BSD 4_4_Lite1 development

author CSRG <csrg@ucbvax.Berkeley.EDU>

Wed, 9 Jan 1991 07:03:53 +0000 (23:03 -0800)

committer CSRG <csrg@ucbvax.Berkeley.EDU>

Wed, 9 Jan 1991 07:03:53 +0000 (23:03 -0800)
author CSRG <csrg@ucbvax.Berkeley.EDU>
Wed, 9 Jan 1991 07:03:53 +0000 (23:03 -0800)
committer CSRG <csrg@ucbvax.Berkeley.EDU>
Wed, 9 Jan 1991 07:03:53 +0000 (23:03 -0800)
diff --git a/usr/src/contrib/emacs-18.57/lisp/gdb.el b/usr/src/contrib/emacs-18.57/lisp/gdb.el

new file mode 100644 (file)

index 0000000..c7e80b9
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/gdb.el
@@ -0,0 +1,397 @@
+;; Run gdb under Emacs
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; Author: W. Schelter, University of Texas
+;;     wfs@rascal.ics.utexas.edu
+;; Rewritten by rms.
+
+;; Some ideas are due to  Masanobu. 
+
+;; Description of GDB interface:
+
+;; A facility is provided for the simultaneous display of the source code
+;; in one window, while using gdb to step through a function in the
+;; other.  A small arrow in the source window, indicates the current
+;; line.
+
+;; Starting up:
+
+;; In order to use this facility, invoke the command GDB to obtain a
+;; shell window with the appropriate command bindings.  You will be asked
+;; for the name of a file to run.  Gdb will be invoked on this file, in a
+;; window named *gdb-foo* if the file is foo.
+
+;; M-s steps by one line, and redisplays the source file and line.
+
+;; You may easily create additional commands and bindings to interact
+;; with the display.  For example to put the gdb command next on \M-n
+;; (def-gdb next "\M-n")
+
+;; This causes the emacs command gdb-next to be defined, and runs
+;; gdb-display-frame after the command.
+
+;; gdb-display-frame is the basic display function.  It tries to display
+;; in the other window, the file and line corresponding to the current
+;; position in the gdb window.  For example after a gdb-step, it would
+;; display the line corresponding to the position for the last step.  Or
+;; if you have done a backtrace in the gdb buffer, and move the cursor
+;; into one of the frames, it would display the position corresponding to
+;; that frame.
+
+;; gdb-display-frame is invoked automatically when a filename-and-line-number
+;; appears in the output.
+
+
+(require 'shell)
+
+(defvar gdb-prompt-pattern "^(.*gdb[+]?) *"
+  "A regexp to recognize the prompt for gdb or gdb+.") 
+
+(defvar gdb-mode-map nil
+  "Keymap for gdb-mode.")
+
+(if gdb-mode-map
+   nil
+  (setq gdb-mode-map (copy-keymap shell-mode-map))
+  (define-key gdb-mode-map "\C-l" 'gdb-refresh))
+
+(define-key ctl-x-map " " 'gdb-break)
+(define-key ctl-x-map "&" 'send-gdb-command)
+
+;;Of course you may use `def-gdb' with any other gdb command, including
+;;user defined ones.   
+
+(defmacro def-gdb (name key &optional doc)
+  (let* ((fun (intern (format "gdb-%s" name)))
+        (cstr (list 'if '(not (= 1 arg))
+                    (list 'format "%s %s" name 'arg)
+                    name)))
+    (list 'progn
+         (list 'defun fun '(arg)
+               (or doc "")
+               '(interactive "p")
+               (list 'gdb-call cstr))
+         (list 'define-key 'gdb-mode-map key  (list 'quote fun)))))
+
+(def-gdb "step"   "\M-s" "Step one source line with display")
+(def-gdb "stepi"  "\M-i" "Step one instruction with display")
+(def-gdb "next"   "\M-n" "Step one source line (skip functions)")
+(def-gdb "cont"   "\M-c" "Continue with display")
+
+(def-gdb "finish" "\C-c\C-f" "Finish executing current function")
+(def-gdb "up"     "\M-u"   "Go up N stack frames (numeric arg) with display")
+(def-gdb "down"   "\M-d"   "Go down N stack frames (numeric arg) with display")
+\f
+(defun gdb-mode ()
+  "Major mode for interacting with an inferior Gdb process.
+The following commands are available:
+
+\\{gdb-mode-map}
+
+\\[gdb-display-frame] displays in the other window
+the last line referred to in the gdb buffer.
+
+\\[gdb-step],\\[gdb-next], and \\[gdb-nexti] in the gdb window,
+call gdb to step,next or nexti and then update the other window
+with the current file and position.
+
+If you are in a source file, you may select a point to break
+at, by doing \\[gdb-break].
+
+Commands:
+Many commands are inherited from shell mode. 
+Additionally we have:
+
+\\[gdb-display-frame] display frames file in other window
+\\[gdb-step] advance one line in program
+\\[gdb-next] advance one line in program (skip over calls).
+\\[send-gdb-command] used for special printing of an arg at the current point.
+C-x SPACE sets break point at current line."
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'gdb-mode)
+  (setq mode-name "Inferior Gdb")
+  (setq mode-line-process '(": %s"))
+  (use-local-map gdb-mode-map)
+  (make-local-variable 'last-input-start)
+  (setq last-input-start (make-marker))
+  (make-local-variable 'last-input-end)
+  (setq last-input-end (make-marker))
+  (make-local-variable 'gdb-last-frame)
+  (setq gdb-last-frame nil)
+  (make-local-variable 'gdb-last-frame-displayed-p)
+  (setq gdb-last-frame-displayed-p t)
+  (make-local-variable 'gdb-delete-prompt-marker)
+  (setq gdb-delete-prompt-marker nil)
+  (make-local-variable 'gdb-filter-accumulator)
+  (setq gdb-filter-accumulator nil)
+  (make-local-variable 'shell-prompt-pattern)
+  (setq shell-prompt-pattern gdb-prompt-pattern)
+  (run-hooks 'shell-mode-hook 'gdb-mode-hook))
+
+(defvar current-gdb-buffer nil)
+
+(defvar gdb-command-name "gdb"
+  "Pathname for executing gdb.")
+
+(defun gdb (path)
+  "Run gdb on program FILE in buffer *gdb-FILE*.
+The directory containing FILE becomes the initial working directory
+and source-file directory for GDB.  If you wish to change this, use
+the GDB commands `cd DIR' and `directory'."
+  (interactive "FRun gdb on file: ")
+  (setq path (expand-file-name path))
+  (let ((file (file-name-nondirectory path)))
+    (switch-to-buffer (concat "*gdb-" file "*"))
+    (setq default-directory (file-name-directory path))
+    (or (bolp) (newline))
+    (insert "Current directory is " default-directory "\n")
+    (make-shell (concat "gdb-" file) gdb-command-name nil "-fullname"
+               "-cd" default-directory file)
+    (gdb-mode)
+    (set-process-filter (get-buffer-process (current-buffer)) 'gdb-filter)
+    (set-process-sentinel (get-buffer-process (current-buffer)) 'gdb-sentinel)
+    (gdb-set-buffer)))
+
+(defun gdb-set-buffer ()
+  (cond ((eq major-mode 'gdb-mode)
+       (setq current-gdb-buffer (current-buffer)))))
+\f
+;; This function is responsible for inserting output from GDB
+;; into the buffer.
+;; Aside from inserting the text, it notices and deletes
+;; each filename-and-line-number;
+;; that GDB prints to identify the selected frame.
+;; It records the filename and line number, and maybe displays that file.
+(defun gdb-filter (proc string)
+  (let ((inhibit-quit t))
+    (if gdb-filter-accumulator
+       (gdb-filter-accumulate-marker proc
+                                     (concat gdb-filter-accumulator string))
+       (gdb-filter-scan-input proc string))))
+
+(defun gdb-filter-accumulate-marker (proc string)
+  (setq gdb-filter-accumulator nil)
+  (if (> (length string) 1)
+      (if (= (aref string 1) ?\032)
+         (let ((end (string-match "\n" string)))
+           (if end
+               (progn
+                 (let* ((first-colon (string-match ":" string 2))
+                        (second-colon
+                         (string-match ":" string (1+ first-colon))))
+                   (setq gdb-last-frame
+                         (cons (substring string 2 first-colon)
+                               (string-to-int
+                                (substring string (1+ first-colon)
+                                           second-colon)))))
+                 (setq gdb-last-frame-displayed-p nil)
+                 (gdb-filter-scan-input proc
+                                        (substring string (1+ end))))
+             (setq gdb-filter-accumulator string)))
+       (gdb-filter-insert proc "\032")
+       (gdb-filter-scan-input proc (substring string 1)))
+    (setq gdb-filter-accumulator string)))
+
+(defun gdb-filter-scan-input (proc string)
+  (if (equal string "")
+      (setq gdb-filter-accumulator nil)
+      (let ((start (string-match "\032" string)))
+       (if start
+           (progn (gdb-filter-insert proc (substring string 0 start))
+                  (gdb-filter-accumulate-marker proc
+                                                (substring string start)))
+           (gdb-filter-insert proc string)))))
+
+(defun gdb-filter-insert (proc string)
+  (let ((moving (= (point) (process-mark proc)))
+       (output-after-point (< (point) (process-mark proc)))
+       (old-buffer (current-buffer))
+       start)
+    (set-buffer (process-buffer proc))
+    (unwind-protect
+       (save-excursion
+         ;; Insert the text, moving the process-marker.
+         (goto-char (process-mark proc))
+         (setq start (point))
+         (insert string)
+         (set-marker (process-mark proc) (point))
+         (gdb-maybe-delete-prompt)
+         ;; Check for a filename-and-line number.
+         (gdb-display-frame
+          ;; 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.
+          (or output-after-point
+              (not (get-buffer-window (current-buffer))))
+          ;; Display a file only when a new filename-and-line-number appears.
+          t))
+      (set-buffer old-buffer))
+    (if moving (goto-char (process-mark proc)))))
+
+(defun gdb-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 redisplay soon
+                (set-buffer-modified-p (buffer-modified-p))
+                (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 gdb buffer.
+            (set-buffer obuf))))))
+
+
+(defun gdb-refresh ()
+  "Fix up a possibly garbled display, and redraw the arrow."
+  (interactive)
+  (redraw-display)
+  (gdb-display-frame))
+
+(defun gdb-display-frame (&optional nodisplay noauto)
+  "Find, obey and delete the last filename-and-line marker from GDB.
+The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
+Obeying it means displaying in another window the specified file and line."
+  (interactive)
+  (gdb-set-buffer)
+  (and gdb-last-frame (not nodisplay)
+       (or (not gdb-last-frame-displayed-p) (not noauto))
+       (progn (gdb-display-line (car gdb-last-frame) (cdr gdb-last-frame))
+             (setq gdb-last-frame-displayed-p t))))
+
+;; 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.
+
+(defun gdb-display-line (true-file line)
+  (let* ((buffer (find-file-noselect true-file))
+        (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)))
+\f
+(defun gdb-call (command)
+  "Invoke gdb COMMAND displaying source in other window."
+  (interactive)
+  (goto-char (point-max))
+  (setq gdb-delete-prompt-marker (point-marker))
+  (gdb-set-buffer)
+  (send-string (get-buffer-process current-gdb-buffer)
+              (concat command "\n")))
+
+(defun gdb-maybe-delete-prompt ()
+  (if (and gdb-delete-prompt-marker
+          (> (point-max) (marker-position gdb-delete-prompt-marker)))
+      (let (start)
+       (goto-char gdb-delete-prompt-marker)
+       (setq start (point))
+       (beginning-of-line)
+       (delete-region (point) start)
+       (setq gdb-delete-prompt-marker nil))))
+
+(defun gdb-break ()
+  "Set GDB breakpoint at this source line."
+  (interactive)
+  (let ((file-name (file-name-nondirectory buffer-file-name))
+       (line (save-restriction
+               (widen)
+               (1+ (count-lines 1 (point))))))
+    (send-string (get-buffer-process current-gdb-buffer)
+                (concat "break " file-name ":" line "\n"))))
+
+(defun gdb-read-address()
+  "Return a string containing the core-address found in the buffer at point."
+  (save-excursion
+   (let ((pt (dot)) found begin)
+     (setq found (if (search-backward "0x" (- pt 7) t)(dot)))
+     (cond (found (forward-char 2)(setq result
+                       (buffer-substring found
+                                (progn (re-search-forward "[^0-9a-f]")
+                                       (forward-char -1)
+                                       (dot)))))
+          (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
+                                (dot)))
+             (forward-char 1)
+             (re-search-forward "[^0-9]")
+             (forward-char -1)
+             (buffer-substring begin (dot)))))))
+
+
+(defvar gdb-commands nil
+  "List of strings or functions used by send-gdb-command.
+It is for customization by you.")
+
+(defun send-gdb-command (arg)
+
+  "This command reads the number where the cursor is positioned.  It
+ then inserts this ADDR at the end of the gdb buffer.  A numeric arg
+ selects the ARG'th member COMMAND of the list gdb-print-command.  If
+ COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
+ (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
+ is a possible string to be a member of gdb-commands.  "
+
+
+  (interactive "P")
+  (let (comm addr)
+    (if arg (setq comm (nth arg gdb-commands)))
+    (setq addr (gdb-read-address))
+    (if (eq (current-buffer) current-gdb-buffer)
+       (set-mark (point)))
+    (cond (comm
+          (setq comm
+                (if (stringp comm) (format comm addr) (funcall comm addr))))
+         (t (setq comm addr)))
+    (switch-to-buffer current-gdb-buffer)
+    (goto-char (dot-max))
+    (insert-string comm)))
diff --git a/usr/src/contrib/emacs-18.57/lisp/gosmacs.el b/usr/src/contrib/emacs-18.57/lisp/gosmacs.el

new file mode 100644 (file)

index 0000000..5ea2697
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/gosmacs.el
@@ -0,0 +1,102 @@
+;; Rebindings to imitate Gosmacs.
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar non-gosmacs-binding-alist nil)
+
+(defun set-gosmacs-bindings ()
+  "Rebind some keys globally to make GNU Emacs resemble Gosling Emacs.
+Use \\[set-gnu-bindings] to restore previous global bindings."
+  (interactive)
+  (setq non-gosmacs-binding-alist
+       (rebind-and-record
+        '(("\C-x\C-e" compile)
+          ("\C-x\C-f" save-buffers-kill-emacs)
+          ("\C-x\C-i" insert-file)
+          ("\C-x\C-m" save-some-buffers)
+          ("\C-x\C-n" next-error)
+          ("\C-x\C-o" switch-to-buffer)
+          ("\C-x\C-r" insert-file)
+          ("\C-x\C-u" undo)
+          ("\C-x\C-v" find-file-other-window)
+          ("\C-x\C-z" shrink-window)
+          ("\C-x!" shell-command)
+          ("\C-xd" delete-window)
+          ("\C-xn" gosmacs-next-window)
+          ("\C-xp" gosmacs-previous-window)
+          ("\C-xz" enlarge-window)
+          ("\C-z" scroll-one-line-up)
+          ("\e\C-c" save-buffers-kill-emacs)
+          ("\e!" line-to-top-of-window)
+          ("\e(" backward-paragraph)
+          ("\e)" forward-paragraph)
+          ("\e?" apropos)
+          ("\eh" delete-previous-word)
+          ("\ej" indent-sexp)
+          ("\eq" query-replace)
+          ("\er" replace-string)
+          ("\ez" scroll-one-line-down)
+          ("\C-_" suspend-emacs)))))
+
+(defun rebind-and-record (bindings)
+  "Establish many new global bindings and record the bindings replaced.
+Arg is an alist whose elements are (KEY DEFINITION).
+Value is a similar alist whose elements describe the same KEYs
+but each with the old definition that was replaced,"
+  (let (old)
+    (while bindings
+      (let* ((this (car bindings))
+            (key (car this))
+            (newdef (nth 1 this)))
+       (setq old (cons (list key (lookup-key global-map key)) old))
+       (global-set-key key newdef))
+      (setq bindings (cdr bindings)))
+    (nreverse old)))
+
+(defun set-gnu-bindings ()
+  "Restore the global bindings that were changed by \\[set-gosmacs-bindings]."
+  (interactive)
+  (rebind-and-record non-gosmacs-binding-alist))
+
+(defun gosmacs-previous-window ()
+  "Select the window above or to the left of the window now selected.
+From the window at the upper left corner, select the one at the lower right."
+  (interactive)
+  (select-window (previous-window)))
+
+(defun gosmacs-next-window ()
+  "Select the window below or to the right of the window now selected.
+From the window at the lower right corner, select the one at the upper left."
+  (interactive)
+  (select-window (next-window)))
+
+(defun scroll-one-line-up (&optional arg)
+  "Scroll the selected window up (forward in the text) one line (or N lines)."
+  (interactive "p")
+  (scroll-up (or arg 1)))
+
+(defun scroll-one-line-down (&optional arg)
+  "Scroll the selected window down (backward in the text) one line (or N)."
+  (interactive "p")
+  (scroll-down (or arg 1)))
+
+(defun line-to-top-of-window ()
+  "Scroll the selected window up so that the current line is at the top."
+  (interactive)
+  (recenter 0))
diff --git a/usr/src/contrib/emacs-18.57/lisp/grow-vers.el b/usr/src/contrib/emacs-18.57/lisp/grow-vers.el

new file mode 100644 (file)

index 0000000..bf55146
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/grow-vers.el
@@ -0,0 +1,30 @@
+;; Load this file to add a new level (starting at zero)
+;; to the Emacs version number recorded in version.el.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(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)
diff --git a/usr/src/contrib/emacs-18.57/lisp/help.el b/usr/src/contrib/emacs-18.57/lisp/help.el

new file mode 100644 (file)

index 0000000..0908681
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/help.el
@@ -0,0 +1,295 @@
+;; Help commands for Emacs
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar help-map (make-sparse-keymap)
+  "Keymap for characters following the Help key.")
+
+(define-key global-map "\C-h" 'help-command)
+(fset 'help-command help-map)
+
+(define-key help-map "\C-h" '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 "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 "i" 'info)
+
+(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 "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)
+
+(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 auto-save-file-name nil)
+      (insert-file-contents (expand-file-name "TUTORIAL" exec-directory))
+      (goto-char (point-min))
+      (search-forward "\n<<")
+      (beginning-of-line)
+      (delete-region (point) (progn (end-of-line) (point)))
+      (newline (- (window-height (selected-window))
+                 (count-lines (point-min) (point))
+                 6))
+      (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: ")
+  (let ((defn (key-binding key)))
+    (if (or (null defn) (integerp defn))
+        (message "%s is undefined" (key-description key))
+      (message "%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 argument FUNCTION to it.
+If FUNCTION is nil, applies `message' to it, thus printing it."
+  (and (not (get-buffer-window standard-output))
+       (funcall (or function 'message)
+               (substitute-command-keys
+                (if (one-window-p t)
+                    (if pop-up-windows
+                        "Type \\[delete-other-windows] to remove help window."
+                      "Type \\[switch-to-buffer] RET to remove help window.")
+                  "Type \\[switch-to-buffer-other-window] RET to restore old contents of help window.")))))
+
+(defun describe-key (key)
+  "Display documentation of the function KEY invokes.  KEY is a string."
+  (interactive "kDescribe key: ")
+  (let ((defn (key-binding key)))
+    (if (or (null defn) (integerp defn))
+        (message "%s is undefined" (key-description key))
+      (with-output-to-temp-buffer "*Help*"
+       (prin1 defn)
+       (princ ":\n")
+       (if (documentation defn)
+           (princ (documentation defn))
+         (princ "not documented"))
+       (print-help-return-message)))))
+
+(defun describe-mode ()
+  "Display documentation of current major mode."
+  (interactive)
+  (with-output-to-temp-buffer "*Help*"
+    (princ mode-name)
+    (princ " Mode:\n")
+    (princ (documentation major-mode))
+    (print-help-return-message)))
+
+(defun describe-distribution ()
+  "Display info on how to obtain the latest version of GNU Emacs."
+  (interactive)
+  (find-file-read-only
+   (expand-file-name "DISTRIB" exec-directory)))
+
+(defun describe-copying ()
+  "Display info on how you may redistribute copies of GNU Emacs."
+  (interactive)
+  (find-file-read-only
+   (expand-file-name "COPYING" exec-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 view-emacs-news ()
+  "Display info on recent changes to Emacs."
+  (interactive)
+  (find-file-read-only (expand-file-name "NEWS" exec-directory)))
+
+(defun view-lossage ()
+  "Display last 100 input keystrokes."
+  (interactive)
+  (with-output-to-temp-buffer "*Help*"
+    (princ (key-description (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")))
+    (print-help-return-message)))
+
+(defun help-for-help ()
+  "You have typed C-h, the help character.  Type a Help option:
+
+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.
+I  info. The  info  documentation reader.
+K  describe-key.  Type a command key sequence;
+             it displays the full documentation.
+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.
+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-w print information on absence of warranty for GNU Emacs."
+  (interactive)
+  (message
+ "A B C F I K L M N S T V W C-c C-d C-n C-w.  Type C-h again for more help: ")
+  (let ((char (read-char)))
+    (if (or (= char ?\C-h) (= char ??))
+       (save-window-excursion
+         (switch-to-buffer "*Help*")
+         (erase-buffer)
+         (insert (documentation 'help-for-help))
+         (goto-char (point-min))
+         (while (memq char '(?\C-h ?? ?\C-v ?\ ?\177 ?\M-v))
+           (if (memq char '(?\C-v ?\ ))
+               (scroll-up))
+           (if (memq char '(?\177 ?\M-v))
+               (scroll-down))
+           (message "A B C F I K L M N S T V W C-c C-d C-n C-w%s: "
+                    (if (pos-visible-in-window-p (point-max))
+                        "" " or Space to scroll"))
+           (let ((cursor-in-echo-area t))
+             (setq char (read-char))))))
+    (let ((defn (cdr (assq (downcase char) (cdr help-map)))))
+      (if defn (call-interactively defn) (ding)))))
+
+
+(defun function-called-at-point ()
+  (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)))
+
+(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)))))
+  (with-output-to-temp-buffer "*Help*"
+    (prin1 function)
+    (princ ":
+")
+    (if (documentation function)
+        (princ (documentation function))
+      (princ "not documented"))
+    (print-help-return-message)))
+
+(defun variable-at-point ()
+  (condition-case ()
+      (save-excursion
+       (forward-sexp -1)
+       (skip-chars-forward "'")
+       (let ((obj (read (current-buffer))))
+         (and (symbolp obj) (boundp obj) obj)))
+    (error nil)))
+
+(defun describe-variable (variable)
+  "Display the full documentation of VARIABLE (a symbol)."
+  (interactive 
+   (let ((v (variable-at-point))
+        (enable-recursive-minibuffers t)
+        val)
+     (setq val (completing-read (if v
+                                   (format "Describe variable (default %s): " v)
+                                 "Describe variable: ")
+                               obarray 'boundp t))
+     (list (if (equal val "")
+              v (intern val)))))
+  (with-output-to-temp-buffer "*Help*"
+    (prin1 variable)
+    (princ "'s value is ")
+    (if (not (boundp variable))
+        (princ "void.")
+      (prin1 (symbol-value variable)))
+    (terpri) (terpri)
+    (princ "Documentation:")
+    (terpri)
+    (let ((doc (documentation-property variable 'variable-documentation)))
+      (if doc
+         (princ (substitute-command-keys doc))
+       (princ "not documented as a variable.")))
+    (print-help-return-message)))
+
+(defun command-apropos (string)
+  "Like apropos but lists only symbols that are names of commands
+\(interactively callable functions)."
+  (interactive "sCommand apropos (regexp): ")
+  (let ((message
+        (let ((standard-output (get-buffer-create "*Help*")))
+          (print-help-return-message 'identity))))
+    (apropos string 'commandp)
+    (and message (message message))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/helper.el b/usr/src/contrib/emacs-18.57/lisp/helper.el

new file mode 100644 (file)

index 0000000..aa7253e
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/helper.el
@@ -0,0 +1,147 @@
+;; helper - utility help package for modes which want to provide help
+;; without relinquishing control, e.g. `electric' modes.
+
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(provide 'helper)                      ; hey, here's a helping hand.
+
+;; Bind this to a string for <blank> in "... Other keys <blank>".
+;; Helper-help uses this to construct help string when scrolling.
+;; Defaults to "return"
+(defvar Helper-return-blurb nil)
+
+;; Keymap implementation doesn't work too well for non-standard loops.
+;; But define it anyway for those who can use it.  Non-standard loops
+;; will probably have to use Helper-help.  You can't autoload the
+;; keymap either.
+
+
+(defvar Helper-help-map nil)
+(if Helper-help-map
+    nil
+  (setq Helper-help-map (make-keymap))
+  ;(fillarray Helper-help-map 'undefined)
+  (define-key Helper-help-map "m" 'Helper-describe-mode)
+  (define-key Helper-help-map "b" 'Helper-describe-bindings)
+  (define-key Helper-help-map "c" 'Helper-describe-key-briefly)
+  (define-key Helper-help-map "k" 'Helper-describe-key)
+  ;(define-key Helper-help-map "f" 'Helper-describe-function)
+  ;(define-key Helper-help-map "v" 'Helper-describe-variable)
+  (define-key Helper-help-map "?" 'Helper-help-options)
+  (define-key Helper-help-map (char-to-string help-char) 'Helper-help-options)
+  (fset 'Helper-help-map Helper-help-map))
+
+(defun Helper-help-scroller ()
+  (let ((blurb (or (and (boundp 'Helper-return-blurb)
+                       Helper-return-blurb)
+                  "return")))
+    (save-window-excursion
+      (goto-char (window-start (selected-window)))
+      (if (get-buffer-window "*Help*")
+         (pop-to-buffer "*Help*")
+       (switch-to-buffer "*Help*"))
+      (goto-char (point-min))
+      (let ((continue t) state)
+       (while continue
+         (setq state (+ (* 2 (if (pos-visible-in-window-p (point-max)) 1 0))
+                        (if (pos-visible-in-window-p (point-min)) 1 0)))
+         (message
+           (nth state
+                '("Space forward, Delete back. Other keys %s"
+                  "Space scrolls forward. Other keys %s"
+                  "Delete scrolls back. Other keys %s"
+                  "Type anything to %s"))
+           blurb)
+         (setq continue (read-char))
+         (cond ((and (memq continue '(?\ ?\C-v)) (< state 2))
+                (scroll-up))
+               ((= continue ?\C-l)
+                (recenter))
+               ((and (= continue ?\177) (zerop (% state 2)))
+                (scroll-down))
+               (t (setq continue nil))))))))
+
+(defun Helper-help-options ()
+  "Describe help options."
+  (interactive)
+  (message "c (key briefly), m (mode), k (key), b (bindings)")
+  ;(message "c (key briefly), m (mode), k (key), v (variable), f (function)")
+  (sit-for 4))
+
+(defun Helper-describe-key-briefly (key)
+  "Briefly describe binding of KEYS."
+  (interactive "kDescribe key briefly: ")
+  (describe-key-briefly key)
+  (sit-for 4))
+
+(defun Helper-describe-key (key)
+  "Describe binding of KEYS."
+  (interactive "kDescribe key: ")
+  (save-window-excursion (describe-key key))
+  (Helper-help-scroller))
+
+(defun Helper-describe-function ()
+  "Describe a function.  Name read interactively."
+  (interactive)
+  (save-window-excursion (call-interactively 'describe-function))
+  (Helper-help-scroller))
+
+(defun Helper-describe-variable ()
+  "Describe a variable.  Name read interactively."
+  (interactive)
+  (save-window-excursion (call-interactively 'describe-variable))
+  (Helper-help-scroller))
+
+(defun Helper-describe-mode ()
+  "Describe the current mode."
+  (interactive)
+  (let ((name mode-name)
+       (documentation (documentation major-mode)))
+    (save-excursion
+      (set-buffer (get-buffer-create "*Help*"))
+      (erase-buffer)
+      (insert name " Mode\n" documentation)))
+  (Helper-help-scroller))
+
+(defun Helper-describe-bindings ()
+  "Describe local key bindings of current mode."
+  (interactive)
+  (message "Making binding list...")
+  (save-window-excursion (describe-bindings))
+  (Helper-help-scroller))
+
+(defun Helper-help ()
+  "Provide help for current mode."
+  (interactive)
+  (let ((continue t) c)
+    (while continue
+      (message "Help (Type ? for further options)")
+      (setq c (char-to-string (downcase (read-char))))
+      (setq c (lookup-key Helper-help-map c))
+      (cond ((eq c 'Helper-help-options)
+            (Helper-help-options))
+           ((commandp c)
+            (call-interactively c)
+            (setq continue nil))
+           (t
+            (ding)
+            (setq continue nil))))))
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/icon.el b/usr/src/contrib/emacs-18.57/lisp/icon.el

new file mode 100644 (file)

index 0000000..718f89d
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/icon.el
@@ -0,0 +1,531 @@
+;; Note: use
+;;  (autoload 'icon-mode "icon" nil t)
+;;  (setq auto-mode-alist (cons '("\\.icn$" . icon-mode) auto-mode-alist))
+;; if not permanently installed in your emacs
+
+;; Icon code editing commands for Emacs
+;; from c-mode.el  13-Apr-88  Chris Smith;  bugs to convex!csmith
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar icon-mode-abbrev-table nil
+  "Abbrev table in use in Icon-mode buffers.")
+(define-abbrev-table 'icon-mode-abbrev-table ())
+
+(defvar icon-mode-map ()
+  "Keymap used in Icon mode.")
+(if icon-mode-map
+    ()
+  (setq icon-mode-map (make-sparse-keymap))
+  (define-key icon-mode-map "{" 'electric-icon-brace)
+  (define-key icon-mode-map "}" 'electric-icon-brace)
+  (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
+  (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
+  (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
+  (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
+  (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
+  (define-key icon-mode-map "\t" 'icon-indent-command))
+
+(defvar icon-mode-syntax-table nil
+  "Syntax table in use in Icon-mode buffers.")
+
+(if icon-mode-syntax-table
+    ()
+  (setq icon-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table)
+  (modify-syntax-entry ?# "<" icon-mode-syntax-table)
+  (modify-syntax-entry ?\n ">" icon-mode-syntax-table)
+  (modify-syntax-entry ?$ "." icon-mode-syntax-table)
+  (modify-syntax-entry ?/ "." icon-mode-syntax-table)
+  (modify-syntax-entry ?* "." icon-mode-syntax-table)
+  (modify-syntax-entry ?+ "." icon-mode-syntax-table)
+  (modify-syntax-entry ?- "." icon-mode-syntax-table)
+  (modify-syntax-entry ?= "." icon-mode-syntax-table)
+  (modify-syntax-entry ?% "." icon-mode-syntax-table)
+  (modify-syntax-entry ?< "." icon-mode-syntax-table)
+  (modify-syntax-entry ?> "." icon-mode-syntax-table)
+  (modify-syntax-entry ?& "." icon-mode-syntax-table)
+  (modify-syntax-entry ?| "." icon-mode-syntax-table)
+  (modify-syntax-entry ?\' "\"" icon-mode-syntax-table))
+
+(defconst icon-indent-level 4
+  "*Indentation of Icon statements with respect to containing block.")
+(defconst icon-brace-imaginary-offset 0
+  "*Imagined indentation of a Icon open brace that actually follows a statement.")
+(defconst icon-brace-offset 0
+  "*Extra indentation for braces, compared with other text in same context.")
+(defconst icon-continued-statement-offset 4
+  "*Extra indent for lines not starting new statements.")
+(defconst icon-continued-brace-offset 0
+  "*Extra indent for substatements that start with open-braces.
+This is in addition to icon-continued-statement-offset.")
+
+(defconst icon-auto-newline nil
+  "*Non-nil means automatically newline before and after braces,
+and after colons and semicolons, inserted in C code.")
+
+(defconst icon-tab-always-indent t
+  "*Non-nil means TAB in Icon mode should always reindent the current line,
+regardless of where in the line point is when the TAB command is used.")
+\f
+(defun icon-mode ()
+  "Major mode for editing Icon code.
+Expression and list commands understand all Icon brackets.
+Tab indents for Icon code.
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+\\{icon-mode-map}
+Variables controlling indentation style:
+ icon-tab-always-indent
+    Non-nil means TAB in Icon mode should always reindent the current line,
+    regardless of where in the line point is when the TAB command is used.
+ icon-auto-newline
+    Non-nil means automatically newline before and after braces
+    inserted in Icon code.
+ icon-indent-level
+    Indentation of Icon statements within surrounding block.
+    The surrounding block's indentation is the indentation
+    of the line on which the open-brace appears.
+ icon-continued-statement-offset
+    Extra indentation given to a substatement, such as the
+    then-clause of an if or body of a while.
+ icon-continued-brace-offset
+    Extra indentation given to a brace that starts a substatement.
+    This is in addition to icon-continued-statement-offset.
+ icon-brace-offset
+    Extra indentation for line if it starts with an open brace.
+ icon-brace-imaginary-offset
+    An open brace following other text is treated as if it were
+    this far to the right of the start of its line.
+
+Turning on Icon mode calls the value of the variable icon-mode-hook with no args,
+if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map icon-mode-map)
+  (setq major-mode 'icon-mode)
+  (setq mode-name "Icon")
+  (setq local-abbrev-table icon-mode-abbrev-table)
+  (set-syntax-table icon-mode-syntax-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^$\\|" page-delimiter))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'icon-indent-line)
+  (make-local-variable 'require-final-newline)
+  (setq require-final-newline t)
+  (make-local-variable 'comment-start)
+  (setq comment-start "# ")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+  (make-local-variable 'comment-column)
+  (setq comment-column 32)
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "# *")
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'icon-comment-indent)
+  (run-hooks 'icon-mode-hook))
+\f
+;; 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                                ;Existing comment at bol stays there.
+    (save-excursion
+      (skip-chars-backward " \t")
+      (max (1+ (current-column))       ;Else indent at comment column
+          comment-column))))   ; except leave at least one space.
+
+(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)))))
+\f
+(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
+             ;; Statement level.  Is it a continuation or a new statement?
+             ;; Find previous non-comment character.
+             (if toplevel
+                 (progn (icon-backward-to-noncomment (point-min))
+                        (if (icon-is-continuation-line)
+                            icon-continued-statement-offset 0))
+               (if (null containing-sexp)
+                   (progn (beginning-of-icon-defun)
+                          (setq containing-sexp (point))))
+               (goto-char indent-point)
+               (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))
+                      ;; here we are
+                      (current-indentation))))))))))
+
+(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)))
+              '(("do") ("dynamic") ("else") ("initial") ("link")
+                ("local") ("of") ("static") ("then")))
+      (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 (search-forward "#" opoint 'move)
+              (< lim (point)))
+         (forward-char -1)
+       (setq stop t)))))
+
+(defun icon-backward-to-start-of-continued-exp (lim)
+  (if (memq (preceding-char) '(?\) ?\]))
+      (forward-sexp -1))
+  (while (icon-is-continued-line)
+    (end-of-line 0))
+  (beginning-of-line)
+  (if (<= (point) lim)
+      (goto-char (1+ lim)))
+  (skip-chars-forward " \t"))
+
+(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))))))
+\f
+(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))
+\f
+(defun indent-icon-exp ()
+  "Indent each line of the Icon grouping following point."
+  (interactive)
+  (let ((indent-stack (list nil))
+       (contain-stack (list (point)))
+       (case-fold-search nil)
+       restart outer-loop-done inner-loop-done state ostate
+       this-indent last-sexp
+       at-else at-brace at-do
+       (opoint (point))
+       (next-depth 0))
+    (save-excursion
+      (forward-sexp 1))
+    (save-excursion
+      (setq outer-loop-done nil)
+      (while (and (not (eobp)) (not outer-loop-done))
+       (setq last-depth next-depth)
+       ;; Compute how depth changes over this line
+       ;; plus enough other lines to get to one that
+       ;; does not end inside a comment or string.
+       ;; Meanwhile, do appropriate indentation on comment lines.
+       (setq innerloop-done nil)
+       (while (and (not innerloop-done)
+                   (not (and (eobp) (setq outer-loop-done t))))
+         (setq ostate state)
+         (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
+                                         nil nil state))
+         (setq next-depth (car state))
+         (if (and (car (cdr (cdr state)))
+                  (>= (car (cdr (cdr state))) 0))
+             (setq last-sexp (car (cdr (cdr state)))))
+         (if (or (nth 4 ostate))
+             (icon-indent-line))
+         (if (or (nth 3 state))
+             (forward-line 1)
+           (setq innerloop-done t)))
+       (if (<= next-depth 0)
+           (setq outer-loop-done t))
+       (if outer-loop-done
+           nil
+         (if (/= last-depth next-depth)
+             (setq last-sexp nil))
+         (while (> last-depth next-depth)
+           (setq indent-stack (cdr indent-stack)
+                 contain-stack (cdr contain-stack)
+                 last-depth (1- last-depth)))
+         (while (< last-depth next-depth)
+           (setq indent-stack (cons nil indent-stack)
+                 contain-stack (cons nil contain-stack)
+                 last-depth (1+ last-depth)))
+         (if (null (car contain-stack))
+             (setcar contain-stack (or (car (cdr state))
+                                       (save-excursion (forward-sexp -1)
+                                                       (point)))))
+         (forward-line 1)
+         (skip-chars-forward " \t")
+         (if (eolp)
+             nil
+           (if (and (car indent-stack)
+                    (>= (car indent-stack) 0))
+               ;; Line is on an existing nesting level.
+               ;; Lines inside parens are handled specially.
+               (if (/= (char-after (car contain-stack)) ?{)
+                   (setq this-indent (car indent-stack))
+                 ;; Line is at statement level.
+                 ;; Is it a new statement?  Is it an else?
+                 ;; Find last non-comment character before this line
+                 (save-excursion
+                   (setq at-else (looking-at "else\\W"))
+                   (setq at-brace (= (following-char) ?{))
+                   (icon-backward-to-noncomment opoint)
+                   (if (icon-is-continuation-line)
+                       ;; Preceding line did not end in comma or semi;
+                       ;; indent this line  icon-continued-statement-offset
+                       ;; more than previous.
+                       (progn
+                         (icon-backward-to-start-of-continued-exp (car contain-stack))
+                         (setq this-indent
+                               (+ icon-continued-statement-offset (current-column)
+                                  (if at-brace icon-continued-brace-offset 0))))
+                     ;; Preceding line ended in comma or semi;
+                     ;; use the standard indent for this level.
+                     (if at-else
+                         (progn (icon-backward-to-start-of-if opoint)
+                                (setq this-indent (current-indentation)))
+                       (setq this-indent (car indent-stack))))))
+             ;; Just started a new nesting level.
+             ;; Compute the standard indent for this level.
+             (let ((val (calculate-icon-indent
+                          (if (car indent-stack)
+                              (- (car indent-stack))))))
+               (setcar indent-stack
+                       (setq this-indent val))))
+           ;; Adjust line indentation according to its contents
+           (if (or (= (following-char) ?})
+                   (looking-at "end\\b"))
+               (setq this-indent (- this-indent icon-indent-level)))
+           (if (= (following-char) ?{)
+               (setq this-indent (+ this-indent icon-brace-offset)))
+           ;; Put chosen indentation into effect.
+           (or (= (current-column) this-indent)
+               (progn
+                 (delete-region (point) (progn (beginning-of-line) (point)))
+                 (indent-to this-indent)))
+           ;; Indent any comment following the text.
+           (or (looking-at comment-start-skip)
+               (if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)
+                   (progn (indent-for-comment) (beginning-of-line))))))))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/inc-vers.el b/usr/src/contrib/emacs-18.57/lisp/inc-vers.el

new file mode 100644 (file)

index 0000000..13a4fb1
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/inc-vers.el
@@ -0,0 +1,43 @@
+;; Load this file to increment the recorded Emacs version number.
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(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))))
+
+
+(write-region (point-min) (point-max) "../lisp/version.el" nil 'nomsg)
+(erase-buffer)
+(set-buffer-modified-p nil)
+
+(kill-emacs)
diff --git a/usr/src/contrib/emacs-18.57/lisp/indent.el b/usr/src/contrib/emacs-18.57/lisp/indent.el

new file mode 100644 (file)

index 0000000..903b8f7
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/indent.el
@@ -0,0 +1,225 @@
+;; Indentation commands for Emacs
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;Now in loaddefs.el
+;(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 ()
+  "Indent line in proper way for current major mode."
+  (interactive)
+  (if (eq indent-line-function 'indent-to-left-margin)
+      (insert-tab)
+    (funcall indent-line-function)))
+
+(defun insert-tab ()
+  (if abbrev-mode
+      (expand-abbrev))
+  (if indent-tabs-mode
+      (insert ?\t)
+    (indent-to (* tab-width (1+ (/ (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)))
+       (delete-region (point) (progn (skip-chars-forward " \t") (point)))
+       (or (eolp)
+           (indent-to (max 0 (+ indent arg)) 0)))
+      (forward-line 1))
+    (move-marker end nil)))
+
+;; This is the default indent-line-function,
+;; used in Fundamental Mode, Text Mode, etc.
+(defun indent-to-left-margin ()
+  (or (= (current-indentation) left-margin)
+      (let (epos)
+       (save-excursion
+        (beginning-of-line)
+        (delete-region (point)
+                       (progn (skip-chars-forward " \t")
+                              (point)))
+        (indent-to left-margin)
+        (setq epos (point)))
+       (if (< (point) epos)
+           (goto-char epos)))))
+
+(defvar indent-region-function nil
+  "Function which is short cut to indent each line in region with Tab.
+nil means really call Tab on each line.")
+
+(defun indent-region (start end arg)
+  "Indent each nonblank line in the region.
+With no argument, indent each line with Tab.
+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 arg)
+      (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)
+          (funcall indent-line-function)
+          (forward-line 1))
+        (move-marker end nil)))
+    (setq arg (prefix-numeric-value arg))
+  (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 arg 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.")
+
+(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 C-c C-c 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)
+  (if abbrev-mode (expand-abbrev))
+  (let ((tabs tab-stop-list))
+    (while (and tabs (>= (current-column) (car tabs)))
+      (setq tabs (cdr tabs)))
+    (if tabs
+       (indent-to (car tabs))
+      (insert ? ))))
+
+(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)
diff --git a/usr/src/contrib/emacs-18.57/lisp/info.el b/usr/src/contrib/emacs-18.57/lisp/info.el

new file mode 100644 (file)

index 0000000..b91ed6b
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/info.el
@@ -0,0 +1,701 @@
+;; Info package for Emacs  -- could use a "create node" feature.
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(provide 'info)
+
+(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-edit] command in Info can edit the current node.")
+
+(defvar Info-enable-active-nodes t
+  "Non-nil allows Info to execute Lisp code associated with nodes.
+The Lisp code is executed when the node is selected.")
+
+(defvar Info-directory nil
+  "Default directory for Info documentation files.")
+
+(defvar Info-current-file nil
+  "Info file that Info is now looking at, or nil.")
+
+(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.")
+
+(defun info ()
+  "Enter Info, the documentation browser."
+  (interactive)
+  (if (get-buffer "*info*")
+      (switch-to-buffer "*info*")
+    (Info-directory)))
+
+;; 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)
+       (setq filename (substitute-in-file-name filename))
+       (setq temp (expand-file-name filename
+                                    ;; Use Info's default dir
+                                    ;; unless the filename starts with `./'.
+                                    (if (not (string-match "^\\./" filename))
+                                        Info-directory)))
+       (if (file-exists-p temp)
+           (setq filename temp)
+         (setq temp (expand-file-name (downcase filename) Info-directory))
+         (if (file-exists-p temp)
+             (setq filename temp)
+           (error "Info file %s does not exist"
+                  (expand-file-name filename Info-directory))))))
+  ;; 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.
+  (switch-to-buffer "*info*")
+  (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)
+             (erase-buffer)
+             (insert-file-contents filename t)
+             (set-buffer-modified-p nil)
+             (setq default-directory (file-name-directory filename))
+             ;; 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)
+             (or (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*"))
+                           (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
+                   (file-name-sans-versions buffer-file-name))))
+       (if (equal nodename "*")
+           (progn (setq Info-current-node nodename)
+                  (Info-set-mode-line))
+         ;; Search file for a suitable node.
+         ;; 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.
+         (let ((guesspos (point-min)))
+           (if (marker-position Info-tag-table-marker)
+               (save-excursion
+                 (set-buffer (marker-buffer Info-tag-table-marker))
+                 (goto-char Info-tag-table-marker)
+                 (if (search-forward (concat "Node: " nodename "\177") 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.
+         (let ((regexp (concat "Node: *" (regexp-quote nodename) " *[,\t\n]")))
+           (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
+       (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)))
+
+(defun Info-read-subfile (nodepos)
+  (set-buffer (marker-buffer Info-tag-table-marker))
+  (goto-char (point-min))
+  (search-forward "\n\^_")
+  (let (lastfilepos
+       lastfilename)
+    (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)))
+             (if (> thisfilepos nodepos)
+                 (throw 'foo t))
+             (setq lastfilename thisfilename)
+             (setq lastfilepos thisfilepos)))))
+    (set-buffer (get-buffer "*info*"))
+    (or (equal Info-current-subfile lastfilename)
+       (let ((buffer-read-only nil))
+         (setq buffer-file-name nil)
+         (widen)
+         (erase-buffer)
+         (insert-file-contents lastfilename)
+         (set-buffer-modified-p nil)
+         (setq Info-current-subfile lastfilename)))
+    (goto-char (point-min))
+    (search-forward "\n\^_")
+    (+ (- 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 (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)))))
+
+(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 ""))))
+\f
+;; 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 "sGoto 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))))
+    (Info-find-node (if (equal filename "") nil filename)
+                   (if (equal nodename "") "Top" nodename))))
+\f
+(defvar Info-last-search nil
+  "Default regexp for Info S 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 (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))
+       (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 opoint)
+                    (goto-char opoint)
+                    (Info-select-node)))))
+    (widen)
+    (goto-char found)
+    (Info-select-node)
+    (or (and (equal onode Info-current-node)
+            (equal ofile Info-current-file))
+       (setq Info-history (cons (list ofile onode opoint)
+                                Info-history)))))
+\f
+(defun Info-extract-pointer (name &optional errorname)
+  (save-excursion
+   (goto-char (point-min))
+   (forward-line 1)
+   (if (re-search-backward (concat name ":") nil t)
+       nil
+     (error (concat "Node has no " (capitalize (or errorname name)))))
+   (goto-char (match-end 0))
+   (Info-following-node-name)))
+
+(defun Info-following-node-name (&optional allowedchars)
+  (skip-chars-forward " \t")
+  (buffer-substring
+   (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")))
+
+(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"))
+\f
+(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 str i)
+     (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 completions
+              (cons (cons str nil)
+                    completions))))
+     (if completions
+        (list (completing-read "Follow reference named: " completions nil t))
+       (error "No cross-references in this node"))))
+  (let (target beg i (str (concat "\\*note " 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")))
+    (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)
+  (skip-chars-forward " \t\n")
+  (let ((beg (point))
+       str i)
+    (skip-chars-forward "^:")
+    (forward-char 1)
+    (setq str
+         (if (looking-at ":")
+             (buffer-substring beg (1- (point)))
+           (skip-chars-forward " \t\n")
+           (Info-following-node-name "^.,\t\n")))
+    (while (setq i (string-match "\n" str i))
+      (aset str i ?\ ))
+    str))
+
+(defun Info-menu-item-sequence (list)
+  (while list
+    (Info-menu-item (car list))
+    (setq list (cdr list))))
+
+(defun Info-menu (menu-item)
+  "Go to node for menu item named (or abbreviated) NAME."
+  (interactive
+   (let ((completions '())
+        ;; If point is within a menu item, use that item as the default
+        (default nil)
+        (p (point))
+        (last nil))
+     (save-excursion
+       (goto-char (point-min))
+       (if (not (search-forward "\n* menu:" nil t))
+          (error "No menu in this node"))
+       (while (re-search-forward
+               "\n\\* \\([^:\t\n]*\\):" nil t)
+        (if (and (null default)
+                 (prog1 (if last (< last p) nil)
+                   (setq last (match-beginning 0)))
+                 (<= p last))
+            (setq default (car (car completions))))
+        (setq completions (cons (cons (buffer-substring
+                                        (match-beginning 1)
+                                        (match-end 1))
+                                      (match-beginning 1))
+                                completions)))
+       (if (and (null default) last
+               (< last p)
+               (<= p (progn (end-of-line) (point))))
+          (setq default (car (car completions)))))
+     (let ((item nil))
+       (while (null item)
+        (setq item (let ((completion-ignore-case t))
+                     (completing-read (if default
+                                          (format "Menu item (default %s): "
+                                                  default)
+                                          "Menu item: ")
+                                      completions nil t)))
+        ;; we rely on the bug (which RMS won't change for his own reasons)
+        ;; 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))))
+  (Info-goto-node (Info-extract-menu-item menu-item)))
+  
+(defun Info-extract-menu-item (menu-item)
+  (save-excursion
+    (goto-char (point-min))
+    (or (search-forward "\n* menu:" nil t)
+       (error "No menu in this node"))
+    (or (search-forward (concat "\n* " menu-item ":") nil t)
+       (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)))
+
+(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"))
+    (or (search-forward "\n* " nil t count)
+       (error "Too few items in menu"))
+    (Info-extract-menu-node-name)))
+
+(defun Info-first-menu-item ()
+  "Go to the node of the first menu item."
+  (interactive)
+  (Info-goto-node (Info-extract-menu-counting 1)))
+
+(defun Info-second-menu-item ()
+  "Go to the node of the second menu item."
+  (interactive)
+  (Info-goto-node (Info-extract-menu-counting 2)))
+
+(defun Info-third-menu-item ()
+  "Go to the node of the third menu item."
+  (interactive)
+  (Info-goto-node (Info-extract-menu-counting 3)))
+
+(defun Info-fourth-menu-item ()
+  "Go to the node of the fourth menu item."
+  (interactive)
+  (Info-goto-node (Info-extract-menu-counting 4)))
+
+(defun Info-fifth-menu-item ()
+  "Go to the node of the fifth menu item."
+  (interactive)
+  (Info-goto-node (Info-extract-menu-counting 5)))
+
+(defun Info-exit ()
+  "Exit Info by selecting some other buffer."
+  (interactive)
+  (switch-to-buffer (prog1 (other-buffer (current-buffer))
+                          (bury-buffer (current-buffer)))))
+
+(defun Info-undefined ()
+  "Make command be undefined in Info."
+  (interactive)
+  (ding))
+
+(defun Info-help ()
+  "Enter the Info tutorial."
+  (interactive)
+  (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))
+    (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 (/= ?\  (setq ch (read-char)))
+                       (progn (setq unread-command-char ch) nil)
+                     flag))
+       (scroll-up)))))
+\f
+(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 " " 'scroll-up)
+  (define-key Info-mode-map "1" 'Info-first-menu-item)
+  (define-key Info-mode-map "2" 'Info-second-menu-item)
+  (define-key Info-mode-map "3" 'Info-third-menu-item)
+  (define-key Info-mode-map "4" 'Info-fourth-menu-item)
+  (define-key Info-mode-map "5" 'Info-fifth-menu-item)
+  (define-key Info-mode-map "6" 'undefined)
+  (define-key Info-mode-map "7" 'undefined)
+  (define-key Info-mode-map "8" 'undefined)
+  (define-key Info-mode-map "9" 'undefined)
+  (define-key Info-mode-map "0" 'undefined)
+  (define-key Info-mode-map "?" 'Info-summary)
+  (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 "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)
+  (define-key Info-mode-map "u" 'Info-up)
+  (define-key Info-mode-map "\177" 'scroll-down))
+
+(defun Info-mode ()
+  "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.
+
+h      Invoke the Info tutorial.
+
+Selecting other nodes:
+n      Move to the \"next\" node of this node.
+p      Move to the \"previous\" node of this node.
+u      Move \"up\" from this node.
+m      Pick menu item specified by name (or abbreviation).
+       Picking a menu item causes another node to be selected.
+f      Follow a cross reference.  Reads name of reference.
+l      Move to the last node you were at.
+
+Moving within a node:
+Space  scroll forward a page.     DEL  scroll backward.
+b      Go to beginning of node.
+
+Advanced commands:
+q      Quit Info: reselect previously selected buffer.
+e      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.
+g      Move to node specified by name.
+       You may include a filename as well, as (FILENAME)NODENAME.
+s      Search through this Info file for specified regexp,
+       and select the node in which the next occurrence is found."
+  (kill-all-local-variables)
+  (setq major-mode 'Info-mode)
+  (setq mode-name "Info")
+  (use-local-map Info-mode-map)
+  (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)
+  (Info-set-mode-line))
+
+(defvar Info-edit-map nil
+  "Local keymap used within `e' command of Info.")
+(if Info-edit-map
+    nil
+  (setq Info-edit-map (copy-keymap text-mode-map))
+  (define-key Info-edit-map "\C-c\C-c" 'Info-cease-edit))
+
+(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}"
+  )
+
+(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"))
+  (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)
+  ;; Make mode line update.
+  (set-buffer-modified-p (buffer-modified-p))
+  (message (substitute-command-keys
+            "Editing: Type \\[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)
+  ;; Make mode line update.
+  (set-buffer-modified-p (buffer-modified-p))
+  (and (marker-position Info-tag-table-marker)
+       (buffer-modified-p)
+       (message "Tags may have changed.  Use Info-tagify if necessary")))
diff --git a/usr/src/contrib/emacs-18.57/lisp/informat.el b/usr/src/contrib/emacs-18.57/lisp/informat.el

new file mode 100644 (file)

index 0000000..95d8744
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/informat.el
@@ -0,0 +1,411 @@
+;; Info support functions package for Emacs
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(require 'info)
+
+(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.
+  (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)
+               (forward-line 1)
+               (let ((beg (point)))
+                 (forward-line 1)
+                 (if (re-search-backward regexp beg t)
+                     (setq list
+                           (cons (list (buffer-substring
+                                         (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)))))))
+\f
+(defun Info-split ()
+  "Split an info file into an indirect file plus bounded-size subfiles.
+Each subfile will be up to 50000 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" (car (car subfiles)))
+             "\n")
+      (setq subfiles (cdr subfiles)))
+    (goto-char start)
+    (insert "\^_\nIndirect:\n")
+    (search-forward "\nTag Table:\n")
+    (insert "(Indirect)\n")))
+\f
+(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
+                               (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
+                                    (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
+            (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
+                                    (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))
+          (or (looking-at "End tag table\n")
+              (throw 'losing 'z))
+          nil))))
+\f
+(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-flush-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
+                        (message "Tagifying %s..." file)
+                        (Info-tagify)
+                        (message "Tagifying %s...done" file))))
+               (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 (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))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/isearch.el b/usr/src/contrib/emacs-18.57/lisp/isearch.el

new file mode 100644 (file)

index 0000000..cf2a0bf
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/isearch.el
@@ -0,0 +1,377 @@
+;; Incremental search
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+; in loaddefs.el
+;(defvar search-last-string ""
+;  "Last string search for by a 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 ?\e
+;  "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-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.")
+;(defconst 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.")
+
+;; 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.
+
+(defun isearch (forward &optional regexp)
+  (let ((search-string "")
+       (search-message "")
+       (cmds nil)
+       (success t)
+       (wrapped nil)
+       (barrier (point))
+       adjusted
+       (invalid-regexp nil)
+       (slow-terminal-mode (and (<= (baud-rate) search-slow-speed)
+                                (> (window-height)
+                                   (* 4 search-slow-window-lines))))
+       (other-end nil)    ;Start of last match if fwd, end if backwd.
+       (small-window nil)              ;if t, using a small window
+       (found-point nil)               ;to restore point from a small window
+       ;; This is the window-start value found by the search.
+       (found-start nil)
+       (opoint (point))
+       (inhibit-quit t))  ;Prevent ^G from quitting immediately.
+    (isearch-push-state)
+    (save-window-excursion
+     (catch 'search-done
+       (while t
+        (or (>= 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-char))))
+          (setq quit-flag nil adjusted nil)
+          ;; Meta character means exit search.
+          (cond ((and (>= char 128)
+                      search-exit-option)
+                 (setq unread-command-char char)
+                 (throw 'search-done t))
+                ((eq char search-exit-char)
+                 ;; Esc 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.
+                         (setq search-string
+                               (if regexp
+                                   search-last-regexp search-last-string)
+                               search-message
+                               (mapconcat 'text-char-description
+                                          search-string ""))
+                       ;; 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 "")
+                     (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 cmds))
+                     (ding)
+                   (isearch-pop)))
+                (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 "")))))
+                        ;; 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 ?\r))))
+                         (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)
+                                ;; unix braindeath
+                                (setq char ?\n)))
+                         (setq search-string (concat search-string
+                                                     (char-to-string char))
+                               search-message (concat search-message
+                                                      (text-char-description char)))))
+                 (if (and (not success)
+                          ;; unsuccessful regexp search may become
+                          ;;  successful by addition of characters which
+                          ;;  make search-string valid
+                          (not regexp))
+                     nil
+                   ;; If a regexp search may have been made more
+                   ;; liberal, retreat the search start.
+                   ;; Go back to place last successful search started
+                   ;; or to the last ^S/^R (barrier), whichever is nearer.
+                   (and regexp success cmds
+                        (cond ((memq char '(?* ??))
+                               (setq adjusted t)
+                               (let ((cs (nth (if forward
+                                                  5 ; other-end
+                                                2) ; saved (point)
+                                              (car (cdr cmds)))))
+                                 ;; (car cmds) is after last search;
+                                 ;; (car (cdr cmds)) is from before it.
+                                 (setq cs (or cs barrier))
+                                 (goto-char
+                                  (if forward
+                                      (max cs barrier)
+                                    (min cs barrier)))))
+                              ((eq char ?\|)
+                               (setq adjusted t)
+                               (goto-char barrier))))
+                   ;; In reverse regexp search, adding a character at
+                   ;; the end may cause zero or many more chars to be
+                   ;; matched, in the string following point.
+                   ;; Allow all those possibiities without moving point as
+                   ;; long as the match does not extend past search origin.
+                   (if (and regexp (not forward) (not adjusted)
+                            (condition-case ()
+                                (looking-at search-string)
+                              (error nil))
+                            (<= (match-end 0) (min opoint 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 adjusted))
+                         (goto-char (if forward other-end
+                                      (min opoint barrier (1+ other-end)))))
+                     (isearch-search)))
+                 (isearch-push-state))))))
+     (setq found-start (window-start (selected-window)))
+     (setq found-point (point)))
+    (if (> (length search-string) 0)
+       (if regexp
+           (setq search-last-regexp search-string)
+           (setq search-last-string search-string)))
+    ;; 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 ""))
+    (if small-window
+       (goto-char found-point)
+      ;; 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 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)))))
+
+(defun isearch-pop ()
+  (setq cmds (cdr cmds))
+  (let ((cmd (car cmds)))
+    (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))
+    (goto-char (car (cdr (cdr cmd))))))
+
+(defun isearch-push-state ()
+  (setq cmds (cons (list search-string search-message (point)
+                        success forward other-end invalid-regexp
+                        wrapped barrier)
+                  cmds)))
+
+(defun isearch-search ()
+  (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 cmds))
+        (ding))
+    (goto-char (nth 2 (car cmds)))))
+
+;; 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-char)))
+    (if (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)))
diff --git a/usr/src/contrib/emacs-18.57/lisp/kermit.el b/usr/src/contrib/emacs-18.57/lisp/kermit.el

new file mode 100644 (file)

index 0000000..2c7ef76
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/kermit.el
@@ -0,0 +1,185 @@
+;;Additions to shell mode for use with kermit, etc.
+;;Feb 1988, Jeff Norden - jeff@colgate.csnet
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(require 'shell)
+
+;; 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.  Funcions are also provied 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
+;; differnce from being in local shell-mode is that it is you need to 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 problably 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.
+
+;; 2) The "clean-filter" can be a troublesome item.  The main problem arises if
+;; you are running a program under shell-mode which is doing periodic output,
+;; and you then try to switch to another buffer.  I came across this while
+;; running kermit file transfers - kermit prints a dot each time a packet is
+;; received. Since emacs is interrupted each time a dot is printed, it becomes
+;; impossible to edit the other buffer.  If you hit a key while the filter code
+;; is running, that character will wind up in the *shell* buffer instead of the
+;; current one!  So you need to be careful to turn the filter off before
+;; leaving the buffer if a program is still running.  In fact, you can't even
+;; use "M-x clean-shell-off" to do this, because you won't be able to type
+;; "clean-shell-off" in the minibuffer!!  So you need to have this command
+;; bound to a keystroke.
+
+;; Please let me know if any bugs turn up.
+;; Feb 1988, Jeff Norden - jeff@colgate.csnet
+
+(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 shell-send-input-cr ()
+  "Like \\[shell-send-input] but end the line with carriage-return."
+  (interactive)
+  (end-of-line)
+    (if (eobp)
+       (progn
+         (move-marker last-input-start
+              (process-mark (get-buffer-process (current-buffer))))
+         (insert ?\n)
+         (move-marker last-input-end (point)))
+    (beginning-of-line)
+    (re-search-forward shell-prompt-pattern nil t)
+    (let ((copy (buffer-substring (point)
+                                 (progn (forward-line 1) (point)))))
+      (goto-char (point-max))
+      (move-marker last-input-start (point))
+      (insert copy)
+      (move-marker last-input-end (point))))
+    (condition-case ()
+       (save-excursion
+         (goto-char last-input-start)
+         (shell-set-directory))
+      (error (funcall shell-set-directory-error-hook)))
+  (let ((process (get-buffer-process (current-buffer))))
+    (process-send-region process last-input-start (- last-input-end 1))
+    (process-send-string process "\r")
+    (set-marker (process-mark process) (point))))
+
+;; This is backwards of what makes sense, but ...
+(define-key shell-mode-map "\n" 'shell-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" 'shell-send-input-cr)
+  (define-key shell-mode-map "\n" 'shell-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" 'shell-send-input-cr)
+  (define-key shell-mode-map "\r" 'shell-send-input))
+
+;; This filter works, but I don't especially recommend it.
+(defun kermit-clean-filter (process string)
+  "A process filter which deletes all ^M's and ^@'s from the output."
+  (set-buffer (process-buffer process))
+  (let 
+      ((firstpos (string-match "[^\C-@\r]+" string))
+       (buffermark (process-mark process))
+       (oldpt (point))
+       (newstring '"")
+       goback)
+    (while firstpos
+      (setq newstring 
+           (concat newstring (substring string firstpos (match-end 0))))
+      (setq firstpos (string-match "[^\C-@\r]+" string (match-end 0))))
+    (goto-char (marker-position buffermark))
+    (setq goback (< oldpt (point)))
+    (insert newstring)
+    (set-marker buffermark (point))
+    (if goback (goto-char oldpt))))
+
+(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))
+
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/keypad.el b/usr/src/contrib/emacs-18.57/lisp/keypad.el

new file mode 100644 (file)

index 0000000..49bc3ea
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/keypad.el
@@ -0,0 +1,152 @@
+;; Terminal-independent keypad and function key bindings.
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; These keys are handled by a two-level process.
+;; The first level, terminal-dependent, maps input sequences
+;; into the function keys that they represent.
+;; The second level, terminal-independent but customized by users,
+;; map function keys into meanings.
+
+;; This file takes care of the second level of mapping.
+;; The first, terminal-dependent, level is handled by the
+;; terminal-specific files term/*.el.
+
+;; The second-level mapping is done by a keymap, function-keymap.
+;; Here we document the meanings of the "characters" defined by
+;; function-keymap.
+
+;; What do these letters mean?
+;; When we say that ``a stands for the clear-all-tabs key'',
+;; we mean that you should attach to the letter `a' in function-keymap
+;; whatever command you want to be executed when you type the
+;; clear-all-tabs key on any terminal.  The terminal-dependent
+;; files will attempt to make this work.  If a terminal has no
+;; clear-all-tabs key that can be recognized, it makes no difference
+;; what binding you give to `a' in function-keymap.
+
+;; a -- clear all tabs key
+;; c -- erase key
+;; d -- down-arrow
+;; e -- enter key
+;; f -- find key or search key
+;; h -- home-position key
+;; k -- delete key or remove key.
+;; l -- left-arrow
+;; p -- portrait mode
+;; q -- landscape mode
+;; r -- right-arrow
+;; s -- select key
+;; t -- clear tab this column key
+;; u -- up-arrow
+;; x -- do key
+;; ? -- help
+
+;; - -- keypad key labelled `-'.
+;; . -- keypad key labelled `.'.
+;; , -- keypad key labelled `,'.
+;; 0 ... 9 -- keypad key labelled with that digit,
+;;   but only if that key is not also an arrow key.
+
+;; C-@, C-a, ... C-x -- numbered function keys 0 through 24.
+;; These are used for function keys with no labels but numbers,
+;; and may also be used for function keys with labels
+;; that we have not defined letters for.
+
+;; A -- insert line key
+;; C -- clear screen key
+;; D -- delete character key.
+;; E -- clear to end of line key
+;; F -- scroll forward key
+;; H -- home-down
+;; I -- insert character key
+;;       If there is just an "insert" key, it should be this.
+;; L -- delete line key
+;; M -- exit insert mode key
+;; N -- next page key
+;; P -- previous page key
+;; R -- scroll reverse key
+;; S -- clear to end of screen key
+;; T -- set tab this column key
+
+(defun keypad-default (char definition)
+  (or (lookup-key function-keymap char)
+      (define-key function-keymap char definition)))
+
+;; Here are the standard command meanings we give to the various
+;; function key names.  Because this file is loaded after the user's
+;; init file, we are careful to avoid overriding any definitions
+;; already stored in function-keymap by the init file or (less often)
+;; by the terminal-specific term/*.el file.
+
+(keypad-default "l" 'backward-char)
+(keypad-default "r" 'forward-char)
+(keypad-default "D" 'delete-char)
+(keypad-default "u" 'previous-line)
+(keypad-default "d" 'next-line)
+(keypad-default "N" 'scroll-up)
+(keypad-default "P" 'scroll-down)
+(keypad-default "C" 'recenter)
+(keypad-default "?" 'help-for-help)
+(keypad-default "s" 'set-mark-command)
+(keypad-default "k" 'kill-region)
+(keypad-default "f" 're-search-forward)
+
+(keypad-default "\C-a" 'beginning-of-line)
+(keypad-default "\C-b" 'end-of-line)
+(keypad-default "\C-c" 'isearch-forward)
+(keypad-default "\C-d" 'kill-line)
+
+(keypad-default "." 'delete-char)
+(keypad-default "0" 'yank)
+(keypad-default "e" 'open-line)
+(keypad-default "1" 'backward-word)
+(keypad-default "3" 'forward-word)
+(keypad-default "7" 'backward-paragraph)
+(keypad-default "9" 'forward-paragraph)
+(keypad-default "h" 'move-to-window-line)
+
+(defun setup-terminal-keymap (map translations)
+  "Set up keymap MAP to forward to function-keymap according to TRANSLATIONS.
+TRANSLATIONS is an alist; each element of it looks like (FROMSTRING . TOCHAR).
+For each such pair, we define the key sequence FROMSTRING in MAP
+to forward to the definition of character TOCHAR in function-keymap.
+\"Forwarding\" means that subsequent redefinition of TOCHAR in
+function-keymap will be seen automatically in MAP as well.
+
+This function is used by files term/*.el to set up the mapping from the
+escape sequences sent by function keys on particular terminals (FROMSTRINGs)
+into Emacs standard function key slots (TOCHARs).
+An actual definition (such as a symbol) may be given in place of TOCHAR.
+Generally, MAP is a prefix keymap which will be attached to a key
+that is the common prefix sent by all function keys (often ESC O or ESC [)."
+  (while translations
+    (define-key map (car (car translations))
+      (if (numberp (cdr (car translations)))
+         (cons function-keymap (cdr (car translations)))
+       (cdr (car translations))))
+    (setq translations (cdr translations))))
+
+(defun function-key-sequence (char)
+  "Return key sequence for function key that on this terminal
+translates into slot CHAR in function-keymap.
+Or return nil if there is none."
+  (car (where-is-internal (cons function-keymap char) (current-local-map))))
+
+(provide 'keypad)
diff --git a/usr/src/contrib/emacs-18.57/lisp/ledit.el b/usr/src/contrib/emacs-18.57/lisp/ledit.el

new file mode 100644 (file)

index 0000000..2cdca35
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/ledit.el
@@ -0,0 +1,138 @@
+;; Emacs side of ledit interface
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; To do:
+;;; o lisp -> emacs side of things (grind-definition and find-definition)
+
+(defvar ledit-mode-map nil)
+
+(defconst ledit-zap-file (concat "/tmp/" (getenv "USER") ".l1")
+  "File name for data sent to Lisp by Ledit.")
+(defconst ledit-read-file (concat "/tmp/" (getenv "USER") ".l2")
+  "File name for data sent to Ledit by Lisp.")
+(defconst ledit-compile-file 
+  (concat "/tmp/" (getenv "USER") ".l4")
+  "File name for data sent to Lisp compiler by Ledit.")
+(defconst ledit-buffer "*LEDIT*"
+  "Name of buffer in which Ledit accumulates data to send to Lisp.")
+;These are now in loaddefs.el
+;(defconst ledit-save-files t
+;  "*Non-nil means Ledit should save files before transferring to Lisp.")
+;(defconst ledit-go-to-lisp-string "%?lisp"
+;  "*Shell commands to execute to resume Lisp job.")
+;(defconst ledit-go-to-liszt-string "%?liszt"
+;  "*Shell commands to execute to resume Lisp compiler job.")
+
+(defun ledit-save-defun ()
+  "Save the current defun in the ledit buffer"
+  (interactive)
+  (save-excursion
+   (end-of-defun)
+   (let ((end (point)))
+     (beginning-of-defun)
+     (append-to-buffer ledit-buffer (point) end))
+   (message "Current defun saved for Lisp")))
+
+(defun ledit-save-region (beg end)
+  "Save the current region in the ledit buffer"
+  (interactive "r")
+  (append-to-buffer ledit-buffer beg end)
+  (message "Region saved for Lisp"))
+
+(defun ledit-zap-defun-to-lisp ()
+  "Carry the current defun to lisp"
+  (interactive)
+  (ledit-save-defun)
+  (ledit-go-to-lisp))
+
+(defun ledit-zap-defun-to-liszt ()
+  "Carry the current defun to liszt"
+  (interactive)
+  (ledit-save-defun)
+  (ledit-go-to-liszt))
+
+(defun ledit-zap-region-to-lisp (beg end)
+  "Carry the current region to lisp"
+  (interactive "r")
+  (ledit-save-region beg end)
+  (ledit-go-to-lisp))
+
+(defun ledit-go-to-lisp ()
+  "Suspend Emacs and restart a waiting Lisp job."
+  (interactive)
+  (if ledit-save-files
+      (save-some-buffers))
+  (if (get-buffer ledit-buffer)
+      (save-excursion
+       (set-buffer ledit-buffer)
+       (goto-char (point-min))
+       (write-region (point-min) (point-max) ledit-zap-file)
+       (erase-buffer)))
+  (suspend-emacs ledit-go-to-lisp-string)
+  (load ledit-read-file t t))
+
+(defun ledit-go-to-liszt ()
+  "Suspend Emacs and restart a waiting Liszt job."
+  (interactive)
+  (if ledit-save-files
+      (save-some-buffers))
+  (if (get-buffer ledit-buffer)
+      (save-excursion
+       (set-buffer ledit-buffer)
+       (goto-char (point-min))
+       (insert "(declare (macros t))\n")
+       (write-region (point-min) (point-max) ledit-compile-file)
+       (erase-buffer)))
+  (suspend-emacs ledit-go-to-liszt-string)
+  (load ledit-read-file t t))
+
+(defun ledit-setup ()
+  "Set up key bindings for the Lisp / Emacs interface"
+  (if (not ledit-mode-map)
+      (progn (setq ledit-mode-map (make-sparse-keymap))
+            (lisp-mode-commands ledit-mode-map)))
+  (define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
+  (define-key ledit-mode-map "\e\^r" 'ledit-save-region)
+  (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
+  (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
+
+(ledit-setup)
+
+(defun ledit-mode ()
+  "Major mode for editing text and stuffing it to a Lisp job.
+Like Lisp mode, plus these special commands:
+  M-C-d        -- record defun at or after point
+          for later transmission to Lisp job.
+  M-C-r -- record region for later transmission to Lisp job.
+  C-x z -- transfer to Lisp job and transmit saved text.
+  M-C-c -- transfer to Liszt (Lisp compiler) job
+          and transmit saved text.
+\\{ledit-mode-map}
+To make Lisp mode automatically change to Ledit mode,
+do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
+  (interactive)
+  (lisp-mode)
+  (ledit-from-lisp-mode))
+
+(defun ledit-from-lisp-mode ()
+  (use-local-map ledit-mode-map)
+  (setq mode-name "Ledit")
+  (setq major-mode 'ledit-mode)
+  (run-hooks 'ledit-mode-hook))
diff --git a/usr/src/contrib/emacs-18.57/lisp/life.el b/usr/src/contrib/emacs-18.57/lisp/life.el

new file mode 100644 (file)

index 0000000..16b0e71
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/life.el
@@ -0,0 +1,276 @@
+;; Conway's `Life' for GNU Emacs
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+;; Contributed by Kyle Jones, talos!kjones@uunet.uu.net
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(provide 'life)
+
+(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.
+;;
+;; The (require) wrapping forces the compiler to eval these macros at
+;; compile time.  This would not be necessary if we did not use macros
+;; inside of macros, which the compiler doesn't seem to check for.
+;;
+;; Don't change any of the life-* macro constants unless you thoroughly
+;; understand the `life-grim-reaper' function.
+(require
+ (progn
+   (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]"))
+
+   ;; try to optimize the (goto-char (point-min)) & (goto-char (point-max))
+   ;; idioms.  This depends on goto-char's not griping if we underrshoot
+   ;; or overshoot beginning or end of buffer.
+   (defmacro goto-beginning-of-buffer () '(goto-char 1))
+   (defmacro maxint () (lsh (lsh (lognot 0) 1) -1))
+   (defmacro goto-end-of-buffer () '(goto-char (maxint)))
+
+   (defmacro increment (variable) (list 'setq variable (list '1+ variable)))
+   'life))
+
+;; 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)
+
+(defun abs (n) (if (< n 0) (- n) n))
+
+(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 sleeptime (setq sleeptime 1))
+  (life-setup)
+  (life-display-generation sleeptime)
+  (while t
+    (let ((inhibit-quit t))
+      (life-grim-reaper)
+      (life-expand-plane-if-needed)
+      (life-increment-generation)
+      (life-display-generation sleeptime))))
+
+(fset 'life-mode 'life)
+(put 'life-mode 'mode-class 'special)
+
+(random t)
+
+(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-flush-undo (current-buffer))
+    ;; stuff in the random pattern
+    (life-insert-random-pattern)
+    ;; make sure (life-life-char) is used throughout
+    (goto-beginning-of-buffer)
+    (while (re-search-forward (life-not-void-regexp) nil t)
+      (replace-match (life-life-string) t t))
+    ;; center the pattern horizontally
+    (goto-beginning-of-buffer)
+    (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-beginning-of-buffer)
+    (newline n)
+    (goto-end-of-buffer)
+    (newline n)
+    ;; pad lines out to fill-column
+    (goto-beginning-of-buffer)
+    (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 (% (abs (random)) (length life-patterns))))
+  (insert ?\n))
+
+(defun life-increment-generation ()
+  (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-beginning-of-buffer)
+  ;; 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))
+              (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-beginning-of-buffer)
+    (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-beginning-of-buffer)
+            (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-beginning-of-buffer)
+  ;; 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-beginning-of-buffer)
+        (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-end-of-buffer)
+  ;; 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-end-of-buffer)
+        (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)
+  (sit-for sleeptime))
+
+(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")
+
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/lisp-mode.el b/usr/src/contrib/emacs-18.57/lisp/lisp-mode.el

new file mode 100644 (file)

index 0000000..860dc36
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/lisp-mode.el
@@ -0,0 +1,578 @@
+;; Lisp mode, and its idiosyncratic commands.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar 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)
+      (modify-syntax-entry ?\f ">   " 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)
+      (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)))
+
+(define-abbrev-table 'lisp-mode-abbrev-table ())
+
+(defun lisp-mode-variables (lisp-syntax)
+  (cond (lisp-syntax
+         (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)))
+         (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 'indent-line-function)
+  (setq indent-line-function 'lisp-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 40)
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'lisp-comment-indent))
+
+(defun lisp-mode-commands (map)
+  (define-key map "\e\C-q" 'indent-sexp)
+  (define-key map "\177" 'backward-delete-char-untabify)
+  (define-key map "\t" 'lisp-indent-line))
+\f
+(defvar emacs-lisp-mode-map () "")
+(if emacs-lisp-mode-map
+    ()
+   (setq emacs-lisp-mode-map (make-sparse-keymap))
+   (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun)
+   (lisp-mode-commands emacs-lisp-mode-map))
+
+(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 ())
+(if lisp-mode-map
+    ()
+  (setq lisp-mode-map (make-sparse-keymap))
+  (define-key lisp-mode-map "\e\C-x" 'lisp-send-defun)
+  (define-key lisp-mode-map "\C-c\C-l" 'run-lisp)
+  (lisp-mode-commands lisp-mode-map))
+
+(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-send-defun nil
+  "Send the current defun to the Lisp process made by M-x run-lisp."
+  (interactive)
+  (error "Process lisp does not exist"))
+
+(defvar lisp-interaction-mode-map ())
+(if lisp-interaction-mode-map
+    ()
+  (setq lisp-interaction-mode-map (make-sparse-keymap))
+  (lisp-mode-commands lisp-interaction-mode-map)
+  (define-key lisp-interaction-mode-map "\e\C-x" 'eval-defun)
+  (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)
+  (set-syntax-table emacs-lisp-mode-syntax-table)
+  (setq major-mode 'lisp-interaction-mode)
+  (setq mode-name "Lisp Interaction")
+  (lisp-mode-variables nil)
+  (run-hooks 'lisp-interaction-mode-hook))
+
+(defun eval-print-last-sexp (arg)
+  "Evaluate sexp before point; print value into current buffer."
+  (interactive "P")
+  (eval-region
+    (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)
+    (current-buffer)))
+\f
+(defun eval-last-sexp (arg)
+  "Evaluate sexp before point; print value in minibuffer.
+With argument, print output into current buffer."
+  (interactive "P")
+  (eval-region
+    (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)
+    (if arg (current-buffer) t)))
+
+(defun eval-defun (arg)
+  "Evaluate defun that point is in or before.
+Print value in minibuffer.
+With argument, insert value in current buffer after the defun."
+  (interactive "P")
+  (save-excursion
+    (end-of-defun)
+    (let ((end (point)))
+      (beginning-of-defun)
+      (eval-region (point) end
+                  (if arg (current-buffer) t)))))
+\f
+(defun lisp-comment-indent ()
+  (if (looking-at ";;;")
+      (current-column)
+    (if (looking-at ";;")
+       (let ((tem (calculate-lisp-indent)))
+         (if (listp tem) (car tem) tem))
+      (skip-chars-backward " \t")
+      (max (if (bolp) 0 (1+ (current-column)))
+          comment-column))))
+
+(defconst lisp-indent-offset nil "")
+(defconst lisp-indent-hook 'lisp-indent-hook "")
+
+(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 ";;;")
+       ;; Don't alter indentation of a ;;; comment line.
+       nil
+      (if (and (looking-at ";") (not (looking-at ";;")))
+         ;; 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)))))
+
+(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)
+          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 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 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 retry
+          nil
+        ;; Innermost containing sexp found
+        (goto-char (1+ containing-sexp))
+        (if (not 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) 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))
+                   last-sexp)
+                ;; This is the first line to start within the containing sexp.
+                ;; It's almost certainly a function call.
+                (if (= (point) 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) 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)))))
+      ;; Point is at the point to indent under unless we are inside a string.
+      ;; Call indentation hook except when overriden 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)
+               (+ normal-indent lisp-indent-offset))
+              (desired-indent)
+              ((and (boundp 'lisp-indent-hook)
+                    lisp-indent-hook
+                    (not retry))
+               (or (funcall lisp-indent-hook indent-point state)
+                   normal-indent))
+              (t
+               normal-indent))))))
+
+(defun lisp-indent-hook (indent-point state)
+  (let ((normal-indent (current-column)))
+    (goto-char (1+ (elt state 1)))
+    (parse-partial-sexp (point) 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))
+                      last-sexp))
+              (progn (goto-char last-sexp)
+                     (beginning-of-line)
+                     (parse-partial-sexp (point) last-sexp 0 t)))
+          ;; Indent under the list or under the first sexp on the
+          ;; same line as 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 (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)))))))
+
+(defconst lisp-body-indent 2 "")
+
+(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-hook 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)))))
+
+\f
+;; (put 'progn 'lisp-indent-hook 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-hook 'defun)
+(put 'progn 'lisp-indent-hook 0)
+(put 'prog1 'lisp-indent-hook 1)
+(put 'save-excursion 'lisp-indent-hook 0)
+(put 'save-window-excursion 'lisp-indent-hook 0)
+(put 'save-restriction 'lisp-indent-hook 0)
+(put 'let 'lisp-indent-hook 1)
+(put 'let* 'lisp-indent-hook 1)
+(put 'while 'lisp-indent-hook 1)
+(put 'if 'lisp-indent-hook 2)
+(put 'catch 'lisp-indent-hook 1)
+(put 'condition-case 'lisp-indent-hook 2)
+(put 'unwind-protect 'lisp-indent-hook 1)
+(put 'with-output-to-temp-buffer 'lisp-indent-hook 1)
+
+(defun 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)
+    ;; 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 (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)))
+       (if (or outer-loop-done (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)))
+         ;; 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 "[;\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))))))
+               (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)))))))))
+\f
+(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))))))
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/lisp.el b/usr/src/contrib/emacs-18.57/lisp/lisp.el

new file mode 100644 (file)

index 0000000..8ecf0f3
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/lisp.el
@@ -0,0 +1,237 @@
+;; Lisp editing commands for Emacs
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun forward-sexp (&optional arg)
+  "Move forward across one balanced expression.
+With argument, do this that many times."
+  (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.
+With argument, do this that many times."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (forward-sexp (- arg)))
+
+(defun mark-sexp (arg)
+  "Set mark ARG sexps from point."
+  (interactive "p")
+  (push-mark
+    (save-excursion
+      (forward-sexp arg)
+      (point))))
+
+(defun forward-list (&optional arg)
+  "Move forward across one balanced group of parentheses.
+With argument, do this that many times."
+  (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 this that many times."
+  (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."
+  (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."
+  (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."
+  (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 syntactic expression following the cursor.
+With argument, kill that many expressions after (or before) the cursor."
+  (interactive "p")
+  (let ((opoint (point)))
+    (forward-sexp arg)
+    (kill-region opoint (point))))
+
+(defun backward-kill-sexp (arg)
+  "Kill the syntactic expression preceding the cursor.
+With argument, kill that many expressions before (or after) the cursor."
+  (interactive "p")
+  (kill-sexp (- arg)))
+\f
+(defun 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")
+  (and arg (< arg 0) (forward-char 1))
+  (and (re-search-backward "^\\s(" nil 'move (or arg 1))
+       (progn (beginning-of-line) 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.
+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 ((first t))
+    (while (and (> arg 0) (< (point) (point-max)))
+      (let ((pos (point)) npos)
+       (while (progn
+               (if (and first
+                        (progn
+                         (forward-char 1)
+                         (beginning-of-defun 1)))
+                   nil
+                 (or (bobp) (forward-char -1))
+                 (beginning-of-defun -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)))
+       (beginning-of-defun 1)
+       (forward-sexp 1)
+       (forward-line 1)
+       (if (>= (point) pos)
+           (if (beginning-of-defun 2)
+               (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-defun ()
+  "Put mark at end of defun, point at beginning."
+  (interactive)
+  (push-mark (point))
+  (end-of-defun)
+  (push-mark (point))
+  (beginning-of-defun)
+  (re-search-backward "^\n" (- (point) 1) t))
+
+(defun insert-parentheses (arg)
+  "Put parentheses around next ARG sexps.  Leave point after open-paren.
+No argument is equivalent to zero: just insert () and leave point between."
+  (interactive "P")
+;Install these commented-out lines for version 19.
+;  (if arg (skip-chars-forward " \t")
+;    (or (memq (char-syntax (preceding-char)) '(?\  ?> ?\( ))
+;      (insert " ")))
+  (insert ?\()
+  (save-excursion
+    (if arg
+       (forward-sexp (prefix-numeric-value arg)))
+    (insert ?\))
+;    (or (memq (char-syntax (following-char)) '(?\  ?> ?\( ))
+;      (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))
+\f
+(defun 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
+                   (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)))
+            (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")))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/loaddefs.el b/usr/src/contrib/emacs-18.57/lisp/loaddefs.el

new file mode 100644 (file)

index 0000000..ba98878
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/loaddefs.el
@@ -0,0 +1,1941 @@
+;; Define standard autoloads and keys of other files, for Emacs.
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+;;; 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.
+;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+;; Know which function the debugger is!
+(setq debugger 'debug)
+
+(defconst mode-line-buffer-identification (purecopy '("Emacs: %17b")) "\
+Mode-line control for identifying the buffer being displayed.
+Its default value is \"Emacs: %17b\".  Major modes that edit things
+other than ordinary files may change this (e.g. Info, Dired,...)")
+
+(make-variable-buffer-local 'mode-line-buffer-identification)
+
+(defconst 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)
+
+(defconst 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 'minor-mode-alist "%n" 'mode-line-process
+   (purecopy ")%]----")
+   (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.")
+(setq minor-mode-alist (mapcar 'purecopy
+                              '((abbrev-mode " Abbrev")
+                                (overwrite-mode " Ovwrt")
+                                (auto-fill-hook " Fill")
+                                ;; not really a minor mode...
+                                (defining-kbd-macro " Def"))))
+
+(defconst function-keymap (make-sparse-keymap) "\
+Keymap containing definitions of keypad and function keys.")
+
+;; These variables are used by autoloadable packages.
+;; They are defined here so that they do not get overridden
+;; by the loading of those packages.
+
+(defconst paragraph-start "^[ \t\n\f]" "\
+*Regexp for beginning of a line that starts OR separates paragraphs.")
+(defconst 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.")
+
+(defconst sentence-end   (purecopy "[.?!][]\"')}]*\\($\\|\t\\|  \\)[ \t\n]*") "\
+*Regexp describing the end of a sentence.
+All paragraph boundaries also end sentences, regardless.")
+
+(defconst page-delimiter "^\014" "\
+*Regexp describing line-beginnings that separate pages.")
+
+(defconst case-replace t "\
+*Non-nil means query-replace should preserve case in replacements.")
+
+;; indent.el may not be autoloading, but it still loses
+;; if lisp-mode is ever called before this defvar is done.
+(defvar indent-line-function 'indent-to-left-margin "\
+Function to indent current line.")
+
+(defconst 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.")
+
+;; 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
+      (if (eq system-type 'vax-vms)
+         '(".obj" ".elc" ".exe" ".bin" ".lbin"
+           ".dvi" ".toc" ".log" ".aux"
+           ".lof" ".brn" ".rnt" ".mem" ".lni" ".lis"
+           ".olb" ".tlb" ".mlb" ".hlb" ".glo" ".idx" ".lot")
+       '(".o" ".elc" "~" ".bin" ".lbin" ".fasl"
+         ".dvi" ".toc" ".log" ".aux"
+         ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot")))
+
+(defvar compile-command "make -k" "\
+*Last shell command used to do a compilation; default for next compilation.")
+
+(defvar dired-listing-switches "-al" "\
+*Switches passed to ls for Dired.  MUST contain the `l' option.
+MUST NOT contain the `F, `s' or `i'' option.")
+
+(defconst lpr-switches nil "\
+*List of strings to pass as extra switch args to lpr when it is invoked.")
+
+(defvar tags-file-name nil "\
+*File name of tag table.
+To switch to a new tag table, setting this variable is sufficient.
+Use the `etags' program to make a tag table file.")
+
+(defconst shell-prompt-pattern "^[^#$%>]*[#$%>] *" "\
+*Regexp used by Newline command in shell mode to match subshell prompts.
+Anything from beginning of line up to the end of what this pattern matches
+is deemed to be prompt, and is not reexecuted.")
+
+(defconst ledit-save-files t "\
+*Non-nil means Ledit should save files before transferring to Lisp.")
+(defconst ledit-go-to-lisp-string "%?lisp" "\
+*Shell commands to execute to resume Lisp job.")
+(defconst ledit-go-to-liszt-string "%?liszt" "\
+*Shell commands to execute to resume Lisp compiler job.")
+
+(defconst display-time-day-and-date nil "\
+*Non-nil means M-x display-time should display day and date as well as time.")
+
+;;; Determine mode according to filename
+
+(defvar auto-mode-alist nil "\
+Alist of filename patterns vs corresponding major mode functions.
+Each element looks like (REGEXP . FUNCTION).
+Visiting a file whose name matches REGEXP causes FUNCTION to be called.")
+(setq auto-mode-alist (mapcar 'purecopy
+                             '(("\\.text$" . text-mode)
+                               ("\\.c$" . c-mode)
+                               ("\\.h$" . c-mode)
+                               ("\\.tex$" . TeX-mode)
+                               ("\\.el$" . emacs-lisp-mode)
+                               ("\\.scm$" . scheme-mode)
+                               ("\\.l$" . lisp-mode)
+                               ("\\.lisp$" . lisp-mode)
+                               ("\\.f$" . fortran-mode)
+                               ("\\.mss$" . scribe-mode)
+                               ("\\.pl$" . prolog-mode)
+;;; Less common extensions come here
+;;; so more common ones above are found faster.
+                               ("\\.TeX$" . TeX-mode)
+                               ("\\.sty$" . LaTeX-mode)
+                               ("\\.bbl$" . LaTeX-mode)
+                               ("\\.bib$" . text-mode)
+                               ("\\.article$" . text-mode)
+                               ("\\.letter$" . text-mode)
+                               ("\\.texinfo$" . texinfo-mode)
+                               ("\\.lsp$" . lisp-mode)
+                               ("\\.prolog$" . prolog-mode)
+                               ;; Mailer puts message to be edited in /tmp/Re.... or Message
+                               ("^/tmp/Re" . text-mode)
+                               ;; some news reader is reported to use this
+                               ("^/tmp/fol/" . text-mode)
+                               ("/Message[0-9]*$" . text-mode)
+                               ("\\.y$" . c-mode)
+                               ("\\.cc$" . c-mode)
+                               ("\\.scm.[0-9]*$" . scheme-mode)
+                               ;; .emacs following a directory delimiter
+                               ;; in either Unix or VMS syntax.
+                               ("[]>:/]\\..*emacs" . emacs-lisp-mode)
+                               ("\\.ml$" . lisp-mode))))
+
+(make-variable-buffer-local 'indent-tabs-mode)
+
+(defvar ctl-x-4-map (make-keymap) "\
+Keymap for subcommands of C-x 4")
+
+;; Reduce total amount of space we must allocate during this function
+;; that we will not need to keep permanently.
+(garbage-collect)
+\f
+;; Autoload random libraries.
+;; Alphabetical order by library name.
+
+(autoload 'add-change-log-entry "add-log"
+  "\
+Find change log file and add an entry for today.
+First arg (interactive prefix) non-nil means prompt for user name and site.
+Second arg is file name of change log.
+Optional third arg OTHER-WINDOW non-nil means visit in other window."
+  t)
+
+(define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
+
+(autoload 'add-change-log-entry-other-window "add-log"
+  "\
+Find change log file in other window, and add an entry for today."
+  t)
+
+(autoload '\` "backquote"
+  "\
+\(` FORM) Expands to a form that will generate FORM.
+FORM is `almost quoted' -- see backquote.el for a description."
+  nil t)
+
+(autoload 'byte-compile-file "bytecomp"
+  "\
+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."
+  t)
+
+(autoload 'byte-recompile-directory "bytecomp"
+  "\
+Recompile every .el file in DIRECTORY that needs recompilation.
+This is if a .elc file exists but is older than the .el file.
+If the .elc file does not exist, offer to compile the .el file
+only if a prefix argument has been specified."
+  t)
+
+(autoload 'batch-byte-compile "bytecomp"
+  "\
+Runs byte-compile-file 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-byte-compile $emacs/ ~/*.el\""
+  nil)
+
+(autoload 'calendar "cal"
+  "\
+Display 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.
+
+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.
+
+The Gregorian calendar is assumed.
+
+After preparing the calendar window, the hooks calendar-hook are run
+when the calendar is for the current month--that is, the was no prefix
+argument.  If the calendar is for a future or past month--that is, there
+was a prefix argument--the hooks offset-calendar-hook are run.  Thus, for
+example, setting calendar-hooks to 'star-date will cause today's date to be
+replaced by asterisks to highlight it in the window."
+  t)
+
+(autoload 'list-command-history "chistory"
+  "\
+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."
+  t)
+
+(autoload 'command-history-mode "chistory"
+  "\
+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.
+
+Like Emacs-Lisp Mode except that characters do not insert themselves 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."
+  t)
+
+(autoload 'repeat-matching-complex-command "chistory"
+  "\
+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."
+  t)
+
+
+(autoload 'common-lisp-indent-hook "cl-indent")
+
+(autoload 'compare-windows "compare-w"
+  "\
+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."
+  t)
+
+(autoload 'compile "compile"
+  "\
+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."
+  t)
+
+(autoload 'grep "compile"
+  "\
+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."
+  t)
+
+(define-key ctl-x-map "`" 'next-error)
+
+(autoload 'next-error "compile"
+  "\
+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 non-nil argument (prefix arg, if interactive)
+means reparse the error message buffer and start at the first error."
+  t)
+
+(define-key esc-map "/" 'dabbrev-expand)
+
+(autoload 'dabbrev-expand "dabbrev"
+  "\
+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.
+
+A positive prefix argument, N, says to take the Nth backward DISTINCT
+possibility.  A negative argument says search forward.  The variable
+dabbrev-backward-only may be used to limit the direction of search to
+backward if set non-nil.
+
+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."
+  t)
+
+(autoload 'debug "debug"
+  "\
+Enter debugger.  Returns if user says \"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.")
+
+(autoload 'cancel-debug-on-entry "debug"
+  "\
+Undoes effect of debug-on-entry on FUNCTION."
+  t)
+
+(autoload 'debug-on-entry "debug"
+  "\
+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."
+  t)
+
+(define-key ctl-x-map "d" 'dired)
+
+(autoload 'dired "dired"
+  "\
+\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
+Dired displays a list of files in DIRNAME.
+You can move around in it with the usual commands.
+You can flag files for deletion with C-d
+and then delete them by typing `x'.
+Type `h' after entering dired for more info."
+  t)
+
+(define-key ctl-x-4-map "d" 'dired-other-window)
+
+(autoload 'dired-other-window "dired"
+  "\
+\"Edit\" directory DIRNAME.  Like \\[dired] but selects in another window."
+  t)
+
+(autoload 'dired-noselect "dired"
+  "\
+Like M-x dired but returns the dired buffer as value, does not select it.")
+
+(autoload 'dissociated-press "dissociate"
+  "\
+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."
+  t)
+
+(autoload 'doctor "doctor"
+  "\
+Switch to *doctor* buffer and start giving psychotherapy."
+  t)
+
+(autoload 'disassemble "disass"
+  "\
+Print disassembled code for OBJECT on (optional) STREAM.
+OBJECT can be a function name, lambda expression or any function object
+returned by SYMBOL-FUNCTION.  If OBJECT is not already compiled, we will
+compile it (but not redefine it)."
+  t)
+
+(autoload 'electric-buffer-list "ebuff-menu"
+  "\
+Vaguely like ITS lunar select buffer;
+combining typeoutoid buffer listing with menuoid buffer selection.
+
+This pops up a buffer describing the set of emacs buffers.
+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 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}"
+  t)
+
+
+(autoload 'electric-command-history "echistory"
+  "\
+Major mode for examining and redoing commands from  command-history.
+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.
+
+This pops up a window with the Command History listing.  If the very
+next character typed is Space, the listing is killed and the previous
+window configuration is restored.  Otherwise, you can browse in the
+Command History with  Return  moving down and  Delete  moving up, possibly
+selecting an expression to be redone with Space or quitting with `Q'.
+
+Like Emacs-Lisp Mode except that characters do not insert themselves and
+Tab and linefeed do not indent.  Instead these commands are provided:
+Space or !     edit then evaluate current line in history inside
+                  the ORIGINAL buffer which invoked this mode.
+                  The previous window configuration is restored
+                  unless the invoked command changes it.
+C-c C-c, C-], Q        Quit and restore previous window configuration.
+LFD, RET       Move to the next line in the history.
+DEL            Move to the previous line in the history.
+?              Provides a complete list of commands.
+
+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."
+  t)
+
+(autoload 'edt-emulation-on "edt"
+  "\
+Begin emulating DEC's EDT editor.
+Certain keys are rebound; including nearly all keypad keys.
+Use \\[edt-emulation-off] to undo all rebindings except the keypad keys.
+Note that this function does not work if called directly from the .emacs file.
+Instead, the .emacs file should do (setq term-setup-hook 'edt-emulation-on)
+Then this function will be called at the time when it will work."
+  t)
+
+(autoload 'fortran-mode "fortran"
+  "\
+Major mode for editing fortran code.
+Tab 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.
+
+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-continuation-indent
+    Extra indentation appled to continuation statements.  (default 5)
+ fortran-comment-line-column
+    Amount of indentation for text within full-line comments. (default 6)
+ fortran-comment-indent-style
+    nil    means don't change indentation of text in full-line comments,
+    fixed  means indent that text at column fortran-comment-line-column
+    relative  means indent at fortran-comment-line-column beyond the
+             indentation for a line of code.
+    Default value is fixed.
+ fortran-comment-indent-char
+    Character to be inserted instead of space for full-line comment
+    indentation.  (default is a space)
+ fortran-minimum-statement-indent
+    Minimum indentation for fortran statements. (default 6)
+ 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-continuation-char
+    character 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-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.
+\\{fortran-mode-map}"
+  t)
+
+(autoload 'ftp-find-file "ftp"
+  "\
+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)"
+  t)
+
+(autoload 'ftp-write-file "ftp"
+  "\
+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)"
+  t)
+\f
+(autoload 'gdb "gdb"
+  "\
+Run gdb on program FILE in buffer *gdb-FILE*.
+The directory containing FILE becomes the initial working directory
+and source-file directory for GDB.  If you wish to change this, use
+the GDB commands `cd DIR' and `directory'."
+  t)
+
+(autoload 'set-gosmacs-bindings "gosmacs"
+  "\
+Rebind some keys globally to make GNU Emacs resemble Gosling Emacs.
+Use \\[set-gnu-bindings] to restore previous global bindings."
+  t)
+
+(autoload 'hanoi "hanoi"
+  "\
+Towers of Hanoi diversion.  Argument is number of rings."
+  t)
+
+(autoload 'Helper-help "helper"
+  "\
+Provide help for current mode."
+  t)
+
+(autoload 'Helper-describe-bindings "helper"
+  "\
+Describe local key bindings of current mode."
+  t)
+
+(autoload 'info "info"
+  "\
+Enter Info, the documentation browser."
+  t)
+
+(autoload 'Info-tagify "informat"
+  "\
+Create or update Info-file tag table in current buffer."
+  t)
+
+(autoload 'Info-validate "informat"
+  "\
+Check current buffer for validity as an Info file.
+Check that every node pointer points to an existing node."
+  t)
+
+(autoload 'Info-split "informat"
+  "\
+Split an info file into an indirect file plus bounded-size subfiles.
+Each subfile will be up to 50000 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."
+  t)
+
+(autoload 'batch-info-validate "informat"
+  "\
+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\""
+  nil)
+
+(autoload 'ledit-mode "ledit"
+  "\
+Major mode for editing text and stuffing it to a Lisp job.
+Like Lisp mode, plus these special commands:
+  M-C-d        -- record defun at or after point
+          for later transmission to Lisp job.
+  M-C-r -- record region for later transmission to Lisp job.
+  C-x z -- transfer to Lisp job and transmit saved text.
+  M-C-c -- transfer to Liszt (Lisp compiler) job
+          and transmit saved text.
+\\{ledit-mode-map}
+To make Lisp mode automatically change to Ledit mode,
+do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
+  t)
+
+(autoload 'ledit-from-lisp-mode "ledit")
+
+(autoload 'lpr-buffer "lpr"
+  "\
+Print buffer contents as with Unix command `lpr'.
+`lpr-switches' is a list of extra switches (strings) to pass to lpr."
+  t)
+
+(autoload 'print-buffer "lpr"
+  "\
+Print buffer contents as with Unix command `lpr -p'.
+`lpr-switches' is a list of extra switches (strings) to pass to lpr."
+  t)
+
+(autoload 'lpr-region "lpr"
+  "\
+Print region contents as with Unix command `lpr'.
+`lpr-switches' is a list of extra switches (strings) to pass to lpr."
+  t)
+
+(autoload 'print-region "lpr"
+  "\
+Print region contents as with Unix command `lpr -p'.
+`lpr-switches' is a list of extra switches (strings) to pass to lpr."
+  t)
+
+(autoload 'insert-kbd-macro "macros"
+  "\
+Insert in buffer the definition of kbd macro NAME, as Lisp code.
+Second argument KEYS non-nil means also record the keys it is on.
+ (This is the prefix argument, when calling interactively.)
+
+This Lisp code will, when executed, define the kbd macro with the
+same definition it has now.  If you say to record the keys,
+the Lisp code will also rebind those keys to the macro.
+Only global key bindings are recorded since executing this Lisp code
+always makes global bindings.
+
+To save a kbd macro, visit a file of Lisp code such as your ~/.emacs,
+use this command, and then save the file."
+  t)
+
+(define-key ctl-x-map "q" 'kbd-macro-query)
+
+(autoload 'kbd-macro-query "macros"
+  "\
+Query user during kbd macro execution.
+With prefix argument, enters recursive edit,
+ reading keyboard commands even within a kbd macro.
+ You can give different commands each time the macro executes.
+Without prefix argument, reads a character.  Your options are:
+ Space -- execute the rest of the macro.
+ DEL -- skip the rest of the macro; start next repetition.
+ C-d -- skip rest of the macro and don't repeat it any more.
+ C-r -- enter a recursive edit, then on exit ask again for a character
+ C-l -- redisplay screen and ask again."
+  t)
+
+(autoload 'name-last-kbd-macro "macros"
+  "\
+Assign a name to the last keyboard macro defined.
+One arg, a symbol, which is the name to define.
+The symbol's function definition becomes the keyboard macro string.
+Such a \"function\" cannot be called from Lisp, but it is a valid command
+definition for the editor command loop."
+  t)
+
+(autoload 'make-command-summary "makesum"
+  "\
+Make a summary of current key bindings in the buffer *Summary*.
+Previous contents of that buffer are killed first."
+  t)
+
+(autoload 'define-mail-alias "mailalias"
+  "\
+Define NAME as a mail-alias that translates to DEFINITION."
+  t)
+
+(autoload 'manual-entry "man"
+  "\
+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)'."
+  t)
+
+(autoload 'mh-rmail "mh-e"
+  "\
+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."
+  t)
+
+(autoload 'mh-smail "mh-e"
+  "\
+Send mail using the MH mail system."
+  t)
+
+(autoload 'convert-mocklisp-buffer "mlconvert"
+  "\
+Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run."
+  t)
+
+(autoload 'modula-2-mode "modula2"
+  "\
+This is a mode intended to support program development in Modula-2.
+All control constructs of Modula-2 can be reached by typing
+Control-C followed by the first character of the construct.
+\\{m2-mode-map}
+  Control-c b begin         Control-c c case
+  Control-c d definition    Control-c e else
+  Control-c f for           Control-c h header
+  Control-c i if            Control-c m module
+  Control-c l loop          Control-c o or
+  Control-c p procedure     Control-c Control-w with
+  Control-c r record        Control-c s stdio
+  Control-c t type          Control-c u until
+  Control-c v var           Control-c w while
+  Control-c x export        Control-c y import
+  Control-c { begin-comment Control-c } end-comment
+  Control-c Control-z suspend-emacs     Control-c Control-t toggle
+  Control-c Control-c compile           Control-x ` next-error
+  Control-c Control-l 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."
+  t)
+
+(setq disabled-command-hook 'disabled-command-hook)
+
+(autoload 'disabled-command-hook "novice")
+(autoload 'enable-command "novice"
+  "\
+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." t)
+
+(autoload 'disable-command "novice"
+  "\
+Require special confirmation to execute COMMAND from now on.
+The user's .emacs file is altered so that this will apply
+to future sessions." t)
+
+(autoload 'nroff-mode "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."
+  t)
+
+(autoload 'list-options "options"
+  "\
+Display a list of Emacs user options, with values and documentation."
+  t)
+
+(autoload 'edit-options "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."
+  t)
+
+(autoload 'outline-mode "outline"
+  "\
+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:
+C-c C-n   outline-next-visible-heading      move by visible headings
+C-c C-p   outline-previous-visible-heading
+C-c C-f   outline-forward-same-level        similar but skip subheadings
+C-c C-b   outline-backward-same-level
+C-c C-u   outline-up-heading               move from subheading to heading
+
+Meta-x hide-body       make all text invisible (not headings).
+Meta-x 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.
+C-c C-h   hide-subtree make body and subheadings invisible.
+C-c C-s   show-subtree make body and subheadings visible.
+C-c C-i   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.
+M-x hide-entry    make immediately following body invisible.
+M-x show-entry    make it visible.
+M-x hide-leaves           make body under heading and under its subheadings invisible.
+                    The subheadings remain visible.
+M-x 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."
+  t)
+
+(autoload 'edit-picture "picture"
+  "\
+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:
+  C-p    Move vertically to SAME column in previous line.
+  C-n    Move vertically to SAME column in next line.
+  C-e    Move to column following last non-whitespace character.
+  C-f    Move right inserting spaces if required.
+  C-b    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 charecter.
+           `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.
+  Delete  Clear (replace) ARG columns before point, moving back over them.
+  C-k    Clear ARG lines, advancing over them.  The cleared
+           text is saved in the kill ring.
+  C-o    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  edit-picture-hook  if non-nil.
+
+Note that Picture mode commands will work outside of Picture mode, but
+they are not defaultly assigned to keys."
+  t)
+
+(fset 'picture-mode 'edit-picture)
+
+(autoload 'prolog-mode "prolog"
+  "\
+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."
+  t)
+
+(autoload 'run-prolog "prolog"
+  "\
+Run an inferior Prolog process, input and output via buffer *prolog*."
+  t)
+
+
+(autoload 'clear-rectangle "rect"
+  "\
+Blank out rectangle with corners at point and mark.
+The text previously in the region is overwritten by the blanks."
+  t)
+
+(autoload 'delete-rectangle "rect"
+  "\
+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."
+  t)
+
+(autoload 'delete-extract-rectangle "rect"
+  "\
+Return and delete contents of rectangle with corners at START and END.
+Value is list of strings, one for each line of the rectangle.")
+
+(autoload 'extract-rectangle "rect"
+  "\
+Return contents of rectangle with corners at START and END.
+Value is list of strings, one for each line of the rectangle.")
+
+(autoload 'insert-rectangle "rect"
+  "\
+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.")
+
+(autoload 'kill-rectangle "rect"
+  "\
+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."
+  t)
+
+(autoload 'open-rectangle "rect"
+  "\
+Blank out rectangle with corners at point and mark, shifting text right.
+The text previously in the region is not overwritten by the blanks,
+but insted winds up to the right of the rectangle."
+  t)
+
+(autoload 'yank-rectangle "rect"
+  "\
+Yank the last killed rectangle with upper left corner at point."
+  t)
+\f
+(autoload 'rnews "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."
+  t)
+
+(autoload 'news-post-news "rnewspost"
+  "\
+Begin editing a new USENET news article to be posted.
+Type \\[describe-mode] once editing the article to get a list of commands."
+  t)
+(fset 'sendnews 'news-post-news)
+(fset 'postnews 'news-post-news)
+
+(autoload 'rmail "rmail"
+  "\
+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 filename as argument;
+then performs rmail editing on that file,
+but does not copy any new mail into the file."
+  t)
+
+(autoload 'rmail-input "rmail"
+  "\
+Run RMAIL on file FILENAME."
+  t)
+
+(defconst rmail-dont-reply-to-names nil "\
+*A regular expression specifying names to prune in replying to messages.
+nil means don't reply to yourself.")
+
+(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 customisation file.")
+
+(defconst rmail-primary-inbox-list  nil "\
+*List of files which are inboxes for user's primary mail file ~/RMAIL.
+`nil' means the default, which is (\"~/mbox\" \"/usr/spool/mail/$USER\")
+(the second name varies depending on the operating system).")
+
+(defconst rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^[a-z-]*message-id:\\|^summary-line:\\|^errors-to:" "\
+*Gubbish header fields one would rather not see.")
+
+(defvar rmail-delete-after-output nil "\
+*Non-nil means automatically delete a message that is copied to a file.")
+
+;;; Others are in paths.el.
+\f
+(autoload 'run-scheme "xscheme"
+  "\
+Run an inferior Scheme process.
+Output goes to the buffer `*scheme*'.
+With argument, asks for a command line."
+  t)
+
+(autoload 'scheme-mode "scheme"
+  "\
+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."
+  t)
+
+(autoload 'scribe-mode "scribe"
+  "\
+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."
+  t)
+
+;; Useful to set in site-init.el
+(defconst send-mail-function 'sendmail-send-it "\
+Function to call to send the current buffer as mail.
+The headers are delimited by a string found in mail-header-separator.")
+
+(defconst 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.")
+
+(defconst 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.")
+
+(defconst mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^[a-z-]*message-id:\\|^summary-line:\\|^to:\\|^cc:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\
+Delete these headers from old message when it's inserted in a reply.")
+
+(defconst mail-header-separator "--text follows this line--" "\
+*Line used to separate headers from text in messages being composed.")
+
+(defconst mail-archive-file-name nil "\
+*Name of file to write all outgoing messages in, or nil for none.")
+
+(defvar mail-aliases t "\
+Alias of mail address aliases,
+or t meaning should be initialized from .mailrc.")
+
+(autoload 'mail-other-window "sendmail"
+  "\
+Like `mail' command, but display mail buffer in another window."
+  t)
+
+(autoload 'mail "sendmail"
+  "\
+Edit a message to be sent.  Argument means resume editing (don't erase).
+Returns with message buffer selected; value t if message freshly initialized.
+While editing message, type C-c C-c 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.
+
+If mail-setup-hook is bound, its value is called with no arguments
+after the message is initialized.  It can add more default fields.
+
+When calling from a program, 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 whose contents
+ should be yanked if the user types C-c C-y."
+  t)
+
+(define-key ctl-x-4-map "m" 'mail-other-window)
+(define-key ctl-x-map "m" 'mail)
+
+;; used in mail-utils
+(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.")
+
+\f
+(autoload 'server-start "server"
+  "\
+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 `etc/emacsclient' in the
+Emacs distribution as your standard \"editor\".
+
+Prefix arg means just kill any existing server communications subprocess."
+  t)
+
+(autoload 'run-lisp "shell"
+  "\
+Run an inferior Lisp process, input and output via buffer *lisp*."
+  t)
+
+(autoload 'shell "shell"
+  "\
+Run an inferior shell, with I/O through buffer *shell*.
+If buffer exists but shell process is not running, make new 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 variable shell-prompt-pattern.
+
+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.
+
+Note that many people's .cshrc files unconditionally clear the prompt.
+If yours does, you will probably want to change it."
+  t)
+
+(autoload 'sort-lines "sort"
+  "\
+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)."
+  t)
+
+(autoload 'sort-paragraphs "sort"
+  "\
+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)."
+  t)
+
+(autoload 'sort-pages "sort"
+  "\
+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)."
+  t)
+
+(autoload 'sort-numeric-fields "sort"
+  "\
+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 -ARG'th field, in reverse order.
+Called from a program, there are three arguments:
+FIELD, BEG and END.  BEG and END specify region to sort."
+  t)
+
+(autoload 'sort-fields "sort"
+  "\
+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 -ARG'th field, in reverse order.
+Called from a program, there are three arguments:
+FIELD, BEG and END.  BEG and END specify region to sort."
+  t)
+
+(autoload 'sort-columns "sort"
+  "\
+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.
+
+Note that sort-columns uses the sort utility program and therefore
+cannot work on text containing TAB characters.  Use M-x untabify
+to convert tabs to spaces before sorting."
+  t)
+
+(autoload 'sort-regexp-fields "sort"
+  "\
+Sort the region lexicographically as specifed 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.
+
+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 \"\\<f\\w*\\>\""
+  t)
+
+\f
+(autoload 'spell-buffer "spell"
+  "\
+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."
+  t)
+
+(autoload 'spell-region "spell"
+  "\
+Like spell-buffer but applies only to region.
+From program, applies from START to END."
+  t)
+
+(define-key esc-map "$" 'spell-word)
+(autoload 'spell-word "spell"
+  "\
+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."
+  t)
+
+(autoload 'spell-string "spell"
+  "\
+Check spelling of string supplied as argument."
+  t)
+
+(autoload 'untabify "tabify"
+  "\
+Convert all tabs in region to multiple spaces, preserving columns.
+The variable tab-width controls the action."
+  t)
+
+(autoload 'tabify "tabify"
+  "\
+Convert multiple spaces in region to tabs when possible.
+A group of spaces is partially replaced by tabs
+when this can be done without changing the column they end at.
+The variable tab-width controls the action."
+  t)
+
+(define-key esc-map "." 'find-tag)
+
+(autoload 'find-tag "tags"
+  "\
+Find tag (in current tag table) whose name contains TAGNAME.
+ Selects the buffer that the tag is contained in
+and puts point at its definition.
+ If TAGNAME is a null string, the expression in the buffer
+around or before point is used as the tag name.
+ If second arg NEXT is non-nil (interactively, with prefix arg),
+searches for the next tag in the tag table
+that matches the tagname used in the previous find-tag.
+
+See documentation of variable tags-file-name."
+  t)
+
+(define-key ctl-x-4-map "." 'find-tag-other-window)
+
+(autoload 'find-tag-other-window "tags"
+  "\
+Find tag (in current tag table) whose name contains TAGNAME.
+ Selects the buffer that the tag is contained in in another window
+and puts point at its definition.
+ If TAGNAME is a null string, the expression in the buffer
+around or before point is used as the tag name.
+ If second arg NEXT is non-nil (interactively, with prefix arg),
+searches for the next tag in the tag table
+that matches the tagname used in the previous find-tag.
+
+See documentation of variable tags-file-name."
+  t)
+
+(autoload 'list-tags "tags"
+  "\
+Display list of tags in file FILE.
+FILE should not contain a directory spec
+unless it has one in the tag table."
+  t)
+
+(autoload 'next-file "tags"
+  "\
+Select next file among files in current tag table.
+Non-nil argument (prefix arg, if interactive)
+initializes to the beginning of the list of files in the tag table."
+  t)
+
+(autoload 'tags-apropos "tags"
+  "\
+Display list of all tags in tag table REGEXP matches."
+  t)
+
+(define-key esc-map "," 'tags-loop-continue)
+(autoload 'tags-loop-continue "tags"
+  "\
+Continue last \\[tags-search] or \\[tags-query-replace] command.
+Used noninteractively with non-nil argument
+to begin such a command.  See variable tags-loop-form."
+  t)
+
+(autoload 'tag-table-files "tags"
+  "\
+Return a list of files in the current tag table.
+File names returned are absolute.")
+
+(autoload 'tags-query-replace "tags"
+  "\
+Query-replace-regexp FROM with TO through all files listed in tag table.
+Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
+If you exit (C-G or ESC), you can resume the query-replace
+with the command \\[tags-loop-continue].
+
+See documentation of variable tags-file-name."
+  t)
+
+(autoload 'tags-search "tags"
+  "\
+Search through all files listed in tag 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."
+  t)
+
+(autoload 'visit-tags-table "tags"
+  "\
+Tell tags commands to use tag 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."
+  t)
+
+(autoload 'telnet "telnet"
+  "\
+Open a network login connection to host named HOST (a string).
+Communication with HOST is recorded in a buffer *HOST-telnet*.
+Normally input is edited in Emacs and sent a line at a time."
+  t)
+
+(autoload 'terminal-emulator "terminal"
+  "\
+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.
+
+Presently with `termcap' only; if somebody sends us code to make this
+work with `terminfo' we will try to use it."
+  t)
+
+(autoload 'latex-mode "tex-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-print] prints the .dvi file made by either of these.
+
+Use \\[validate-TeX-buffer] to check buffer for paragraphs containing
+mismatched $'s or braces.
+
+Special commands:
+\\{TeX-mode-map}
+
+Mode variables:
+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-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 calls the value of text-mode-hook,
+then the value of TeX-mode-hook, and then the value
+of LaTeX-mode-hook."
+  t)
+
+(autoload 'plain-tex-mode "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-print] prints the .dvi file made by either of these.
+
+Use \\[validate-TeX-buffer] to check buffer for paragraphs containing
+mismatched $'s or braces.
+
+Special commands:
+\\{TeX-mode-map}
+
+Mode variables:
+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-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 calls the value of text-mode-hook,
+then the value of TeX-mode-hook, and then the value
+of plain-TeX-mode-hook."
+  t)
+
+(autoload 'tex-mode "tex-mode"
+  "\
+Major mode for editing files of input for TeX or LaTeX.
+Trys to intuit whether this file is for plain TeX or LaTeX and
+calls plain-tex-mode or latex-mode.  If it cannot be determined
+(e.g., there are no commands in the file), the value of
+TeX-default-mode is used."
+  t)
+
+(fset 'TeX-mode 'tex-mode)
+(fset 'plain-TeX-mode 'plain-tex-mode)
+(fset 'LaTeX-mode 'latex-mode)
+
+(autoload 'texinfo-mode "texinfo"
+  "\
+Major mode for editing texinfo files.
+These are files that are input for TEX and also to be turned
+into Info files by \\[texinfo-format-buffer].
+These files must be written in a very restricted and
+modified version of TEX input format.
+
+As for editing commands, like text-mode except for syntax table,
+which is set up so expression commands skip texinfo bracket groups."
+  t)
+
+(autoload 'texinfo-format-buffer "texinfmt"
+  "\
+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."
+  t)
+
+(autoload 'texinfo-format-region "texinfmt"
+  "\
+Convert the 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."
+  t)
+
+(autoload 'batch-texinfo-format "texinfmt"
+  "\
+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\"."
+  nil)
+
+(autoload 'display-time "time"
+  "\
+Display current time and load level in mode line of each buffer.
+Updates automatically every minute.
+If display-time-day-and-date is non-nil, the current day and date
+are displayed as well."
+  t)
+
+(autoload 'underline-region "underline"
+  "\
+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."
+  t)
+
+(autoload 'ununderline-region "underline"
+  "\
+Remove all underlining (overstruck underscores) in the region.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+  t)
+
+(autoload 'ask-user-about-lock "userlock"
+  "\
+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."
+  nil)
+
+(autoload 'ask-user-about-supersession-threat "userlock"
+  "\
+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."
+  nil)
+
+(autoload 'vi-mode "vi"
+  "\
+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."
+  t)
+
+(autoload 'view-file "view"
+  "\
+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.
+
+Calls the value of  view-hook  if that is non-nil."
+  t)
+
+(autoload 'view-buffer "view"
+  "\
+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.
+
+Calls the value of  view-hook  if that is non-nil."
+  t)
+
+(autoload 'view-mode "view"
+  "\
+Major mode for viewing text but not editing it.
+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).
+C-h            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 or C-c       exit view-mode and return to previous buffer.
+
+Entry to this mode calls the value of  view-hook  if non-nil.
+\\{view-mode-map}")
+
+(autoload 'vip-mode "vip"
+  "\
+Begin emulating the vi editor.  This is distinct from `vi-mode'.
+This emulator has different capabilities from the `vi-mode' emulator.
+See the text at the beginning of the source file .../lisp/vip.el
+in the Emacs distribution."
+  t)
+
+(autoload 'yow "yow"
+  "\
+Return or display a Zippy quotation" t)
+(autoload 'psychoanalyze-pinhead "yow"
+  "\
+Zippy goes to the analyst." t)
+
+\f
+(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-d" 'down-list)
+(define-key esc-map "\C-k" '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 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)
+\f
+(define-key ctl-x-map "/" 'point-to-register)
+(define-key ctl-x-map "j" 'register-to-point)
+(define-key ctl-x-map "x" 'copy-to-register)
+(define-key ctl-x-map "g" 'insert-register)
+(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)
+\f
+(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)
+(put 'narrow-to-region 'disabled t)
+(define-key ctl-x-map "p" 'narrow-to-page)
+(put 'narrow-to-page 'disabled t)
+(define-key ctl-x-map "l" 'count-lines-page)
+\f
+(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 ESC 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))
+
+(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))
+
+(defun isearch-backward ()
+  "\
+Do incremental search backward.
+See \\[isearch-forward] for more information."
+  (interactive)
+  (isearch nil))
+
+(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))
+
+(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 ?\e "\
+*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-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.")
+
+(autoload 'isearch "isearch")
+
+(define-key global-map "\C-s" 'isearch-forward)
+(define-key global-map "\C-r" 'isearch-backward)
+(define-key esc-map "\C-s" 'isearch-forward-regexp)
+\f
+(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.
+
+Preserves case in each replacement if  case-replace  and  case-fold-search
+are non-nil and FROM-STRING has no uppercase letters.
+Third arg DELIMITED (prefix arg if interactive) non-nil means replace
+only matches surrounded by word boundaries."
+  (interactive "sQuery replace: \nsQuery replace %s with: \nP")
+  (perform-replace from-string to-string t nil arg)
+  (message "Done"))
+
+(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.
+
+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) non-nil means replace
+only matches surrounded by word boundaries.
+In TO-STRING, \\& means insert what matched REGEXP,
+and \\=\\<n> means insert what matched <n>th \\(...\\) in REGEXP."
+  (interactive "sQuery replace regexp: \nsQuery replace regexp %s with: \nP")
+  (perform-replace regexp to-string t t arg)
+  (message "Done"))
+
+(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.
+Third arg DELIMITED (prefix arg if interactive) non-nil means replace
+only matches surrounded by word boundaries."
+  (interactive "sReplace string: \nsReplace string %s with: \nP")
+  (perform-replace from-string to-string nil nil delimited)
+  (message "Done"))
+
+(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) non-nil means replace
+only matches surrounded by word boundaries.
+In TO-STRING, \\& means insert what matched REGEXP,
+and \\=\\<n> means insert what matched <n>th \\(...\\) in REGEXP."
+  (interactive "sReplace regexp: \nsReplace regexp %s with: \nP")
+  (perform-replace regexp to-string nil t delimited)
+  (message "Done"))
+
+(define-key esc-map "%" 'query-replace)
+
+(autoload 'perform-replace "replace")
+\f
+(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)
diff --git a/usr/src/contrib/emacs-18.57/lisp/loadup.el b/usr/src/contrib/emacs-18.57/lisp/loadup.el

new file mode 100644 (file)

index 0000000..0d80c2d
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/loadup.el
@@ -0,0 +1,144 @@
+;Load up standardly loaded Lisp files for Emacs.
+;; This is loaded into a bare Emacs to make a dumpable one.
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(load "subr")
+(garbage-collect)
+(load "loaddefs.el")  ;Don't get confused if someone compiled loaddefs by mistake.
+(garbage-collect)
+(load "simple")
+(garbage-collect)
+(load "help")
+(garbage-collect)
+(load "files")
+(garbage-collect)
+(load "indent")
+(load "window")
+(load "paths.el")  ;Don't get confused if someone compiled paths by mistake.
+(garbage-collect)
+(load "startup")
+(load "lisp")
+(garbage-collect)
+(load "page")
+(load "register")
+(garbage-collect)
+(load "paragraphs")
+(load "lisp-mode")
+(garbage-collect)
+(load "text-mode")
+(load "fill")
+(garbage-collect)
+(load "c-mode")
+(garbage-collect)
+(load "isearch")
+(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 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 ../etc/makedoc.com.
+;For other systems, you must edit ../src/ymakefile.
+(if (load "site-load" t)
+    (garbage-collect))
+
+(load "version.el")  ;Don't get confused if someone compiled version.el by mistake.
+
+;; 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 (fboundp 'dump-emacs)
+    (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)))))
+      (copy-file (expand-file-name "../etc/DOC")
+                (concat (expand-file-name "../etc/DOC-") name)
+                t)
+      (Snarf-documentation (concat "DOC-" 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)
+(garbage-collect)
+
+(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))
+      (if (fboundp 'dump-emacs-data)
+         ;; Handle the IBM RS/6000, and perhaps eventually other machines.
+         (progn
+           ;; This strange nesting is so that the variable `name'
+           ;; is not bound when the data is dumped.
+           (message "Dumping data as file ../etc/EMACS-DATA")
+           (dump-emacs-data "../etc/EMACS-DATA")
+           (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)))))
+         (message "Dumping under names xemacs and %s" name))
+       (condition-case ()
+           (delete-file "xemacs")
+         (file-error nil))
+       (dump-emacs "xemacs" "temacs")
+       ;; Recompute NAME now, so that it isn't set when we dump.
+       (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 "xemacs" 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 (fboundp 'dump-emacs)
+    (eval top-level))
diff --git a/usr/src/contrib/emacs-18.57/lisp/lpr.el b/usr/src/contrib/emacs-18.57/lisp/lpr.el

new file mode 100644 (file)

index 0000000..00a7584
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/lpr.el
@@ -0,0 +1,71 @@
+;; Print Emacs buffer on line printer.
+;; Copyright (C) 1985, 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;(defconst lpr-switches nil
+;  "*List of strings to pass as extra switch args to lpr when it is invoked.")
+
+(defvar lpr-command (if (eq system-type 'usg-unix-v)
+                       "lp" "lpr")
+  "Shell command for printing a file")
+
+(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))
+
+(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) (cons "-p" lpr-switches)))
+
+(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))
+
+(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 (cons "-p" lpr-switches)))
+
+(defun print-region-1 (start end switches)
+  (let ((name (concat (buffer-name) " Emacs buffer"))
+       (width tab-width))
+    (save-excursion
+     (message "Spooling...")
+     (if (/= tab-width 8)
+        (let ((oldbuf (current-buffer)))
+         (set-buffer (get-buffer-create " *spool temp*"))
+         (widen) (erase-buffer)
+         (insert-buffer-substring oldbuf start end)
+         (setq tab-width width)
+         (untabify (point-min) (point-max))
+         (setq start (point-min) end (point-max))))
+     (apply 'call-process-region
+           (nconc (list start end lpr-command
+                        nil nil nil)
+                  (nconc (and (eq system-type 'berkeley-unix)
+                              (list "-J" name "-T" name))
+                         switches)))
+     (message "Spooling...done"))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/macros.el b/usr/src/contrib/emacs-18.57/lisp/macros.el

new file mode 100644 (file)

index 0000000..bd2bd9c
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/macros.el
@@ -0,0 +1,103 @@
+;; Non-primitive commands for keyboard macros.
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun name-last-kbd-macro (symbol)
+  "Assign a name to the last keyboard macro defined.
+One arg, a symbol, which is the name to define.
+The symbol's function definition becomes the keyboard macro string.
+Such a \"function\" cannot be called from Lisp, but it is a valid command
+definition for the editor command loop."
+  (interactive "SName for last kbd macro: ")
+  (or last-kbd-macro
+      (error "No keyboard macro defined"))
+  (and (fboundp symbol)
+       (not (stringp (symbol-function symbol)))
+       (error "Function %s is already defined and not a keyboard macro."
+             symbol))
+  (fset symbol last-kbd-macro))
+
+(defun insert-kbd-macro (macroname &optional keys)
+  "Insert in buffer the definition of kbd macro NAME, as Lisp code.
+Second argument KEYS non-nil means also record the keys it is on.
+ (This is the prefix argument, when calling interactively.)
+
+This Lisp code will, when executed, define the kbd macro with the
+same definition it has now.  If you say to record the keys,
+the Lisp code will also rebind those keys to the macro.
+Only global key bindings are recorded since executing this Lisp code
+always makes global bindings.
+
+To save a kbd macro, visit a file of Lisp code such as your ~/.emacs,
+use this command, and then save the file."
+  (interactive "CInsert kbd macro (name): \nP")
+  (insert "(fset '")
+  (prin1 macroname (current-buffer))
+  (insert "\n   ")
+  (prin1 (symbol-function macroname) (current-buffer))
+  (insert ")\n")
+  (if keys
+      (let ((keys (where-is-internal macroname nil)))
+       (while keys
+         (insert "(global-set-key ")
+         (prin1 (car keys) (current-buffer))
+         (insert " '")
+         (prin1 macroname (current-buffer))
+         (insert ")\n")
+         (setq keys (cdr keys))))))
+
+(defun kbd-macro-query (flag)
+  "Query user during kbd macro execution.
+With prefix argument, enters recursive edit,
+ reading keyboard commands even within a kbd macro.
+ You can give different commands each time the macro executes.
+Without prefix argument, reads a character.  Your options are:
+ Space -- execute the rest of the macro.
+ DEL -- skip the rest of the macro; start next repetition.
+ C-d -- skip rest of the macro and don't repeat it any more.
+ C-r -- enter a recursive edit, then on exit ask again for a character
+ C-l -- redisplay screen and ask again."
+  (interactive "P")
+  (or executing-macro
+      defining-kbd-macro
+      (error "Not defining or executing kbd macro"))
+  (if flag
+      (let (executing-macro defining-kbd-macro)
+       (recursive-edit))
+    (if (not executing-macro)
+       nil
+      (let ((loop t))
+       (while loop
+         (let ((char (let ((executing-macro nil)
+                           (defining-kbd-macro nil))
+                       (message "Proceed with macro? (Space, DEL, C-d, C-r or C-l) ")
+                       (read-char))))
+           (cond ((= char ? )
+                  (setq loop nil))
+                 ((= char ?\177)
+                  (setq loop nil)
+                  (setq executing-macro ""))
+                 ((= char ?\C-d)
+                  (setq loop nil)
+                  (setq executing-macro t))
+                 ((= char ?\C-l)
+                  (recenter nil))
+                 ((= char ?\C-r)
+                  (let (executing-macro defining-kbd-macro)
+                    (recursive-edit))))))))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/mail-utils.el b/usr/src/contrib/emacs-18.57/lisp/mail-utils.el

new file mode 100644 (file)

index 0000000..4976758
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/mail-utils.el
@@ -0,0 +1,179 @@
+;; Utility functions used both by rmail and rnews
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(provide 'mail-utils)
+                    
+;; should be in loaddefs
+(defvar mail-use-rfc822 nil
+  "*If non-nil, use a full, hairy RFC822 parser on mail addresses.
+Otherwise, (the default) use a smaller, somewhat faster and
+often-correct parser.")
+
+(defun mail-string-delete (string start end)
+  "Returns a string containing all of STRING except the part
+from START (inclusive) to END (exclusive)."
+  (if (null end) (substring string 0 start)
+    (concat (substring string 0 start)
+           (substring string end nil))))
+
+(defun mail-strip-quoted-names (address)
+  "Delete comments and quoted strings in an address list ADDRESS.
+Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR.
+Return a modified address list."
+  (if mail-use-rfc822
+      (progn (require 'rfc822)
+            (mapconcat 'identity (rfc822-addresses address) ", "))
+    (let (pos)
+     (string-match "\\`[ \t\n]*" address)
+     ;; strip surrounding whitespace
+     (setq address (substring address
+                             (match-end 0)
+                             (string-match "[ \t\n]*\\'" address
+                                           (match-end 0))))
+     ;; strip rfc822 comments
+     (while (setq pos (string-match 
+                       ;; This doesn't hack rfc822 nested comments
+                       ;;  `(xyzzy (foo) whinge)' properly.  Big deal.
+                       "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)"
+                       address))
+       (setq address
+            (mail-string-delete address
+                                pos (match-end 0))))
+     ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
+     (setq pos 0)
+     (while (setq pos (string-match
+                       "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
+                       address pos))
+       ;; If the next thing is "@", we have "foo bar"@host.  Leave it.
+       (if (and (> (length address) (match-end 0))
+               (= (aref address (match-end 0)) ?@))
+          (setq pos (match-end 0))
+        (setq address
+              (mail-string-delete address
+                                  pos (match-end 0)))))
+     ;; Retain only part of address in <> delims, if there is such a thing.
+     (while (setq pos (string-match "\\(,\\|\\`\\)[^,]*<\\([^>,]*>\\)"
+                                   address))
+       (let ((junk-beg (match-end 1))
+            (junk-end (match-beginning 2))
+            (close (match-end 0)))
+        (setq address (mail-string-delete address (1- close) close))
+        (setq address (mail-string-delete address junk-beg junk-end))))
+     address)))
+  
+(or (and (boundp 'rmail-default-dont-reply-to-names)
+        (not (null rmail-default-dont-reply-to-names)))
+    (setq rmail-default-dont-reply-to-names "info-"))
+
+; rmail-dont-reply-to-names is defined in loaddefs
+(defun rmail-dont-reply-to (userids)
+  "Returns string of mail addresses USERIDS sans any recipients
+that start with matches for  rmail-dont-reply-to-names.
+Usenet paths ending in an element that matches are removed also."
+  (if (null rmail-dont-reply-to-names)
+      (setq rmail-dont-reply-to-names
+           (concat (if rmail-default-dont-reply-to-names
+                       (concat rmail-default-dont-reply-to-names "\\|")
+                       "")
+                   (concat (regexp-quote
+                             (or (getenv "USER") (getenv "LOGNAME")
+                                 (user-login-name)))
+                           "\\>"))))
+  (let ((match (concat "\\(^\\|,\\)[ \t\n]*\\([^,\n]*!\\|\\)\\("
+                      rmail-dont-reply-to-names
+                      "\\)"))
+       (case-fold-search t)
+       pos epos)
+    (while (setq pos (string-match match userids))
+      (if (> pos 0) (setq pos (1+ pos)))
+      (setq epos
+           (if (string-match "[ \t\n,]+" userids (match-end 0))
+               (match-end 0)
+             (length userids)))
+      (setq userids
+           (mail-string-delete
+             userids pos epos)))
+    ;; get rid of any trailing commas
+    (if (setq pos (string-match "[ ,\t\n]*\\'" userids))
+       (setq userids (substring userids 0 pos)))
+    ;; remove leading spaces. they bother me.
+    (if (string-match "\\s *" userids)
+       (substring userids (match-end 0))
+      userids)))
+\f
+(defun mail-fetch-field (field-name &optional last all)
+  "Return the value of the header field FIELD.
+The buffer is expected to be narrowed to just the headers of the message.
+If 2nd arg LAST is non-nil, use the last such field if there are several.
+If 3rd arg ALL is non-nil, concatenate all such fields, with commas between."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((case-fold-search t)
+         (name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*")))
+      (goto-char (point-min))
+      (if all
+         (let ((value ""))
+           (while (re-search-forward name nil t)
+             (let ((opoint (point)))
+               (while (progn (forward-line 1)
+                             (looking-at "[ \t]")))
+               (setq value (concat value
+                                   (if (string= value "") "" ", ")
+                                   (buffer-substring opoint (1- (point)))))))
+           (and (not (string= value "")) value))
+       (if (re-search-forward name nil t)
+           (progn
+             (if last (while (re-search-forward name nil t)))
+             (let ((opoint (point)))
+               (while (progn (forward-line 1)
+                             (looking-at "[ \t]")))
+               (buffer-substring opoint (1- (point))))))))))
+\f
+;; Parse a list of tokens separated by commas.
+;; It runs from point to the end of the visible part of the buffer.
+;; Whitespace before or after tokens is ignored,
+;; but whitespace within tokens is kept.
+(defun mail-parse-comma-list ()
+  (let (accumulated
+       beg)
+    (skip-chars-forward " ")
+    (while (not (eobp))
+      (setq beg (point))
+      (skip-chars-forward "^,")
+      (skip-chars-backward " ")
+      (setq accumulated
+           (cons (buffer-substring beg (point))
+                 accumulated))
+      (skip-chars-forward "^,")
+      (skip-chars-forward ", "))
+    accumulated))
+
+(defun mail-comma-list-regexp (labels)
+  (let (pos)
+    (setq pos (or (string-match "[^ \t]" labels) 0))
+    ;; Remove leading and trailing whitespace.
+    (setq labels (substring labels pos (string-match "[ \t]*$" labels pos)))
+    ;; Change each comma to \|, and flush surrounding whitespace.
+    (while (setq pos (string-match "[ \t]*,[ \t]*" labels))
+      (setq labels
+           (concat (substring labels 0 pos)
+                   "\\|"
+                   (substring labels (match-end 0))))))
+  labels)
diff --git a/usr/src/contrib/emacs-18.57/lisp/mailalias.el b/usr/src/contrib/emacs-18.57/lisp/mailalias.el

new file mode 100644 (file)

index 0000000..bfeb7c7
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/mailalias.el
@@ -0,0 +1,146 @@
+;; Expand mailing address aliases defined in ~/.mailrc.
+;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; Called from sendmail-send-it, or similar functions,
+;; only if some mail aliases are defined.
+(defun expand-mail-aliases (beg end)
+  "Expand all mail aliases in suitable header fields found between BEG and END.
+Suitable header fields are To, Cc and Bcc."
+  (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 "^\\(to\\|cc\\|bcc\\):" 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 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)
+                 (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 ~/.mailrc exists.
+(defun build-mail-aliases (&optional file)
+  "Read mail aliases from ~/.mailrc and set mail-aliases."
+  (setq file (expand-file-name (or file "~/.mailrc")))
+  (let ((buffer nil)
+       (obuf (current-buffer)))
+    (unwind-protect
+       (progn
+         (setq buffer (generate-new-buffer "mailrc"))
+         (buffer-flush-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))
+         ;; 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 (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t)
+                    (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t))
+           (re-search-forward "[^ \t]+")
+           (let* ((name (buffer-substring (match-beginning 0) (match-end 0)))
+                  (start (progn (skip-chars-forward " \t") (point))))
+             (end-of-line)
+             (define-mail-alias
+               name
+               (buffer-substring start (point)))))
+         mail-aliases)
+      (if buffer (kill-buffer buffer))
+      (set-buffer obuf))))
+
+;; Always autoloadable in case the user wants to define aliases
+;; interactively or in .emacs.
+(defun define-mail-alias (name definition)
+  "Define NAME as a mail-alias that translates to DEFINITION."
+  (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
+  ;; Read the defaults first, if we have not done so.
+  (if (eq mail-aliases t)
+      (progn
+       (setq mail-aliases nil)
+       (if (file-exists-p "~/.mailrc")
+           (build-mail-aliases))))
+  (let (tem)
+    ;; ~/.mailrc contains addresses separated by spaces.
+    ;; mailers should expect addresses separated by commas.
+    (while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
+      (if (= (match-end 0) (length definition))
+         (setq definition (substring definition 0 (1+ tem)))
+       (setq definition (concat (substring definition
+                                           0 (1+ tem))
+                                ", "
+                                (substring definition (match-end 0))))
+       (setq tem (+ 3 tem))))
+    (setq tem (assoc name mail-aliases))
+    (if tem
+       (rplacd tem definition)
+      (setq mail-aliases (cons (cons name definition) mail-aliases)))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/makesum.el b/usr/src/contrib/emacs-18.57/lisp/makesum.el

new file mode 100644 (file)

index 0000000..4258959
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/makesum.el
@@ -0,0 +1,100 @@
+;; Generate key binding summary for Emacs
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun make-command-summary ()
+  "Make a summary of current key bindings in the buffer *Summary*.
+Previous contents of that buffer are killed first."
+  (interactive)
+  (message "Making command summary...")
+  ;; This puts a description of bindings in a buffer called *Help*.
+  (save-window-excursion
+   (describe-bindings))
+  (with-output-to-temp-buffer "*Summary*"
+    (save-excursion
+     (let ((cur-mode mode-name))
+       (set-buffer standard-output)
+       (erase-buffer)
+       (insert-buffer-substring "*Help*")
+       (goto-char (point-min))
+       (delete-region (point) (progn (forward-line 1) (point)))
+       (while (search-forward "         " nil t)
+        (replace-match "  "))
+       (goto-char (point-min))
+       (while (search-forward "-@ " nil t)
+        (replace-match "-SP"))
+       (goto-char (point-min))
+       (while (search-forward "  .. ~ " nil t)
+        (replace-match "SP .. ~"))
+       (goto-char (point-min))
+       (while (search-forward "C-?" nil t)
+        (replace-match "DEL"))
+       (goto-char (point-min))
+       (while (search-forward "C-i" nil t)
+        (replace-match "TAB"))
+       (goto-char (point-min))
+       (if (re-search-forward "^Local Bindings:" nil t)
+          (progn
+           (forward-char -1)
+           (insert " for " cur-mode " Mode")
+           (while (search-forward "??\n" nil t)
+             (delete-region (point)
+                            (progn
+                             (forward-line -1)
+                             (point))))))
+       (goto-char (point-min))
+       (insert "Emacs command summary, " (substring (current-time-string) 0 10)
+              ".\n")
+       ;; Delete "key    binding" and underlining of dashes.
+       (delete-region (point) (progn (forward-line 2) (point)))
+       (forward-line 1)                        ;Skip blank line
+       (while (not (eobp))
+        (let ((beg (point)))
+          (or (re-search-forward "^$" nil t)
+              (goto-char (point-max)))
+          (double-column beg (point))
+          (forward-line 1)))
+       (goto-char (point-min)))))
+  (message "Making command summary...done"))
+
+(defun double-column (start end)
+  (interactive "r")
+  (let (half cnt
+        line lines nlines
+       (from-end (- (point-max) end)))
+    (setq nlines (count-lines start end))
+    (if (<= nlines 1)
+       nil
+      (setq half (/ (1+ nlines) 2))
+      (goto-char start)
+      (save-excursion
+       (forward-line half)
+       (while (< half nlines)
+        (setq half (1+ half))
+        (setq line (buffer-substring (point) (save-excursion (end-of-line) (point))))
+        (setq lines (cons line lines))
+        (delete-region (point) (progn (forward-line 1) (point)))))
+      (setq lines (nreverse lines))
+      (while lines
+       (end-of-line)
+       (indent-to 41)
+       (insert (car lines))
+       (forward-line 1)
+       (setq lines (cdr lines))))
+    (goto-char (- (point-max) from-end))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/man.el b/usr/src/contrib/emacs-18.57/lisp/man.el

new file mode 100644 (file)

index 0000000..18407e4
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/man.el
@@ -0,0 +1,152 @@
+;; Read in and display parts of Unix manual.
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(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 (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 "*Manual Entry*"
+    (buffer-flush-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)
+      (message ""))))
+
+;; Hint: BS stands form more things than "back space"
+(defun nuke-nroff-bs ()
+  (interactive "*")
+  ;; 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))
+           ((= preceding ?\_)
+            ;; _\b
+            (delete-char -2))
+           ((= following ?\_)
+            ;; \b_
+            (delete-region (1- (point)) (1+ (point)))))))
+
+  ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
+  (goto-char (point-min))
+  (while (re-search-forward "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t)
+    (replace-match ""))
+  
+  ;; Nuke footers: "Printed 12/3/85    27 April 1981   1"
+  ;;    Sun appear to be on drugz:
+  ;;     "Sun Release 3.0\ eB\ f  Last change: 1 February 1985     1"
+  ;;    HP are even worse!
+  ;;     "     Hewlett-Packard   -1- (printed 12/31/99)"  FMHWA12ID!!
+  ;;    System V (well WICATs anyway):
+  ;;     "Page 1                         (printed 7/24/85)"
+  ;;    Who is administering PCP to these corporate bozos?
+  (goto-char (point-min))
+  (while (re-search-forward
+          (cond ((eq system-type 'hpux)
+                 "^[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*$")
+                ((eq system-type 'usg-unix-v)
+                 "^ *Page [0-9]*.*(printed [0-9/]*)$")
+                (t
+                 "^\\(Printed\\|Sun Release\\) [0-9].*[0-9]$"))
+          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))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/medit.el b/usr/src/contrib/emacs-18.57/lisp/medit.el

new file mode 100644 (file)

index 0000000..4a37d86
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/medit.el
@@ -0,0 +1,116 @@
+;; Lisp interface between GNU Emacs and MEDIT package. Emacs under MDL.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; >> This package depends on two MDL packages: MEDIT and FORKS which
+;; >> can be obtained from the public (network) library at mit-ajax.
+
+(require 'mim-mode)
+
+(defconst medit-zap-file (concat "/tmp/" (getenv "USER") ".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 (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."
+  (indetarctive)
+  (medit-save-defun)
+  (medit-go-to-mdl))
+
+(defun medit-zap-region-mdl (start end)
+  "Return to MDL with current region."
+  (interactive)
+  (medit-save-region start end)
+  (medit-go-to-mdl))
+
+(defun medit-zap-buffer ()
+  "Return to MDL with current buffer."
+  (interactive)
+  (medit-save-buffer)
+  (medit-go-to-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-alist 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)
+
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/mh-e.el b/usr/src/contrib/emacs-18.57/lisp/mh-e.el

new file mode 100644 (file)

index 0000000..50ee808
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/mh-e.el
@@ -0,0 +1,2832 @@
+;;;  mh-e.el   (Version: 3.7 for GNU Emacs Version 18 and MH.5 and MH.6)
+
+(defvar mh-e-RCS-id)
+(setq mh-e-RCS-id "$Header: /var/home/larus/lib/emacs/RCS/mh-e.el,v 3.1 90/09/28 15:47:58 larus Exp Locker: larus $")
+(provide 'mh-e)
+
+;;;  Copyright (C) 1985-89 Free Software Foundation
+;;;     Author:  James Larus (larus@ginger.Berkeley.EDU or ucbvax!larus)
+;;;    Please send suggestions and corrections to the above address.
+;;;
+;;;  This file contains mh-e, a GNU Emacs front end to the MH mail 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 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.
+
+
+;;;  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
+
+
+;;;  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.
+
+\f
+
+;;; 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 t
+  "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-quit-hook nil
+  "Invoked after quitting mh-e with \\[mh-quit].")
+
+
+(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))
+       (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.")
+
+(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.")
+
+
+;;; Parameterize mh-e to work with different scan formats.  The defaults work
+;;; 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 specifiying 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 "^   ----- Unsent message follows -----$"
+  "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-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))))
+
+\f
+
+;;; Entry points:
+
+(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)))
+
+
+(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))
+
+\f
+
+;;; 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
+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))
+  (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))
+                (find-file (mh-msg-filename msg))
+                (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:"
+                        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:"
+                               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 "NMessage number? ")
+  (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, mail is incorporated 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
+       (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)
+      (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
+    (set-buffer mh-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"
+                   "-nodraftfolder" mh-current-folder
+                   msg
+                   "-nocc" "all"
+                   (if prefix-provided
+                       (list "-filter" "mhl.reply"))))
+           ((equal reply-to "to")
+            (apply 'mh-exec-cmd
+                   "repl" "-build"
+                   "-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"
+                   "-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 ()
+  "Restore the previous window configuration, if one exists.
+Finish by running mh-quit-hook."
+  (interactive)
+  (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 (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."
+  (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)
+  (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)))
+       ((or (looking-at mh-deleted-msg-regexp)
+            (looking-at mh-refiled-msg-regexp))
+        (mh-undo-msg (mh-get-msg-num t)))
+       (t
+        (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)
+        (mh-notate msg ?  mh-cmd-note))
+       (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-visit-folder (folder &optional range)
+  "Visit FOLDER and display RANGE of messages."
+  (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)))
+
+
+(defun mh-widen ()
+  "Remove restrictions from the current folder, thereby showing all messages."
+  (interactive "")
+  (with-mh-folder-updating (t)
+    (delete-region (point-min) (point-max))
+    (widen)
+    (mh-make-folder-mode-line))
+  (setq mh-narrowed-to-seq nil))
+
+\f
+
+;;; 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.
+  (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.
+  (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 2))
+      (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)))))
+
+
+(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)))
+
+\f
+
+;;; The folder data abstraction.
+
+(defvar mh-current-folder nil "Name of current folder, a string.")
+(defvar mh-show-buffer nil "Buffer that displays mesage 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.
+
+ 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
+  (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 ((= (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))
+
+\f
+
+;;; 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.
+
+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 auto-fill-hook
+    (make-local-variable 'auto-fill-hook)
+    (setq auto-fill-hook '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 (dot-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 (save-excursion
+                (backward-char 1)
+                (not (looking-at "[:,]")))
+              (insert ", ")
+              (insert " ")))
+         (t
+          (goto-char (dot-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 ~/.signature at the current point."
+  (interactive "")
+  (insert-file-contents "~/.signature")
+  (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")))
+
+\f
+
+;;; 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)
+       (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))))
+
+\f
+
+;;; 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))
+          (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)
+                                (buffer-substring (point) (mark)))
+                               ((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)))))
+
+\f
+
+;;; 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))
+      (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 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)))
+
+\f
+
+;;; 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 (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)))
+
+\f
+
+;;; 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)))))
+
+\f
+
+;;; User prompting commands.
+
+(defun mh-prompt-for-folder (prompt default can-create)
+  ;; Prompt for a folder name with PROMPT.  Returns the folder's name.
+  ;; DEFAULT is used if the folder exists and the user types return.
+  ;; If the CAN-CREATE flag is t, then a non-existant folder is made.
+  (let* ((prompt (format "%s folder%s" prompt
+                        (if (equal "" default)
+                            "? "
+                            (format " [%s]? " default))))
+        name)
+    (if (null mh-folder-list)
+       (setq mh-folder-list (mh-make-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)
+            (mh-push (list (substring name 1 nil)) 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)
+              (mh-push (list (substring name 1 nil)) mh-folder-list)))))
+    name))
+
+
+(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)))
+
+\f
+
+;;; 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 (search-forward field nil t)) "")
+         ((looking-at "[\t ]*$") "")
+         (t
+          (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
+          (let ((field (buffer-substring (match-beginning 1)
+                                         (match-end 1)))
+                (end-of-match (point)))
+            (forward-line)
+            (while (looking-at "[ \t]") (forward-line 1))
+            (backward-char 1)
+            (if (<= (point) end-of-match)
+                field
+                (format "%s%s"
+                        field
+                        (buffer-substring end-of-match (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.
+  (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)))
+
+\f
+
+;;; 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 "\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 "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)
+
+\f
+
+;;; For Gnu Emacs.
+;;; Local Variables: ***
+;;; eval: (put 'mh-when 'lisp-indent-hook 1) ***
+;;; eval: (put 'with-mh-folder-updating 'lisp-indent-hook 1) ***
+;;; End: ***
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/mim-mode.el b/usr/src/contrib/emacs-18.57/lisp/mim-mode.el

new file mode 100644 (file)

index 0000000..ca222b9
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/mim-mode.el
@@ -0,0 +1,859 @@
+;; Mim (MDL in MDL) mode.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(provide 'mim-mode)
+
+(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-hook 'indent-mim-hook
+  "Controls (via properties) indenting of special forms.
+\(put 'FOO 'indent-mim-hook n\), integer n, means lines inside
+<FOO ...> will be indented n spaces from start of form.
+\(put 'FOO 'indent-mim-hook 'DEFINE\) is like above but means use
+value of mim-body-indent as offset from start of form.
+\(put 'FOO 'indent-mim-hook <cons>\) where <cons> is a list or pointted 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 pointted list, in which case the last
+cdr is used.  Confused? Here is an example:
+\(put 'FROBIT 'indent-mim-hook '\(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-hook.")
+
+(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-hook 'DEFINE)
+(put 'DEFMAC 'indent-mim-hook 'DEFINE)
+(put 'BIND 'indent-mim-hook 'DEFINE)
+(put 'PROG 'indent-mim-hook 'DEFINE)
+(put 'REPEAT 'indent-mim-hook 'DEFINE)
+(put 'CASE 'indent-mim-hook 'DEFINE)
+(put 'FUNCTION 'indent-mim-hook 'DEFINE)
+(put 'MAPF 'indent-mim-hook 'DEFINE)
+(put 'MAPR 'indent-mim-hook 'DEFINE)
+(put 'UNWIND 'indent-mim-hook (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.")
+
+(fset '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. M-f = M-C-f).
+The default action is bind the escape keys.
+  Tab        Indents the current line as MDL code.
+  Delete     Converts tabs to spaces as it moves back.
+  M-C-f      Move forward over next mim object.
+  M-C-b      Move backward over previous mim object.
+  M-C-p      Move to beginning of previous toplevel mim object.
+  M-C-n      Move to the beginning of the next toplevel mim object.
+  M-C-a      Move to the top of surrounding toplevel mim form.
+  M-C-e      Move to the end of surrounding toplevel mim form.
+  M-C-u      Move up a level of mim structure backwards.
+  M-C-d      Move down a level of mim structure forwards.
+  M-C-t      Transpose mim objects on either side of point.
+  M-C-k      Kill next mim object.
+  M-C-h      Place mark at end of next mim object.
+  M-C-o      Insert a newline before current line and indent.
+  M-Delete   Kill previous mim object.
+  M-^        Join current line to previous line.
+  M-\\        Delete whitespace around point.
+  M-;        Move to existing comment or insert empty comment if none.
+  M-Tab      Indent following mim object and all contained lines.
+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-hook
+  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-hook)
+  (setq comment-indent-hook '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 wierd 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 wierdo - 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-hook
+              (not retry)
+              (setq desired-indent
+                    (funcall indent-mim-hook 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-hook (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-hook)))
+           (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 pointted 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-hook))
+       (containing-sexp (car (cdr state)))
+       (last-sexp (car (nthcdr 2 state)))
+       indentation)
+    (goto-char (1+ containing-sexp))
+    ;; determine wheich 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)))
diff --git a/usr/src/contrib/emacs-18.57/lisp/mim-syntax.el b/usr/src/contrib/emacs-18.57/lisp/mim-syntax.el

new file mode 100644 (file)

index 0000000..c9a95b5
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/mim-syntax.el
@@ -0,0 +1,91 @@
+;; Syntax checker for Mim (MDL).
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(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")))))
+
+
+       
diff --git a/usr/src/contrib/emacs-18.57/lisp/mlconvert.el b/usr/src/contrib/emacs-18.57/lisp/mlconvert.el

new file mode 100644 (file)

index 0000000..faf88e5
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/mlconvert.el
@@ -0,0 +1,272 @@
+;; Convert buffer of Mocklisp code to real lisp.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(defun convert-mocklisp-buffer ()
+  "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run."
+  (interactive)
+  (emacs-lisp-mode)
+  (set-syntax-table (copy-sequence (syntax-table)))
+  (modify-syntax-entry ?\| "w")
+  (message "Converting mocklisp (ugh!)...")
+  (goto-char (point-min))
+  (fix-mlisp-syntax)
+
+  ;; Emulation of mocklisp is accurate only within a mocklisp-function
+  ;; so turn any non-function into a defun and then call it.
+  (goto-char (point-min))
+  (condition-case ignore
+      (while t
+       (let ((opt (point))
+             (form (read (current-buffer))))
+         (and (listp form)
+              (not (eq (car form) 'defun))
+              (progn (insert "))\n\n(ml-foo)\n\n")
+                     (save-excursion
+                       (goto-char opt)
+                       (skip-chars-forward "\n")
+                       (insert "(defun (ml-foo \n "))))))
+    (end-of-file nil))
+
+  (goto-char (point-min))
+  (insert ";;; GNU Emacs code converted from Mocklisp\n")
+  (insert "(require 'mlsupport)\n\n")
+  (fix-mlisp-symbols)
+
+  (goto-char (point-min))
+  (message "Converting mocklisp...done"))
+
+(defun fix-mlisp-syntax ()
+  (while (re-search-forward "['\"]" nil t)
+    (if (= (preceding-char) ?\")
+       (progn (forward-char -1)
+              (forward-sexp 1))
+      (delete-char -1)
+      (insert "?")
+    (if (or (= (following-char) ?\\) (= (following-char) ?^))
+         (forward-char 1)
+       (if (looking-at "[^a-zA-Z]")
+           (insert ?\\)))
+      (forward-char 1)
+      (delete-char 1))))
+
+(defun fix-mlisp-symbols ()
+  (while (progn
+          (skip-chars-forward " \t\n()")
+          (not (eobp)))
+    (cond ((or (= (following-char) ?\?)
+              (= (following-char) ?\"))
+          (forward-sexp 1))
+         ((= (following-char) ?\;)
+          (forward-line 1))
+         (t
+          (let ((start (point)) prop)
+            (forward-sexp 1)
+            (setq prop (get (intern-soft (buffer-substring start (point)))
+                            'mocklisp))
+            (cond ((null prop))
+                  ((stringp prop)
+                   (delete-region start (point))
+                   (insert prop))
+                  (t
+                   (save-excursion
+                     (goto-char start)
+                     (funcall prop)))))))))
+
+(defun ml-expansion (ml-name lisp-string)
+  (put ml-name 'mocklisp lisp-string))
+
+(ml-expansion 'defun "ml-defun")
+(ml-expansion 'if "ml-if")
+(ml-expansion 'setq '(lambda ()
+                      (if (looking-at "setq[ \t\n]+buffer-modified-p")
+                          (replace-match "set-buffer-modified-p"))))
+
+(ml-expansion 'while '(lambda ()
+                        (let ((end (progn (forward-sexp 2) (point-marker)))
+                              (start (progn (forward-sexp -1) (point))))
+                          (let ((cond (buffer-substring start end)))
+                            (cond ((equal cond "1")
+                                   (delete-region (point) end)
+                                   (insert "t"))
+                                  (t
+                                   (insert "(not (zerop ")
+                                   (goto-char end)
+                                   (insert "))")))
+                            (set-marker end nil)
+                            (goto-char start)))))
+
+(ml-expansion 'arg "ml-arg")
+(ml-expansion 'nargs "ml-nargs")
+(ml-expansion 'interactive "ml-interactive")
+(ml-expansion 'message "ml-message")
+(ml-expansion 'print "ml-print")
+(ml-expansion 'set "ml-set")
+(ml-expansion 'set-default "ml-set-default")
+(ml-expansion 'provide-prefix-argument "ml-provide-prefix-argument")
+(ml-expansion 'prefix-argument-loop "ml-prefix-argument-loop")
+(ml-expansion 'prefix-argument "ml-prefix-arg")
+(ml-expansion 'use-local-map "ml-use-local-map")
+(ml-expansion 'use-global-map "ml-use-global-map")
+(ml-expansion 'modify-syntax-entry "ml-modify-syntax-entry")
+(ml-expansion 'error-message "error")
+
+(ml-expansion 'dot "point-marker")
+(ml-expansion 'mark "mark-marker")
+(ml-expansion 'beginning-of-file "beginning-of-buffer")
+(ml-expansion 'end-of-file "end-of-buffer")
+(ml-expansion 'exchange-dot-and-mark "exchange-point-and-mark")
+(ml-expansion 'set-mark "set-mark-command")
+(ml-expansion 'argument-prefix "universal-arg")
+
+(ml-expansion 'previous-page "ml-previous-page")
+(ml-expansion 'next-page "ml-next-page")
+(ml-expansion 'next-window "ml-next-window")
+(ml-expansion 'previous-window "ml-previous-window")
+
+(ml-expansion 'newline "ml-newline")
+(ml-expansion 'next-line "ml-next-line")
+(ml-expansion 'previous-line "ml-previous-line")
+(ml-expansion 'self-insert "self-insert-command")
+(ml-expansion 'meta-digit "digit-argument")
+(ml-expansion 'meta-minus "negative-argument")
+
+(ml-expansion 'newline-and-indent "ml-newline-and-indent")
+(ml-expansion 'yank-from-killbuffer "yank")
+(ml-expansion 'yank-buffer "insert-buffer")
+(ml-expansion 'copy-region "copy-region-as-kill")
+(ml-expansion 'delete-white-space "delete-horizontal-space")
+(ml-expansion 'widen-region "widen")
+
+(ml-expansion 'forward-word '(lambda ()
+                              (if (looking-at "forward-word[ \t\n]*)")
+                                  (replace-match "forward-word 1)"))))
+(ml-expansion 'backward-word '(lambda ()
+                              (if (looking-at "backward-word[ \t\n]*)")
+                                  (replace-match "backward-word 1)"))))
+
+(ml-expansion 'forward-paren "forward-list")
+(ml-expansion 'backward-paren "backward-list")
+(ml-expansion 'search-reverse "ml-search-backward")
+(ml-expansion 're-search-reverse "ml-re-search-backward")
+(ml-expansion 'search-forward "ml-search-forward")
+(ml-expansion 're-search-forward "ml-re-search-forward")
+(ml-expansion 'quote "regexp-quote")
+(ml-expansion 're-query-replace "query-replace-regexp")
+(ml-expansion 're-replace-string "replace-regexp")
+
+; forward-paren-bl, backward-paren-bl
+
+(ml-expansion 'get-tty-character "read-char")
+(ml-expansion 'get-tty-input "read-input")
+(ml-expansion 'get-tty-string "read-string")
+(ml-expansion 'get-tty-buffer "read-buffer")
+(ml-expansion 'get-tty-command "read-command")
+(ml-expansion 'get-tty-variable "read-variable")
+(ml-expansion 'get-tty-no-blanks-input "read-no-blanks-input")
+(ml-expansion 'get-tty-key "read-key")
+
+(ml-expansion 'c= "char-equal")
+(ml-expansion 'goto-character "goto-char")
+(ml-expansion 'substr "ml-substr")
+(ml-expansion 'variable-apropos "apropos")
+(ml-expansion 'execute-mlisp-buffer "eval-current-buffer")
+(ml-expansion 'execute-mlisp-file "load")
+(ml-expansion 'visit-file "find-file")
+(ml-expansion 'read-file "find-file")
+(ml-expansion 'write-modified-files "save-some-buffers")
+(ml-expansion 'backup-before-writing "make-backup-files")
+(ml-expansion 'write-file-exit "save-buffers-kill-emacs")
+(ml-expansion 'write-named-file "write-file")
+(ml-expansion 'change-file-name "set-visited-file-name")
+(ml-expansion 'change-buffer-name "rename-buffer")
+(ml-expansion 'buffer-exists "get-buffer")
+(ml-expansion 'delete-buffer "kill-buffer")
+(ml-expansion 'unlink-file "delete-file")
+(ml-expansion 'unlink-checkpoint-files "delete-auto-save-files")
+(ml-expansion 'file-exists "file-exists-p")
+(ml-expansion 'write-current-file "save-buffer")
+(ml-expansion 'change-directory "cd")
+(ml-expansion 'temp-use-buffer "set-buffer")
+(ml-expansion 'fast-filter-region "filter-region")
+
+(ml-expansion 'pending-input "input-pending-p")
+(ml-expansion 'execute-keyboard-macro "call-last-kbd-macro")
+(ml-expansion 'start-remembering "start-kbd-macro")
+(ml-expansion 'end-remembering "end-kbd-macro")
+(ml-expansion 'define-keyboard-macro "name-last-kbd-macro")
+(ml-expansion 'define-string-macro "ml-define-string-macro")
+
+(ml-expansion 'current-column "ml-current-column")
+(ml-expansion 'current-indent "ml-current-indent")
+(ml-expansion 'insert-character "insert")
+
+(ml-expansion 'users-login-name "user-login-name")
+(ml-expansion 'users-full-name "user-full-name")
+(ml-expansion 'current-time "current-time-string")
+(ml-expansion 'current-numeric-time "current-numeric-time-you-lose")
+(ml-expansion 'current-buffer-name "buffer-name")
+(ml-expansion 'current-file-name "buffer-file-name")
+
+(ml-expansion 'local-binding-of "local-key-binding")
+(ml-expansion 'global-binding-of "global-key-binding")
+
+;defproc (ProcedureType, "procedure-type");
+
+(ml-expansion 'remove-key-binding "global-unset-key")
+(ml-expansion 'remove-binding "global-unset-key")
+(ml-expansion 'remove-local-binding "local-unset-key")
+(ml-expansion 'remove-all-local-bindings "use-local-map nil")
+(ml-expansion 'autoload "ml-autoload")
+
+(ml-expansion 'checkpoint-frequency "auto-save-interval")
+
+(ml-expansion 'mode-string "mode-name")
+(ml-expansion 'right-margin "fill-column")
+(ml-expansion 'tab-size "tab-width")
+(ml-expansion 'default-right-margin "default-fill-column")
+(ml-expansion 'default-tab-size "default-tab-width")
+(ml-expansion 'buffer-is-modified "(buffer-modified-p)")
+
+(ml-expansion 'file-modified-time "you-lose-on-file-modified-time")
+(ml-expansion 'needs-checkpointing "you-lose-on-needs-checkpointing")
+
+(ml-expansion 'lines-on-screen "set-screen-height")
+(ml-expansion 'columns-on-screen "set-screen-width")
+
+(ml-expansion 'dumped-emacs "t")
+
+(ml-expansion 'buffer-size "ml-buffer-size")
+(ml-expansion 'dot-is-visible "pos-visible-in-window-p")
+
+(ml-expansion 'track-eol-on-^N-^P "track-eol")
+(ml-expansion 'ctlchar-with-^ "ctl-arrow")
+(ml-expansion 'help-on-command-completion-error "completion-auto-help")
+(ml-expansion 'dump-stack-trace "backtrace")
+(ml-expansion 'pause-emacs "suspend-emacs")
+(ml-expansion 'compile-it "compile")
+
+(ml-expansion '!= "/=")
+(ml-expansion '& "logand")
+(ml-expansion '| "logior")
+(ml-expansion '^ "logxor")
+(ml-expansion '! "ml-not")
+(ml-expansion '<< "lsh")
+
+;Variable pause-writes-files
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/mlsupport.el b/usr/src/contrib/emacs-18.57/lisp/mlsupport.el

new file mode 100644 (file)

index 0000000..e3c7577
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/mlsupport.el
@@ -0,0 +1,408 @@
+;; Run-time support for mocklisp code.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(provide 'mlsupport)
+
+(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)))
+
+(defmacro setq-default (var val)
+  (list 'set-default (list 'quote var) val))
+
+(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)))
+
+(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-char 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-hook (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)))
+\f
+(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))))
+\f
+;; 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)))
+\f
+(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))))
+\f
+(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)))))))
+\f
+
+
+(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))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/novice.el b/usr/src/contrib/emacs-18.57/lisp/novice.el

new file mode 100644 (file)

index 0000000..a0417f1
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/novice.el
@@ -0,0 +1,105 @@
+;; Handling of disabled commands ("novice mode") for Emacs.
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; This function is called (by autoloading)
+;; to handle any disabled command.
+;; The command is found in this-command
+;; and the keys are returned by (this-command-keys).
+
+(defun disabled-command-hook (&rest ignore)
+  (let (char)
+    (save-window-excursion
+     (with-output-to-temp-buffer "*Help*"
+       (if (= (aref (this-command-keys) 0) ?\M-x)
+          (princ "You have invoked the disabled command ")
+        (princ "You have typed ")
+        (princ (key-description (this-command-keys)))
+        (princ ", invoking disabled command "))
+       (princ this-command)
+       (princ ":\n")
+       ;; Print any special message saying why the command is disabled.
+       (if (stringp (get this-command 'disabled))
+          (princ (get this-command 'disabled)))
+       (princ (or (condition-case ()
+                     (documentation this-command)
+                   (error nil))
+                 "<< not documented >>"))
+       ;; Keep only the first paragraph of the documentation.
+       (save-excursion
+        (set-buffer "*Help*")
+        (goto-char (point-min))
+        (if (search-forward "\n\n" nil t)
+            (delete-region (1- (point)) (point-max))
+          (goto-char (point-max))))
+       (princ "\n\n")
+       (princ "You can now type
+Space to try the command just this once,
+      but leave it disabled,
+Y to try it and enable it (no questions if you use it again),
+N to do nothing (command remains disabled)."))
+     (message "Type y, n or Space: ")
+     (let ((cursor-in-echo-area t))
+       (while (not (memq (setq char (downcase (read-char)))
+                        '(?  ?y ?n)))
+        (ding)
+        (message "Please type y, n or Space: "))))
+    (if (= char ?y)
+       (if (y-or-n-p "Enable command for future editing sessions also? ")
+           (enable-command this-command)
+         (put this-command 'disabled nil)))
+    (if (/= char ?n)
+       (call-interactively this-command))))
+
+(defun enable-command (command)
+  "Allow COMMAND to be executed without special confirmation from now on.
+The user's .emacs file is altered so that this will apply
+to future sessions."
+  (interactive "CEnable command: ")
+  (put command 'disabled nil)
+  (save-excursion
+   (set-buffer (find-file-noselect (substitute-in-file-name "~/.emacs")))
+   (goto-char (point-min))
+   (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
+       (delete-region
+       (progn (beginning-of-line) (point))
+       (progn (forward-line 1) (point)))
+     ;; Must have been disabled by default.
+     (goto-char (point-max))
+     (insert "\n(put '" (symbol-name command) " 'disabled nil)\n"))
+   (setq foo (buffer-modified-p))
+   (save-buffer)))
+
+(defun disable-command (command)
+  "Require special confirmation to execute COMMAND from now on.
+The user's .emacs file is altered so that this will apply
+to future sessions."
+  (interactive "CDisable command: ")
+  (put command 'disabled t)
+  (save-excursion
+   (set-buffer (find-file-noselect (substitute-in-file-name "~/.emacs")))
+   (goto-char (point-min))
+   (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
+       (delete-region
+       (progn (beginning-of-line) (point))
+       (progn (forward-line 1) (point))))
+   (goto-char (point-max))
+   (insert "(put '" (symbol-name command) " 'disabled t)\n")
+   (save-buffer)))
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/nroff-mode.el b/usr/src/contrib/emacs-18.57/lisp/nroff-mode.el

new file mode 100644 (file)

index 0000000..16e1445
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/nroff-mode.el
@@ -0,0 +1,203 @@
+;; GNU Emacs major mode for editing nroff source
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+
+(defvar nroff-mode-abbrev-table nil
+  "Abbrev table used while in nroff mode.")
+
+(defvar nroff-mode-map nil
+     "Major mode keymap for nroff-mode buffers")
+(if (not nroff-mode-map)
+    (progn
+      (setq nroff-mode-map (make-sparse-keymap))
+      (define-key nroff-mode-map "\t"  'tab-to-tab-stop)
+      (define-key nroff-mode-map "\es" 'center-line)
+      (define-key nroff-mode-map "\e?" 'count-text-lines)
+      (define-key nroff-mode-map "\n"  'electric-nroff-newline)
+      (define-key nroff-mode-map "\en" 'forward-text-line)
+      (define-key nroff-mode-map "\ep" 'backward-text-line)))
+
+(defun nroff-mode ()
+  "Major mode for editing text intended for nroff to format.
+\\{nroff-mode-map}
+Turning on Nroff mode runs text-mode-hook, then nroff-mode-hook.
+Also, try nroff-electric-mode, for automatically inserting
+closing requests for requests that are used in matched pairs."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map nroff-mode-map)
+  (setq mode-name "Nroff")
+  (setq major-mode 'nroff-mode)
+  (set-syntax-table text-mode-syntax-table)
+  (setq local-abbrev-table nroff-mode-abbrev-table)
+  (make-local-variable 'nroff-electric-mode)
+  ;; now define a bunch of variables for use by commands in this mode
+  (make-local-variable 'page-delimiter)
+  (setq page-delimiter "^\\.\\(bp\\|SK\\|OP\\)")
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^[.']\\|" paragraph-start))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate (concat "^[.']\\|" paragraph-separate))
+  ;; comment syntax added by mit-erl!gildea 18 Apr 86
+  (make-local-variable 'comment-start)
+  (setq comment-start "\\\" ")
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "\\\\\"[ \t]*")
+  (make-local-variable 'comment-column)
+  (setq comment-column 24)
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'nroff-comment-indent)
+  (run-hooks 'text-mode-hook 'nroff-mode-hook))
+
+;;; Compute how much to indent a comment in nroff/troff source.
+;;; By mit-erl!gildea April 86
+(defun nroff-comment-indent ()
+  "Compute indent for an nroff/troff comment.
+Puts a full-stop before comments on a line by themselves."
+  (let ((pt (point)))
+    (unwind-protect
+       (progn
+         (skip-chars-backward " \t")
+         (if (bolp)
+             (progn
+               (setq pt (1+ pt))
+               (insert ?.)
+               1)
+           (if (save-excursion
+                 (backward-char 1)
+                 (looking-at "^[.']"))
+               1
+             (max comment-column
+                  (* 8 (/ (+ (current-column)
+                             9) 8)))))) ; add 9 to ensure at least two blanks
+      (goto-char pt))))
+
+(defun count-text-lines (start end &optional print)
+  "Count lines in region, except for nroff request lines.
+All lines not starting with a period are counted up.
+Interactively, print result in echo area.
+Noninteractively, return number of non-request lines from START to END."
+  (interactive "r\np")
+  (if print
+      (message "Region has %d text lines" (count-text-lines start end))
+    (save-excursion
+      (save-restriction
+       (narrow-to-region start end)
+       (goto-char (point-min))
+       (- (buffer-size) (forward-text-line (buffer-size)))))))
+
+(defun forward-text-line (&optional cnt)
+  "Go forward one nroff text line, skipping lines of nroff requests.
+An argument is a repeat count; if negative, move backward."
+  (interactive "p")
+  (if (not cnt) (setq cnt 1))
+  (while (and (> cnt 0) (not (eobp)))
+    (forward-line 1)
+    (while (and (not (eobp)) (looking-at "[.']."))
+      (forward-line 1))
+    (setq cnt (- cnt 1)))
+  (while (and (< cnt 0) (not (bobp)))
+    (forward-line -1)
+    (while (and (not (bobp))
+               (looking-at "[.']."))
+      (forward-line -1))
+    (setq cnt (+ cnt 1)))
+  cnt)
+
+(defun backward-text-line (&optional cnt)
+  "Go backward one nroff text line, skipping lines of nroff requests.
+An argument is a repeat count; negative means move forward."
+  (interactive "p")
+  (forward-text-line (- cnt)))
+
+(defconst nroff-brace-table
+  '((".(b" . ".)b")
+    (".(l" . ".)l")
+    (".(q" . ".)q")
+    (".(c" . ".)c")
+    (".(x" . ".)x")
+    (".(z" . ".)z")
+    (".(d" . ".)d")
+    (".(f" . ".)f")
+    (".LG" . ".NL")
+    (".SM" . ".NL")
+    (".LD" . ".DE")
+    (".CD" . ".DE")
+    (".BD" . ".DE")
+    (".DS" . ".DE")
+    (".DF" . ".DE")
+    (".FS" . ".FE")
+    (".KS" . ".KE")
+    (".KF" . ".KE")
+    (".LB" . ".LE")
+    (".AL" . ".LE")
+    (".BL" . ".LE")
+    (".DL" . ".LE")
+    (".ML" . ".LE")
+    (".RL" . ".LE")
+    (".VL" . ".LE")
+    (".RS" . ".RE")
+    (".TS" . ".TE")
+    (".EQ" . ".EN")
+    (".PS" . ".PE")
+    (".BS" . ".BE")
+    (".G1" . ".G2")                    ; grap
+    (".na" . ".ad b")
+    (".nf" . ".fi")
+    (".de" . "..")))
+
+(defun electric-nroff-newline (arg)
+  "Insert newline for nroff mode; special if electric-nroff mode.
+In electric-nroff-mode, if ending a line containing an nroff opening request,
+automatically inserts the matching closing request after point."
+  (interactive "P")
+  (let ((completion (save-excursion
+                     (beginning-of-line)
+                     (and (null arg)
+                          nroff-electric-mode
+                          (<= (point) (- (point-max) 3))
+                          (cdr (assoc (buffer-substring (point)
+                                                        (+ 3 (point)))
+                                      nroff-brace-table)))))
+       (needs-nl (not (looking-at "[ \t]*$"))))
+    (if (null completion)
+       (newline (prefix-numeric-value arg))
+      (save-excursion
+       (insert "\n\n" completion)
+       (if needs-nl (insert "\n")))
+      (forward-char 1))))
+
+(defun electric-nroff-mode (&optional arg)
+  "Toggle nroff-electric-newline minor mode
+Nroff-electric-newline forces emacs to check for an nroff
+request at the beginning of the line, and insert the
+matching closing request if necessary.  
+This command toggles that mode (off->on, on->off), 
+with an argument, turns it on iff arg is positive, otherwise off."
+  (interactive "P")
+  (or (eq major-mode 'nroff-mode) (error "Must be in nroff mode"))
+  (or (assq 'nroff-electric-mode minor-mode-alist)
+      (setq minor-mode-alist (append minor-mode-alist
+                                    (list '(nroff-electric-mode
+                                            " Electric")))))
+  (setq nroff-electric-mode
+       (cond ((null arg) (null nroff-electric-mode))
+             (t (> (prefix-numeric-value arg) 0)))))
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/options.el b/usr/src/contrib/emacs-18.57/lisp/options.el

new file mode 100644 (file)

index 0000000..59d89c8
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/options.el
@@ -0,0 +1,119 @@
+;; Edit Options command for Emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun 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))))))
+
+(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 ()
+  "Major mode for editing Emacs user option settings.
+Special commands are:
+s -- set variable point points at.  New value read using minibuffer.
+x -- toggle variable, t -> nil, nil -> t.
+1 -- set variable to t.
+0 -- set variable to nil.
+Each variable description is a paragraph.
+For convenience, the characters p and n 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"))
+
+(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 (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)))))
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/outline.el b/usr/src/contrib/emacs-18.57/lisp/outline.el

new file mode 100644 (file)

index 0000000..974895a
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/outline.el
@@ -0,0 +1,335 @@
+;; Outline mode commands for Emacs
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
+  
+(defvar outline-regexp "[*\^l]+"
+  "*Regular expression to match the beginning of a heading line.
+Any line whose beginning matches this regexp is considered a heading.
+The recommended way to set this is with a Local Variables: list
+in the file it applies to.")
+
+(defvar outline-mode-map nil "")
+
+(if outline-mode-map
+    nil
+  (setq outline-mode-map (copy-keymap text-mode-map))
+  (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading)
+  (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
+  (define-key outline-mode-map "\C-c\C-i" 'show-children)
+  (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
+  (define-key outline-mode-map "\C-c\C-h" 'hide-subtree)
+  (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
+  (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
+  (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level))
+
+(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:
+C-c C-n   outline-next-visible-heading      move by visible headings
+C-c C-p   outline-previous-visible-heading
+C-c C-f   outline-forward-same-level        similar but skip subheadings
+C-c C-b   outline-backward-same-level
+C-c C-u   outline-up-heading               move from subheading to heading
+
+Meta-x hide-body       make all text invisible (not headings).
+Meta-x 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.
+C-c C-h   hide-subtree make body and subheadings invisible.
+C-c C-s   show-subtree make body and subheadings visible.
+C-c C-i   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.
+M-x hide-entry    make immediately following body invisible.
+M-x show-entry    make it visible.
+M-x hide-leaves           make body under heading and under its subheadings invisible.
+                    The subheadings remain visible.
+M-x 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 "\\)"))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate (concat paragraph-separate "\\|^\\("
+                                  outline-regexp "\\)"))
+  (run-hooks 'text-mode-hook 'outline-mode-hook))
+\f
+(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 length of whatever 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 (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 (possibly invisible) heading line,
+or to beginning of this line if it is a heading line."
+  (beginning-of-line)
+  (or (outline-on-heading-p)
+      (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move)))
+
+(defun outline-on-heading-p ()
+  "Return T if point is on a header line."
+  (save-excursion
+    (beginning-of-line)
+    (and (eq (preceding-char) ?\n)
+        (looking-at outline-regexp))))
+
+(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))
+  (re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil 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 `\\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
+        (subst-char-in-region from to
+                             (if (= flag ?\n) ?\^M ?\n)
+                             flag t)
+     (set-buffer-modified-p modp))))
+\f
+(defun hide-entry ()
+  "Hide the body directly following this heading."
+  (interactive)
+  (outline-back-to-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))
+      (while (not (eobp))
+       (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)
+       (if (not (eobp))
+           (forward-char
+            (if (looking-at "[\n\^M][\n\^M]")
+                2 1)))))))
+
+(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)
+  (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 outline-flag-subtree (flag)
+  (save-excursion
+    (outline-back-to-heading)
+    (outline-flag-region (point)
+                         (progn (outline-end-of-subtree) (point))
+                         flag)))
+
+(defun outline-end-of-subtree ()
+  (beginning-of-line)
+  (let ((opoint (point))
+       (first t)
+       (level (outline-level)))
+    (while (and (not (eobp))
+               (or first (> (outline-level) level)))
+      (setq first nil)
+      (outline-next-heading))
+    (forward-char -1)
+    (if (memq (preceding-char) '(?\n ?\^M))
+       (forward-char -1))))
+\f
+(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.  Optional LEVEL specifies
+how many levels below the current level should be shown."
+  (interactive "p")
+  (or level (setq level 1))
+  (save-excursion
+   (save-restriction
+    (beginning-of-line)
+    (setq level (+ level (outline-level)))
+    (narrow-to-region (point)
+                     (progn (outline-end-of-subtree) (1+ (point))))
+    (goto-char (point-min))
+    (while (and (not (eobp))
+               (progn
+                (outline-next-heading)
+                (not (eobp))))
+      (if (<= (outline-level) level)
+         (save-excursion
+          (let ((end (1+ (point))))
+            (forward-char -1)
+            (if (memq (preceding-char) '(?\n ?\^M))
+                (forward-char -1))
+            (outline-flag-region (point) end ?\n))))))))
+\f
+(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 (outline-level) 1)
+      (error ""))
+    (while (and (> (outline-level) 1)
+               (> arg 0)
+               (not (bobp)))
+      (let ((present-level (outline-level)))
+       (while (not (< (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 from here of the same level as the
+present one. It stops 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 ()
+  "Position the point at the next heading of the same level, 
+and return that position or nil if it cannot be found."
+  (let ((level (outline-level)))
+    (outline-next-visible-heading 1)
+    (while (and (> (outline-level) level)
+               (not (eobp)))
+      (outline-next-visible-heading 1))
+    (if (< (outline-level) level)
+       nil
+      (point))))
+       
+(defun outline-backward-same-level (arg)
+  "Move backward to the ARG'th subheading from here of the same level as the
+present one. It stops 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 ()
+  "Position the point at the previous heading of the same level, 
+and return that position or nil if it cannot be found."
+  (let ((level (outline-level)))
+    (outline-previous-visible-heading 1)
+    (while (and (> (outline-level) level)
+               (not (bobp)))
+      (outline-previous-visible-heading 1))
+    (if (< (outline-level) level)
+       nil
+        (point))))
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/page.el b/usr/src/contrib/emacs-18.57/lisp/page.el

new file mode 100644 (file)

index 0000000..19b29d0
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/page.el
@@ -0,0 +1,123 @@
+;; Page motion commands for emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun forward-page (&optional count)
+  "Move forward to page boundary.  With arg, repeat, or go back if negative.
+A page boundary is any line whose beginning matches the regexp  page-delimiter."
+  (interactive "p")
+  (or count (setq count 1))
+  (while (and (> count 0) (not (eobp)))
+    (if (re-search-forward page-delimiter nil t)
+       nil
+      (goto-char (point-max)))
+    (setq count (1- count)))
+  (while (and (< count 0) (not (bobp)))
+    (forward-char -1)
+    (if (re-search-backward page-delimiter nil t)
+       (goto-char (match-end 0))
+      (goto-char (point-min)))
+    (setq count (1+ count))))
+
+(defun backward-page (&optional count)
+  "Move backward to page boundary.  With arg, repeat, or go fwd if negative.
+A page boundary is any line whose beginning matches the regexp  page-delimiter."
+  (interactive "p")
+  (or count (setq count 1))
+  (forward-page (- count)))
+
+(defun mark-page (&optional arg)
+  "Put mark at end of page, point at beginning.
+A numeric arg specifies to move forward or backward by that many pages,
+thus marking a page other than the one point was originally in."
+  (interactive "P")
+  (setq arg (if arg (prefix-numeric-value arg) 0))
+  (if (> arg 0)
+      (forward-page arg)
+    (if (< arg 0)
+        (forward-page (1- arg))))
+  (forward-page)
+  (push-mark nil t)
+  (forward-page -1))
+
+(defun narrow-to-page (&optional arg)
+  "Make text outside current page invisible.
+A numeric arg specifies to move forward or backward by that many pages,
+thus showing a page other than the one point was originally in."
+  (interactive "P")
+  (setq arg (if arg (prefix-numeric-value arg) 0))
+  (save-excursion
+    (widen)
+    (if (> arg 0)
+       (forward-page arg)
+      (if (< arg 0)
+         (forward-page (1- arg))))
+    ;; Find the end of the page.
+    (forward-page)
+    ;; If we stopped due to end of buffer, stay there.
+    ;; If we stopped after a page delimiter, put end of restriction
+    ;; at the beginning of that line.
+    (if (save-excursion (beginning-of-line)
+                       (looking-at page-delimiter))
+       (beginning-of-line))
+    (narrow-to-region (point)
+                     (progn
+                       ;; Find the top of the page.
+                       (forward-page -1)
+                       ;; If we found beginning of buffer, stay there.
+                       ;; If extra text follows page delimiter on same line,
+                       ;; include it.
+                       ;; Otherwise, show text starting with following line.
+                       (if (and (eolp) (not (bobp)))
+                           (forward-line 1))
+                       (point)))))
+
+(defun count-lines-page ()
+  "Report number of lines on current page, and how many are before or after point."
+  (interactive)
+  (save-excursion
+    (let ((opoint (point)) beg end
+         total before after)
+      (forward-page)
+      (beginning-of-line)
+      (or (looking-at page-delimiter)
+         (end-of-line))
+      (setq end (point))
+      (backward-page)
+      (setq beg (point))
+      (setq total (count-lines beg end)
+           before (count-lines beg opoint)
+           after (count-lines opoint end))
+      (message "Page has %d lines (%d + %d)" total before after))))
+
+(defun what-page ()
+  "Print page and line number of point."
+  (interactive)
+  (save-restriction
+    (widen)
+    (save-excursion
+      (beginning-of-line)
+      (let ((count 1)
+           (opoint (point)))
+       (goto-char 1)
+       (while (re-search-forward page-delimiter opoint t)
+         (setq count (1+ count)))
+       (message "Page %d, line %d"
+                count
+                (1+ (count-lines (point) opoint)))))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/paragraphs.el b/usr/src/contrib/emacs-18.57/lisp/paragraphs.el

new file mode 100644 (file)

index 0000000..cb6c259
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/paragraphs.el
@@ -0,0 +1,199 @@
+;; Paragraph and sentence parsing.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar paragraph-ignore-fill-prefix nil
+  "Non-nil means the paragraph commands are not affected by fill-prefix.
+This is desirable in modes where blank lines are the paragraph delimiters.")
+
+(defun forward-paragraph (&optional arg)
+  "Move forward to end of paragraph.  With arg, do it arg times.
+A line which  paragraph-start  matches either separates paragraphs
+\(if  paragraph-separate  matches it also) or is the first line of a paragraph.
+A paragraph end is the beginning of a line which is not part of the paragraph
+to which the end of the previous line belongs, or the end of the buffer."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (let* ((fill-prefix-regexp
+         (and fill-prefix (not (equal fill-prefix ""))
+              (not paragraph-ignore-fill-prefix)
+              (regexp-quote fill-prefix)))
+        (paragraph-separate
+         (if fill-prefix-regexp
+             (concat paragraph-separate "\\|^"
+                     fill-prefix-regexp "[ \t]*$")
+           paragraph-separate)))
+    (while (< arg 0)
+      (if (and (not (looking-at paragraph-separate))
+              (re-search-backward "^\n" (max (1- (point)) (point-min)) t))
+         nil
+       (forward-char -1) (beginning-of-line)
+       (while (and (not (bobp)) (looking-at paragraph-separate))
+         (forward-line -1))
+       (end-of-line)
+       ;; Search back for line that starts or separates paragraphs.
+       (if (if fill-prefix-regexp
+               ;; There is a fill prefix; it overrides paragraph-start.
+               (progn
+                (while (progn (beginning-of-line)
+                              (and (not (bobp))
+                                   (not (looking-at paragraph-separate))
+                                   (looking-at fill-prefix-regexp)))
+                  (forward-line -1))
+                (not (bobp)))
+             (re-search-backward paragraph-start nil t))
+           ;; Found one.
+           (progn
+             (while (and (not (eobp)) (looking-at paragraph-separate))
+               (forward-line 1))
+             (if (eq (char-after (- (point) 2)) ?\n)
+                 (forward-line -1)))
+         ;; No starter or separator line => use buffer beg.
+         (goto-char (point-min))))
+      (setq arg (1+ arg)))
+    (while (> arg 0)
+      (beginning-of-line)
+      (while (prog1 (and (not (eobp))
+                        (looking-at paragraph-separate))
+                   (forward-line 1)))
+      (if fill-prefix-regexp
+         ;; There is a fill prefix; it overrides paragraph-start.
+         (while (and (not (eobp))
+                     (not (looking-at paragraph-separate))
+                     (looking-at fill-prefix-regexp))
+           (forward-line 1))
+       (if (re-search-forward paragraph-start nil t)
+           (goto-char (match-beginning 0))
+         (goto-char (point-max))))
+      (setq arg (1- arg)))))
+
+(defun backward-paragraph (&optional arg)
+  "Move backward to start of paragraph.  With arg, do it arg times.
+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."
+  (interactive)
+  (forward-paragraph 1)
+  (push-mark nil t)
+  (backward-paragraph 1))
+
+(defun kill-paragraph (arg)
+  "Kill to end of paragraph."
+  (interactive "*p")
+  (kill-region (point) (progn (forward-paragraph arg) (point))))
+
+(defun backward-kill-paragraph (arg)
+  "Kill back to start 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.
+Sentence ends are identified by the value of sentence-end
+treated as a regular expression.  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, or backward if negative arg."
+  (interactive "*p")
+  (let ((beg (point)))
+    (forward-sentence arg)
+    (kill-region beg (point))))
+
+(defun backward-kill-sentence (&optional arg)
+  "Kill back from point to start of sentence.
+With arg, repeat, or forward if negative arg."
+  (interactive "*p")
+  (let ((beg (point)))
+    (backward-sentence arg)
+    (kill-region beg (point))))
+
+(defun mark-end-of-sentence (arg)
+  "Put mark at end of sentence.  Arg works as in forward-sentence."
+  (interactive "p")
+  (push-mark
+    (save-excursion
+      (forward-sentence arg)
+      (point))))
+
+(defun transpose-sentences (arg)
+  "Interchange this (next) and previous sentence."
+  (interactive "*p")
+  (transpose-subr 'forward-sentence arg))
diff --git a/usr/src/contrib/emacs-18.57/lisp/paths.el-dist b/usr/src/contrib/emacs-18.57/lisp/paths.el-dist

new file mode 100644 (file)

index 0000000..452997d
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/paths.el-dist
@@ -0,0 +1,120 @@
+;; Define pathnames for use by various Emacs commands.
+;; Copyright (C) 1986, 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; 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.
+
+(defvar Info-directory (expand-file-name "../info/" exec-directory))
+
+(defvar news-path "/usr/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/lib/news/inews") "/usr/lib/news/inews")
+       (t "inews"))
+  "Program to post news.")
+
+(defvar mh-progs
+  (cond ((file-exists-p "/usr/new/mh") "/usr/new/mh/")
+       ((file-exists-p "/usr/local/bin/mh") "/usr/local/bin/mh/")
+       (t "/usr/local/mh/"))
+  "Directory containing MH commands")
+
+(defvar mh-lib
+  (cond ((file-exists-p "/usr/new/lib/mh") "/usr/new/lib/mh/")
+       ((file-exists-p "/usr/local/lib/mh") "/usr/local/lib/mh/")
+       (t "/usr/local/bin/mh/"))
+  "Directory of MH library")
+
+(defconst rmail-file-name "~/RMAIL"
+  "Name of user's primary mail file.")
+
+(defconst rmail-spool-directory
+  (if (memq system-type '(hpux usg-unix-v unisoft-unix rtu
+                              silicon-graphics-unix))
+      "/usr/mail/"
+    "/usr/spool/mail/")
+  "Name of directory used by system mailer for delivering new mail.
+Its name should end with a slash.")
+
+(defconst sendmail-program
+  (if (file-exists-p "/usr/lib/sendmail")
+      "/usr/lib/sendmail"
+    "fakemail")                        ;In ../etc, to interface to /bin/mail.
+  "Program used to send messages.")
+
+(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 manual-program (if (eq system-type 'berkeley-unix)
+                            "/usr/ucb/man" "/usr/bin/man")
+  "Program to run to print man pages.")
+
+;; Note that /usr/man/cat is not really right for this on sysV; nothing is,
+;; judging by the list of directories below.  You can't get the dir
+;; for a section by appending the section number to any one prefix.
+;; But it turns out that a string that's wrong does no harm here.
+(defconst manual-formatted-dir-prefix
+  (if (file-exists-p "/usr/man/cat.C")  ;; Check for Xenix.
+      "/usr/man/cat." "/usr/man/cat")
+  "Prefix for directories containing formatted manual pages.
+Append a section-number or section-name to get a directory name.")
+
+(defconst manual-formatted-dirlist
+  (cond ((eq system-type 'hpux)
+        '("/usr/man/cat1" "/usr/man/cat2" "/usr/man/cat3"
+          "/usr/man/cat4" "/usr/man/cat5" "/usr/man/cat6"
+          "/usr/man/cat7" "/usr/man/cat1m" "/usr/man/cat8"
+          "/usr/local/man/cat1" "/usr/local/man/cat2" "/usr/local/man/cat3"
+          "/usr/local/man/cat4" "/usr/local/man/cat5" "/usr/local/man/cat6"
+          "/usr/local/man/cat7" "/usr/local/man/cat1m" "/usr/local/man/cat8"
+          "/usr/contrib/man/cat1" "/usr/contrib/man/cat2"
+          "/usr/contrib/man/cat3" "/usr/contrib/man/cat4"
+          "/usr/contrib/man/cat5" "/usr/contrib/man/cat6"
+          "/usr/contrib/man/cat7" "/usr/contrib/man/cat1m"
+          "/usr/contrib/man/cat8"))
+        ((file-exists-p "/usr/man/cat.C")  ; Xenix
+         '("/usr/man/cat.C" "/usr/man/cat.CP" "/usr/man/cat.CT"
+           "/usr/man/cat.DOS/" "/usr/man/cat.F" "/usr/man/cat.HW"
+           "/usr/man/cat.M/" "/usr/man/cat.S" "/usr/man/cat.LOCAL"))
+        ((file-exists-p "/usr/man/cat1")
+         '("/usr/man/cat1" "/usr/man/cat2" "/usr/man/cat3"
+           "/usr/man/cat4" "/usr/man/cat5" "/usr/man/cat6"
+           "/usr/man/cat7" "/usr/man/cat8" "/usr/man/catl" "/usr/man/catn"))
+        (t
+          '("/usr/catman/u_man/man1" "/usr/catman/u_man/man6"
+            "/usr/catman/p_man/man2" "/usr/catman/p_man/man3"
+            "/usr/catman/p_man/man4" "/usr/catman/p_man/man5"
+            "/usr/catman/a_man/man1" "/usr/catman/a_man/man7"
+            "/usr/catman/a_man/man8" "/usr/catman/local")))
+  "List of directories containing formatted manual pages.")
+
+(defconst abbrev-file-name 
+  (if (eq system-type 'vax-vms)
+      "~/abbrev.def"
+    "~/.abbrev_defs")
+  "*Default name of file to read abbrevs from.")
diff --git a/usr/src/contrib/emacs-18.57/lisp/picture.el b/usr/src/contrib/emacs-18.57/lisp/picture.el

new file mode 100644 (file)

index 0000000..393c2f7
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/picture.el
@@ -0,0 +1,563 @@
+;; "Picture mode" -- editing using quarter-plane screen model.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(provide 'picture)
+
+(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."
+  (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))))))
+
+\f
+;; Picture Movement Commands
+
+(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))))
+
+(defun picture-forward-column (arg)
+  "Move cursor right, making whitespace if necessary.
+With argument, move that many columns."
+  (interactive "p")
+  (move-to-column-force (+ (current-column) arg)))
+
+(defun picture-backward-column (arg)
+  "Move cursor left, making whitespace if necessary.
+With argument, move that many columns."
+  (interactive "p")
+  (move-to-column-force (- (current-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)))))
+  ;; Kludge - force the mode line to be updated.  Is there a better
+  ;; way to this?
+  (set-buffer-modified-p (buffer-modified-p))
+  (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)))
+
+\f
+;; 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-input-char)
+    (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)))))
+
+(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)))
+
+(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))))
+
+\f
+;; 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 (move) to next tab stop.
+With 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))
+        (target (prog2 (tab-to-tab-stop)
+                       (current-column)
+                       (delete-region opoint (point)))))
+    (move-to-column-force target)
+    (if arg
+       (let (indent-tabs-mode)
+         (delete-region opoint (point))
+         (indent-to target)))))
+\f
+;; 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-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)))
+
+\f
+;; Picture Keymap, entry and exit points.
+
+(defconst picture-mode-map nil)
+
+(if (not picture-mode-map)
+    (let ((i ?\ ))
+      (setq picture-mode-map (make-keymap))
+      (while (< i ?\177)
+        (aset picture-mode-map i 'picture-self-insert)
+       (setq i (1+ i)))
+      (define-key picture-mode-map "\C-f" 'picture-forward-column)
+      (define-key picture-mode-map "\C-b" 'picture-backward-column)
+      (define-key picture-mode-map "\C-d" 'picture-clear-column)
+      (define-key picture-mode-map "\C-c\C-d" 'delete-char)
+      (define-key picture-mode-map "\177" 'picture-backward-clear-column)
+      (define-key picture-mode-map "\C-k" 'picture-clear-line)
+      (define-key picture-mode-map "\C-o" 'picture-open-line)
+      (define-key picture-mode-map "\C-m" 'picture-newline)
+      (define-key picture-mode-map "\C-j" 'picture-duplicate-line)
+      (define-key picture-mode-map "\C-n" 'picture-move-down)
+      (define-key picture-mode-map "\C-p" 'picture-move-up)
+      (define-key picture-mode-map "\C-e" 'picture-end-of-line)
+      (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 edit-picture-hook nil
+  "If non-nil, it's value is called on entry to Picture mode.
+Picture mode is invoked by the command \\[edit-picture].")
+
+(defun edit-picture ()
+  "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:
+  C-p    Move vertically to SAME column in previous line.
+  C-n    Move vertically to SAME column in next line.
+  C-e    Move to column following last non-whitespace character.
+  C-f    Move right inserting spaces if required.
+  C-b    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.
+  Delete  Clear (replace) ARG columns before point, moving back over them.
+  C-k    Clear ARG lines, advancing over them.  The cleared
+           text is saved in the kill ring.
+  C-o    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  edit-picture-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 'edit-picture)
+      (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 'edit-picture)
+    (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)
+    (picture-set-motion 0 1)
+    (run-hooks 'edit-picture-hook)
+    (message
+     (substitute-command-keys
+      "Type \\[picture-mode-exit] in this buffer to return it to %s mode.")
+     picture-mode-old-mode-name)))
+
+(fset 'picture-mode 'edit-picture)     ; for the confused
+
+(defun picture-mode-exit (&optional nostrip)
+  "Undo edit-picture 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 'edit-picture))
+      (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)
+    ;; Kludge - force the mode line to be updated.  Is there a better
+    ;; way to do this?
+    (set-buffer-modified-p (buffer-modified-p))))
+
+(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)))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/prolog.el b/usr/src/contrib/emacs-18.57/lisp/prolog.el

new file mode 100644 (file)

index 0000000..10903e1
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/prolog.el
@@ -0,0 +1,267 @@
+;; Major mode for editing Prolog, and for running Prolog under Emacs
+;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
+;; Author Masanobu UMEDA (umerin@flab.flab.fujitsu.junet)
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(defvar prolog-mode-syntax-table nil)
+(defvar prolog-mode-abbrev-table nil)
+(defvar prolog-mode-map nil)
+  
+(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 operaing 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 ?< "." 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-hook)
+  (setq comment-indent-hook '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))
+
+(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")
+              (max (1+ (current-column)) ;Insert one space at least
+                   comment-column)))
+       ))
+
+\f
+;;;
+;;; Inferior prolog mode
+;;;
+(defvar inferior-prolog-mode-map nil)
+
+;; Moved into inferior-prolog-mode
+;;(if inferior-prolog-mode-map
+;;    nil
+;;  (setq inferior-prolog-mode-map (copy-alist shell-mode-map))
+;;  (prolog-mode-commands inferior-prolog-mode-map))
+
+(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 shell-mode-hook.
+prolog-mode-hook is called after shell-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.
+\\[shell-send-eof] sends end-of-file as input.
+\\[kill-shell-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
+\\[interrupt-shell-subjob] interrupts the shell or its current subjob if any.
+\\[stop-shell-subjob] stops, likewise. \\[quit-shell-subjob] sends quit signal, likewise."
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'inferior-prolog-mode)
+  (setq mode-name "Inferior Prolog")
+  (setq mode-line-process '(": %s"))
+  (prolog-mode-variables)
+  (require 'shell)
+  (if inferior-prolog-mode-map
+      nil
+    (setq inferior-prolog-mode-map (copy-alist shell-mode-map))
+    (prolog-mode-commands inferior-prolog-mode-map))
+  (use-local-map inferior-prolog-mode-map)
+  (make-local-variable 'last-input-start)
+  (setq last-input-start (make-marker))
+  (make-local-variable 'last-input-end)
+  (setq last-input-end (make-marker))
+  (make-variable-buffer-local 'shell-prompt-pattern)
+  (setq shell-prompt-pattern "^| [ ?][- ] *") ;Set prolog prompt pattern
+  (run-hooks 'shell-mode-hook 'prolog-mode-hook))
+
+(defun run-prolog ()
+  "Run an inferior Prolog process, input and output via buffer *prolog*."
+  (interactive)
+  (require 'shell)
+  (switch-to-buffer (make-shell "prolog" "prolog"))
+  (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*"))
diff --git a/usr/src/contrib/emacs-18.57/lisp/rect.el b/usr/src/contrib/emacs-18.57/lisp/rect.el

new file mode 100644 (file)

index 0000000..5eabcd4
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rect.el
@@ -0,0 +1,203 @@
+;; Rectangle functions for GNU Emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun operate-on-rectangle (function start end coerce-tabs)
+  "Call FUNCTION for each line of rectangle with corners at START, END.
+If COERCE-TABS is non-nil, convert multi-column characters
+that span the starting or ending columns on any line
+to multiple spaces before calling FUNCTION.
+FUNCTION is called with three arguments:
+ position of start of segment of this line within the rectangle,
+ number of columns that belong to rectangle but are before that position,
+ number of columns that belong to rectangle but are after point.
+Point is at the end of the segment of this line within the rectangle."
+  (let (startcol startlinepos endcol endlinepos)
+    (save-excursion
+     (goto-char start)
+     (setq startcol (current-column))
+     (beginning-of-line)
+     (setq startlinepos (point)))
+    (save-excursion
+     (goto-char end)
+     (setq endcol (current-column))
+     (forward-line 1)
+     (setq endlinepos (point-marker)))
+    (if (< endcol startcol)
+       (let ((tem startcol))
+         (setq startcol endcol endcol tem)))
+    (if (/= endcol startcol)
+       (save-excursion
+        (goto-char startlinepos)
+        (while (< (point) endlinepos)
+          (let (startpos begextra endextra)
+            (move-to-column startcol)
+            (and coerce-tabs
+                 (> (current-column) startcol)
+                 (rectangle-coerce-tab startcol))
+            (setq begextra (- (current-column) startcol))
+            (setq startpos (point))
+            (move-to-column endcol)
+            (if (> (current-column) endcol)
+                (if coerce-tabs
+                    (rectangle-coerce-tab endcol)
+                  (forward-char -1)))
+            (setq endextra (- endcol (current-column)))
+            (if (< begextra 0)
+                (setq endextra (+ endextra begextra)
+                      begextra 0))
+            (funcall function startpos begextra endextra))
+          (forward-line 1))))
+    (- endcol startcol)))
+
+(defun delete-rectangle-line (startdelpos ignore ignore)
+  (delete-region startdelpos (point)))
+
+(defun delete-extract-rectangle-line (startdelpos begextra endextra)
+  (save-excursion
+   (extract-rectangle-line startdelpos begextra endextra))
+  (delete-region startdelpos (point)))
+
+(defun extract-rectangle-line (startdelpos begextra endextra)
+  (let ((line (buffer-substring startdelpos (point)))
+       (end (point)))
+    (goto-char startdelpos)
+    (while (search-forward "\t" end t)
+      (let ((width (- (current-column)
+                     (save-excursion (forward-char -1)
+                                     (current-column)))))
+       (setq line (concat (substring line 0 (- (point) end 1))
+                          (spaces-string width)
+                          (substring line (+ (length line) (- (point) end)))))))
+    (if (or (> begextra 0) (> endextra 0))
+       (setq line (concat (spaces-string begextra)
+                          line
+                          (spaces-string endextra))))
+    (setq lines (cons line lines))))
+
+(defconst spaces-strings
+  '["" " " "  " "   " "    " "     " "      " "       " "        "])
+
+(defun spaces-string (n)
+  (if (<= n 8) (aref spaces-strings n)
+    (let ((val ""))
+      (while (> n 8)
+       (setq val (concat "        " val)
+             n (- n 8)))
+      (concat val (aref spaces-strings n)))))
+    
+(defun delete-rectangle (start end)
+  "Delete (don't save) text in rectangle with point and mark as corners.
+The same range of columns is deleted in each line
+starting with the line where the region begins
+and ending with the line where the region ends."
+  (interactive "r")
+  (operate-on-rectangle 'delete-rectangle-line start end t))
+
+(defun delete-extract-rectangle (start end)
+  "Return and delete 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 'delete-extract-rectangle-line
+                         start end t)
+    (nreverse lines)))
+
+(defun extract-rectangle (start end)
+  "Return contents of rectangle with corners at START and END.
+Value is list of strings, one for each line of the rectangle."
+  (let (lines)
+    (operate-on-rectangle 'extract-rectangle-line start end nil)
+    (nreverse lines)))
+
+(defvar killed-rectangle nil
+  "Rectangle for yank-rectangle to insert.")
+
+(defun kill-rectangle (start end)
+  "Delete rectangle with corners at point and mark; save as last killed one.
+Calling from program, supply two args START and END, buffer positions.
+But in programs you might prefer to use delete-extract-rectangle."
+  (interactive "r")
+  (setq killed-rectangle (delete-extract-rectangle start end)))
+
+(defun yank-rectangle ()
+  "Yank the last killed rectangle with upper left corner at point."
+  (interactive)
+  (insert-rectangle killed-rectangle))
+
+(defun insert-rectangle (rectangle)
+  "Insert text of RECTANGLE with upper left corner at point.
+RECTANGLE's first line is inserted at point,
+its second line is inserted at a point vertically under point, etc.
+RECTANGLE should be a list of strings."
+  (let ((lines rectangle)
+       (insertcolumn (current-column))
+       (first t))
+    (while lines
+      (or first
+         (progn
+          (forward-line 1)
+          (or (bolp) (insert ?\n))
+          (move-to-column insertcolumn)
+          (if (> (current-column) insertcolumn)
+              (rectangle-coerce-tab insertcolumn))
+          (if (< (current-column) insertcolumn)
+              (indent-to insertcolumn))))
+      (setq first nil)
+      (insert (car lines))
+      (setq lines (cdr lines)))))
+
+(defun open-rectangle (start end)
+  "Blank out rectangle with corners at point and mark, shifting text right.
+The text previously in the region is not overwritten by the blanks,
+but insted winds up to the right of the rectangle."
+  (interactive "r")
+  (operate-on-rectangle 'open-rectangle-line start end nil))
+
+(defun open-rectangle-line (startpos begextra endextra)
+  (let ((column (+ (current-column) begextra endextra)))
+    (goto-char startpos)
+    (let ((ocol (current-column)))
+      (skip-chars-forward " \t")
+      (setq column (+ column (- (current-column) ocol))))
+    (delete-region (point)
+                   (progn (skip-chars-backward " \t")
+                         (point)))
+    (indent-to column)))
+
+(defun clear-rectangle (start end)
+  "Blank out rectangle with corners at point and mark.
+The text previously in the region is overwritten by the blanks."
+  (interactive "r")
+  (operate-on-rectangle 'clear-rectangle-line start end t))
+
+(defun clear-rectangle-line (startpos begextra endextra)
+  (skip-chars-forward " \t")
+  (let ((column (+ (current-column) endextra)))
+    (delete-region (point)
+                   (progn (goto-char startpos)
+                         (skip-chars-backward " \t")
+                         (point)))
+    (indent-to column)))
+
+(defun rectangle-coerce-tab (column)
+  (let ((aftercol (current-column))
+       (indent-tabs-mode nil))
+    (delete-char -1)
+    (indent-to aftercol)
+    (backward-char (- aftercol column))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/register.el b/usr/src/contrib/emacs-18.57/lisp/register.el

new file mode 100644 (file)

index 0000000..ead49c3
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/register.el
@@ -0,0 +1,175 @@
+;; Register commands for Emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(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,
+mark or list.  A list represents a rectangle; its elements are strings.")
+
+(defun get-register (char)
+  "Return contents of Emacs register named CHAR, or nil if none."
+  (cdr (assq char register-alist)))
+
+(defun set-register (char value)
+  "Set contents of Emacs register named CHAR to VALUE."
+  (let ((aelt (assq char register-alist)))
+    (if aelt
+       (setcdr aelt value)
+      (setq aelt (cons char value))
+      (setq register-alist (cons aelt register-alist)))))
+
+(defun point-to-register (char)
+  "Store current location of point in a register.
+Argument is a character, naming the register."
+  (interactive "cPoint to register: ")
+  (set-register char (point-marker)))
+
+(defun register-to-point (char)
+  "Move point to location stored in a register.
+Argument is a character, naming the register."
+  (interactive "cRegister to point: ")
+  (let ((val (get-register char)))
+    (if (markerp val)
+       (progn
+         (switch-to-buffer (marker-buffer val))
+         (goto-char val))
+      (error "Register doesn't contain a buffer position"))))
+
+;(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 (char)
+  "Display what is contained in register named REGISTER.
+REGISTER is a character."
+  (interactive "cView register: ")
+  (let ((val (get-register char)))
+    (if (null val)
+       (message "Register %s is empty" (single-key-description char))
+      (with-output-to-temp-buffer "*Output*"
+       (princ "Register ")
+       (princ (single-key-description char))
+       (princ " contains ")
+       (if (integerp val)
+           (princ val)
+         (if (markerp val)
+             (progn
+               (princ "a buffer position:\nbuffer ")
+               (princ (buffer-name (marker-buffer val)))
+               (princ ", position ")
+               (princ (+ 0 val)))
+           (if (consp val)
+               (progn
+                 (princ "the rectangle:\n")
+                 (while val
+                   (princ (car val))
+                   (terpri)
+                   (setq val (cdr val))))
+             (princ "the string:\n")
+             (princ val))))))))
+
+(defun insert-register (char &optional arg)
+  "Insert contents of register REG.  REG 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 char)))
+    (if (consp val)
+       (insert-rectangle val)
+      (if (stringp val)
+         (insert val)
+       (if (or (integerp val) (markerp val))
+           (princ (+ 0 val) (current-buffer))
+         (error "Register does not contain text")))))
+  (or arg (exchange-point-and-mark)))
+
+(defun copy-to-register (char start end &optional delete-flag)
+  "Copy region into register REG.
+With prefix arg, delete as well.
+Called from program, takes four args:
+REG, START, END and DELETE-FLAG.
+START and END are buffer positions indicating what to copy."
+  (interactive "cCopy to register: \nr\nP")
+  (set-register char (buffer-substring start end))
+  (if delete-flag (delete-region start end)))
+
+(defun append-to-register (char start end &optional delete-flag)
+  "Append region to text in register REG.
+With prefix arg, delete as well.
+Called from program, takes four args:
+REG, 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 char))
+      (error "Register does not contain text"))
+  (set-register char (concat (get-register char)
+                            (buffer-substring start end)))
+  (if delete-flag (delete-region start end)))
+
+(defun prepend-to-register (char start end &optional delete-flag)
+  "Prepend region to text in register REG.
+With prefix arg, delete as well.
+Called from program, takes four args:
+REG, 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 char))
+      (error "Register does not contain text"))
+  (set-register char (concat (buffer-substring start end)
+                            (get-register char)))
+  (if delete-flag (delete-region start end)))
+
+(defun copy-rectangle-to-register (char start end &optional delete-flag)
+  "Copy rectangular region into register REG.
+With prefix arg, delete as well.
+Called from program, takes four args:
+REG, 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 char
+               (if delete-flag
+                   (delete-extract-rectangle start end)
+                 (extract-rectangle start end))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/replace.el b/usr/src/contrib/emacs-18.57/lisp/replace.el

new file mode 100644 (file)

index 0000000..3c2b81c
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/replace.el
@@ -0,0 +1,307 @@
+;; Replace commands for Emacs.
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(fset '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 "sKeep lines (containing match for regexp): ")
+  (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)))))))
+
+(fset '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 "sFlush lines (containing match for regexp): ")
+  (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))))))
+
+(fset 'count-matches 'how-many)
+(defun how-many (regexp)
+  "Print number of matches for REGEXP following point."
+  (interactive "sHow many matches for (regexp): ")
+  (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 "\C-c\C-c" '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].
+Move point to one of the occurrences in this buffer,
+then use \\[occur-mode-goto-occurrence] to go to the same occurrence
+in the buffer that the occurrences were found in.
+\\{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))
+
+(defun occur-mode-goto-occurrence ()
+  "Go to the line this occurrence was found in, in the buffer it was found in."
+  (interactive)
+  (if (or (null occur-buffer)
+         (null (buffer-name occur-buffer)))
+      (progn
+       (setq occur-buffer nil
+             occur-pos-list nil)
+       (error "Buffer in which occurences were found is deleted.")))
+  (let* ((occur-number (save-excursion
+                       (beginning-of-line)
+                       (/ (1- (count-lines (point-min) (point)))
+                          (cond ((< occur-nlines 0)
+                                 (- 2 occur-nlines))
+                                ((> occur-nlines 0)
+                                 (+ 2 (* 2 occur-nlines)))
+                                (t 1)))))
+        (pos (nth occur-number occur-pos-list)))
+    (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.")
+
+(fset 'list-matching-lines 'occur)
+(defun occur (regexp &optional nlines)
+  "Show all lines following point containing a match for REGEXP.
+Display each line 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 "sList lines matching regexp: \nP")
+  (setq nlines (if nlines (prefix-numeric-value nlines)
+                list-matching-lines-default-context-lines))
+  (let ((first t)
+       (buffer (current-buffer))
+       linenum prevpos)
+    (save-excursion
+      (beginning-of-line)
+      (setq linenum (1+ (count-lines (point-min) (point))))
+      (setq prevpos (point)))
+    (with-output-to-temp-buffer "*Occur*"
+      (save-excursion
+       (set-buffer standard-output)
+       (insert "Lines matching ")
+       (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))
+         (beginning-of-line 1)
+         (save-excursion
+           (setq linenum (+ linenum (count-lines prevpos (point))))
+           (setq prevpos (point)))
+         (let* ((start (save-excursion
+                         (forward-line (if (< nlines 0) nlines (- nlines)))
+                         (point)))
+                (end (save-excursion
+                       (if (> nlines 0)
+                           (forward-line (1+ nlines))
+                           (forward-line 1))
+                       (point)))
+                (tag (format "%3d" 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)
+             (backward-char (- end start))
+             (setq tem (if (< nlines 0) (- nlines) nlines))
+             (while (> tem 0)
+               (insert empty ?:)
+               (forward-line 1)
+               (setq tem (1- tem)))
+             (insert tag ?:)
+             (forward-line 1)
+             (while (< tem nlines)
+               (insert empty ?:)
+               (forward-line 1)
+               (setq tem (1+ tem))))                           
+           (forward-line 1)))
+       (set-buffer standard-output)
+       ;; Put positions in increasing order to go with buffer.
+       (setq occur-pos-list (nreverse occur-pos-list))
+       (if (interactive-p)
+           (message "%d matching lines." (length occur-pos-list)))))))
+\f
+(defconst query-replace-help
+  "Type Space or `y' to replace one match, Delete or `n' to skip to next,
+ESC 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")
+
+(defun perform-replace (from-string to-string
+                       query-flag regexp-flag delimited-flag)
+  (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)
+       (keep-going t)
+       (lastrepl nil))                 ;Position after last match considered.
+    (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)
+    (push-mark)
+    (while (and keep-going
+               (not (eobp))
+               (progn
+                (set-mark (point))
+                (funcall search-function search-string nil t)))
+      ;; Don't replace the null string 
+      ;; right after end of previous replacement.
+      (if (eq lastrepl (point))
+         (forward-char 1)
+       (undo-boundary)
+       (if (not query-flag)
+           (replace-match to-string nocasify literal)
+         (let (done replaced)
+           (while (not done)
+             ;; Preserve the match data.  Process filters and sentinels
+             ;; could run inside read-char..
+             (let ((data (match-data))
+                   (help-form
+                    '(concat "Query replacing "
+                             (if regexp-flag "regexp " "")
+                             from-string " with " to-string ".\n\n"
+                             (substitute-command-keys query-replace-help))))
+               (setq char help-char)
+               (while (= char help-char)
+                 (message "Query replacing %s with %s: " from-string to-string)
+                 (setq char (read-char))
+                 (if (= char ??)
+                     (setq unread-command-char help-char char help-char)))
+               (store-match-data data))
+             (cond ((or (= char ?\e)
+                        (= char ?q))
+                    (setq keep-going nil)
+                    (setq done t))
+                   ((= char ?^)
+                    (goto-char (mark))
+                    (setq replaced t))
+                   ((or (= char ?\ )
+                        (= char ?y))
+                    (or replaced
+                        (replace-match to-string nocasify literal))
+                    (setq done t))
+                   ((= char ?\.)
+                    (or replaced
+                        (replace-match to-string nocasify literal))
+                    (setq keep-going nil)
+                    (setq done t))
+                   ((= char ?\,)
+                    (if (not replaced)
+                        (progn
+                          (replace-match to-string nocasify literal)
+                          (setq replaced t))))
+                   ((= char ?!)
+                    (or replaced
+                        (replace-match to-string nocasify literal))
+                    (setq done t query-flag nil))
+                   ((or (= char ?\177)
+                        (= char ?n))
+                    (setq done t))
+                   ((= char ?\C-l)
+                    (recenter nil))
+                   ((= char ?\C-r)
+                    (store-match-data
+                      (prog1 (match-data)
+                        (save-excursion (recursive-edit)))))
+                   ((= char ?\C-w)
+                    (delete-region (match-beginning 0) (match-end 0))
+                    (store-match-data
+                      (prog1 (match-data)
+                        (save-excursion (recursive-edit))))
+                    (setq replaced t))
+                   (t
+                    (setq keep-going nil)
+                    (setq unread-command-char char)
+                    (setq done t))))))
+       (setq lastrepl (point))))
+    (pop-mark)
+    keep-going))
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/rfc822.el b/usr/src/contrib/emacs-18.57/lisp/rfc822.el

new file mode 100644 (file)

index 0000000..18cf3c9
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rfc822.el
@@ -0,0 +1,305 @@
+;; Hairy rfc822 parser for mail and news and suchlike
+;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
+;; Author Richard Mlynarik.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(provide 'rfc822)
+
+;; 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
+                                   ":\n\t  \"")
+    (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))))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/rmail.el b/usr/src/contrib/emacs-18.57/lisp/rmail.el

new file mode 100644 (file)

index 0000000..6afc482
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rmail.el
@@ -0,0 +1,1392 @@
+;; "RMAIL" mail reader for Emacs.
+;; Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; 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.
+
+(require 'mail-utils)
+(provide 'rmail)
+
+; these variables now declared in loaddefs or 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.  It's name should end with a slash.")
+;(defvar rmail-dont-reply-to-names
+;  nil
+;  "*A regexp specifying names to prune of reply to messages.
+;nil means dont reply to yourself.")
+;(defvar rmail-ignored-headers
+;   "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^message-id:\\|^summary-line:"
+;   "*Gubbish headers one would rather not see.")
+;(defvar rmail-file-name
+;  (expand-file-name "~/RMAIL")
+;  "")
+;
+;(defvar rmail-delete-after-output nil
+;  "*Non-nil means automatically delete a message that is copied to a file.")
+;
+;(defvar rmail-primary-inbox-list 
+;  '("/usr/spool/mail/$USER" "~/mbox")
+; "")
+
+;; these may be altered by site-init.el to match the format of mmdf files
+;;  delimitation 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, is a filter function for new headers in RMAIL.
+Called with region narrowed to unformatted header.")
+
+(defvar rmail-mode-map 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)
+
+;; 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 labels specified to C-M-n or C-M-p or C-M-l.
+(defvar rmail-last-multi-labels nil)
+(defvar rmail-last-file nil)
+(defvar rmail-last-rmail-file nil)
+\f
+;;;; *** Rmail Mode ***
+
+(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 filename as argument;
+then performs rmail editing on that file,
+but does not copy any new mail into the file."
+  (interactive (if current-prefix-arg
+                  (list (read-file-name "Run rmail on RMAIL file: "
+                                        nil nil t))))
+  (or rmail-last-file
+      (setq rmail-last-file (expand-file-name "~/xmail")))
+  (or rmail-last-rmail-file
+      (setq rmail-last-rmail-file (expand-file-name "~/XMAIL")))
+  (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name)))
+        (existed (get-file-buffer file-name))
+        ;; Don't be confused by apparent local-variables spec
+        ;; in the last message in the RMAIL file.
+        (inhibit-local-variables t))
+    ;; 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
+         (find-file file-name)
+         (if (and (verify-visited-file-modtime existed)
+                  (eq major-mode 'rmail-mode))
+             (progn (rmail-forget-messages)
+                    (rmail-set-message-counters))))
+      (find-file file-name))
+    (if (eq major-mode 'rmail-edit-mode)
+       (error "exit rmail-edit-mode before getting new mail"))
+    (if (and existed (eq major-mode 'rmail-mode))
+       nil
+      (rmail-mode)
+      ;; Provide default set of inboxes for primary mail file ~/RMAIL.
+      (and (null rmail-inbox-list)
+          (null file-name-arg)
+          (setq rmail-inbox-list
+                (or rmail-primary-inbox-list
+                    (list "~/mbox"
+                          (concat rmail-spool-directory
+                                  (or (getenv "LOGNAME")
+                                      (getenv "USER")
+                                      (user-login-name)))))))
+      ;; 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))))
+    (rmail-get-new-mail)))
+
+(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:\n")))
+         (t
+          (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
+           (progn (goto-char (point-max))
+                  (search-backward "\^_")
+                  (forward-char 1)
+                  (looking-at "\n*From ")))
+       (let ((buffer-read-only nil))
+         (message "Converting to Babyl format...")
+         (narrow-to-region (point) (point-max))
+         (rmail-convert-to-babyl-format)
+         (message "Converting to Babyl format...done")))))
+
+(defun rmail-insert-rmail-file-header ()
+  (let ((buffer-read-only nil))
+    (insert "BABYL OPTIONS:
+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 "." 'rmail-beginning-of-message)
+  (define-key rmail-mode-map " " 'scroll-up)
+  (define-key rmail-mode-map "\177" 'scroll-down)
+  (define-key rmail-mode-map "n" 'rmail-next-undeleted-message)
+  (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message)
+  (define-key rmail-mode-map "\en" 'rmail-next-message)
+  (define-key rmail-mode-map "\ep" 'rmail-previous-message)
+  (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
+  (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message)
+  (define-key rmail-mode-map "a" 'rmail-add-label)
+  (define-key rmail-mode-map "k" 'rmail-kill-label)
+  (define-key rmail-mode-map "d" 'rmail-delete-forward)
+  (define-key rmail-mode-map "u" 'rmail-undelete-previous-message)
+  (define-key rmail-mode-map "e" 'rmail-expunge)
+  (define-key rmail-mode-map "x" 'rmail-expunge)
+  (define-key rmail-mode-map "s" 'rmail-expunge-and-save)
+  (define-key rmail-mode-map "g" 'rmail-get-new-mail)
+  (define-key rmail-mode-map "h" 'rmail-summary)
+  (define-key rmail-mode-map "\e\C-h" 'rmail-summary)
+  (define-key rmail-mode-map "l" 'rmail-summary-by-labels)
+  (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 "t" 'rmail-toggle-header)
+  (define-key rmail-mode-map "m" 'rmail-mail)
+  (define-key rmail-mode-map "r" 'rmail-reply)
+  (define-key rmail-mode-map "c" 'rmail-continue)
+  (define-key rmail-mode-map "f" 'rmail-forward)
+  (define-key rmail-mode-map "\es" 'rmail-search)
+  (define-key rmail-mode-map "j" 'rmail-show-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 "i" 'rmail-input)
+  (define-key rmail-mode-map "q" 'rmail-quit)
+  (define-key rmail-mode-map ">" 'rmail-last-message)
+  (define-key rmail-mode-map "?" 'describe-mode)
+  (define-key rmail-mode-map "w" 'rmail-edit-current-message)
+  (define-key rmail-mode-map "\C-d" 'rmail-delete-backward))
+
+;; Rmail mode is suitable only for specially formatted data.
+(put 'rmail-mode 'mode-class 'special)
+
+(defun rmail-mode ()
+  "Rmail Mode is used by \\[rmail] for editing Rmail files.
+All normal editing commands are turned off.
+Instead, these commands are available:
+
+.      Move point to front of this message (same as \\[beginning-of-buffer]).
+SPC    Scroll to next screen of this message.
+DEL    Scroll to previous screen of this message.
+n      Move to Next non-deleted message.
+p      Move to Previous non-deleted message.
+M-n    Move to Next message whether deleted or not.
+M-p    Move to Previous message whether deleted or not.
+>      Move to the last message in Rmail file.
+j      Jump to message specified by numeric position in file.
+M-s    Search for string and show message it is found in.
+d      Delete this message, move to next nondeleted.
+C-d    Delete this message, move to previous nondeleted.
+u      Undelete message.  Tries current message, then earlier messages
+       till a deleted message is found.
+e      Expunge deleted messages.
+s      Expunge and save the file.
+q       Quit Rmail: expunge, save, then switch to another buffer.
+C-x C-s Save without expunging.
+g      Move new mail from system spool directory or mbox into this file.
+m      Mail a message (same as \\[mail-other-window]).
+c      Continue composing outgoing message started before.
+r      Reply to this message.  Like m but initializes some fields.
+f      Forward this message to another user.
+o       Output this message to an Rmail file (append it).
+C-o    Output this message to a Unix-format mail file (append it).
+i      Input Rmail file.  Run Rmail on that file.
+a      Add label to message.  It will be displayed in the mode line.
+k      Kill label.  Remove a label from current message.
+C-M-n   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 `a'.
+C-M-p   Move to Previous message with specified label
+C-M-h  Show headers buffer, with a one line summary of each message.
+C-M-l  Like h only just messages with particular label(s) are summarized.
+C-M-r   Like h only just messages with particular recipient(s) are summarized.
+t      Toggle header, show Rmail header if unformatted or vice versa.
+w      Edit the current message.  C-c C-c to return to Rmail."
+  (interactive)
+  (kill-all-local-variables)
+  (rmail-mode-1)
+  (rmail-variables)
+  (run-hooks 'rmail-mode-hook))
+
+(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.
+  (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 'rmail-last-label)
+  (make-local-variable 'rmail-deleted-vector)
+  (make-local-variable 'rmail-keywords)
+  (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 'version-control)
+  (setq version-control 'never)
+  (make-local-variable 'file-precious-flag)
+  (setq file-precious-flag t)
+  (make-local-variable 'rmail-message-vector)
+  (make-local-variable 'rmail-last-file)
+  (make-local-variable 'rmail-inbox-list)
+  (setq rmail-inbox-list (rmail-parse-file-inboxes))
+  (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)
+    ;; 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-set-message-counters)
+         (rmail-show-message)))))
+
+;; 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 "\^_" 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))
+
+(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
+      (bury-buffer rmail-summary-buffer))
+  (let ((obuf (current-buffer)))
+    (switch-to-buffer (other-buffer))
+    (bury-buffer obuf)))
+
+(defun rmail-input (filename)
+  "Run RMAIL on file FILENAME."
+  (interactive "FRun rmail on RMAIL file: ")
+  (rmail filename))
+
+\f
+;;;; *** 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.
+These are normally your ~/mbox and 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."
+  (interactive
+   (list (if current-prefix-arg
+            (read-file-name "Get new mail from file: "))))
+  (or (verify-visited-file-modtime (current-buffer))
+      (progn
+       (find-file (buffer-file-name))
+       (if (verify-visited-file-modtime (current-buffer))
+           (rmail-forget-messages))))
+  (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))
+  (unwind-protect
+      (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))
+       (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 (list file-name) nil)
+             (setq delete-files (rmail-insert-inbox-text rmail-inbox-list t)))
+           ;; Scan the new text and convert each message to babyl format.
+           (goto-char (point-min))
+           (save-excursion
+             (setq new-messages (rmail-convert-to-babyl-format)))
+           (or (zerop new-messages)
+               (let (success)
+                 (widen)
+                 (search-backward "\^_")
+                 (narrow-to-region (point) (point-max))
+                 (goto-char (1+ (point-min)))
+                 (rmail-count-new-messages)
+                 (save-buffer)))
+           ;; Delete the old files, now that babyl file is saved.
+           (while delete-files
+             (condition-case ()
+                 (delete-file (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)")))
+           (message "%d new message%s read"
+                    new-messages (if (= 1 new-messages) "" "s"))))
+    ;; Don't leave the buffer screwed up if we get a disk-full error.
+    (rmail-show-message)))
+
+(defun rmail-insert-inbox-text (files renamep)
+  (let (file tofile delete-files movemail popmail)
+    (while files
+      (setq file (expand-file-name (substitute-in-file-name (car files)))
+           ;;>> un*x specific <<
+           tofile (concat file "~"))
+      ;; If getting from mail spool directory,
+      ;; use movemail to move rather than renaming.
+      (setq movemail (equal (file-name-directory file) rmail-spool-directory))
+      (setq popmail (string-match "^po:" (file-name-nondirectory file)))
+      (if popmail (setq file (file-name-nondirectory file)
+                       renamep t))
+      (if movemail
+         (progn
+           (setq tofile (expand-file-name
+                          ".newmail"
+                          ;; 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))))
+           ;; 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 (or (getenv "LOGNAME")
+                                                (getenv "USER")
+                                                (user-login-name))
+                                            file)))))
+      (if popmail
+         (message "Getting mail from post office ...")
+       (if (or (file-exists-p tofile) (file-exists-p 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))
+            (rename-file file tofile nil))
+           (t
+            (let ((errors nil))
+              (unwind-protect
+                  (save-excursion
+                    (setq errors (generate-new-buffer " *rmail loss*"))
+                    (buffer-flush-undo errors)
+                    (call-process
+                      (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 (concat "movemail: "
+                                       (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)
+         (progn (goto-char (point-max))
+                (insert-file-contents tofile)
+                (goto-char (point-max))
+                (or (= (preceding-char) ?\n)
+                    (insert ?\n))
+                (setq delete-files (cons tofile delete-files))))
+      (message "")
+      (setq files (cdr files)))
+    delete-files))
+
+;; the  rmail-break-forwarded-messages  feature is not implemented
+(defun rmail-convert-to-babyl-format ()
+  (let ((count 0) start
+       (case-fold-search nil))
+    (goto-char (point-min))
+    (save-restriction
+      (while (not (eobp))
+       (cond ((looking-at "BABYL OPTIONS:");Babyl header
+              (search-forward "\n\^_")
+              (delete-region (point-min) (point)))
+             ;; Babyl format message
+             ((looking-at "\^L")
+              (or (search-forward "\n\^_" nil t)
+                  (progn
+                    (message "Invalid Babyl format in inbox!")
+                    (sit-for 1)
+                    (goto-char (point-max))))
+              (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 (re-search-forward
+                   (concat "^[\^_]?\\("
+                           "From [^ \n]*\\(\\|\".*\"[^ \n]*\\)  ?[^ \n]* [^ \n]* *"
+                           "[0-9]* [0-9:]*\\( ?[A-Z]?[A-Z][A-Z]T\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) " ; EDT, -0500
+                           "19[0-9]* *\\(remote from .*\\)?$\\|"
+                           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 is a kludge, in case we're wrong about mmdf not
+             ;;allowing anything in between.  If it loses, we'll have
+             ;;to look for something else
+             (t (delete-char 1)))))
+    count))
+
+(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
+              "^From \\([^ ]*\\(\\|\".*\"[^ ]*\\)\\)  ?\\([^ ]*\\) \\([^ ]*\\) *\\([0-9]*\\) \\([0-9:]*\\)\\( ?[A-Z]?[A-Z][A-Z]T\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) 19\\([0-9]*\\) *\\(remote from [^\n]*\\)?\n" nil t)
+             (replace-match
+               (concat
+                 ;; Keep and reformat the date if we don't
+                 ;;  have a Date: field.
+                 (if has-date
+                     ""
+                   ;; If no time zone specified, assume est.
+                   (if (= (match-beginning 7) (match-end 7))
+                       "Date: \\3, \\5 \\4 \\8 \\6 EST\n"
+                       "Date: \\3, \\5 \\4 \\8 \\6\\7\n"))
+                 ;; Keep and reformat the sender if we don't
+                 ;; have a From: field.
+                 (if has-from
+                     ""
+                   "From: \\1\n")))))))))
+\f
+;;;; *** 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)
+    (if (looking-at "Summary-line: ")
+       (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-ignored-headers (rmail-clear-headers))
+    (if rmail-message-filter (funcall rmail-message-filter))))
+
+(defun rmail-clear-headers ()
+  (if (search-forward "\n\n" nil t)
+      (save-restriction
+        (narrow-to-region (point-min) (point))
+       (let ((buffer-read-only nil))
+         (while (let ((case-fold-search t))
+                  (goto-char (point-min))
+                  (re-search-forward rmail-ignored-headers nil t))
+           (beginning-of-line)
+           (delete-region (point)
+                          (progn (re-search-forward "\n[^ \t]")
+                                 (forward-char -1)
+                                 (point))))))))
+
+(defun rmail-toggle-header ()
+  "Show original message header if pruned header currently shown, or vice versa."
+  (interactive)
+  (rmail-maybe-set-message-counters)
+  (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
+  (let ((buffer-read-only nil))
+    (goto-char (point-min))
+    (forward-line 1)
+    (if (= (following-char) ?1)
+       (progn (delete-char 1)
+              (insert ?0)
+              (forward-line 1)
+              (if (looking-at "Summary-Line:")
+                  (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)))))
+\f
+;;;; *** 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)))))))))))
+       (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
+         (concat " " rmail-current-message "/" rmail-total-messages
+                 blurb))))
+
+;; Turn an attribute of the current message on or off according to STATE.
+;; ATTR is the name of the attribute, as a string.
+(defun rmail-set-attribute (attr state)
+  (let ((omax (- (buffer-size) (point-max)))
+       (omin (- (buffer-size) (point-min)))
+       (buffer-read-only nil))
+    (unwind-protect
+       (save-excursion
+         (widen)
+         (goto-char (+ 3 (rmail-msgbeg rmail-current-message)))
+         (let ((curstate (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 rmail-current-message state)))
+      (narrow-to-region (max 1 (- (buffer-size) omin))
+                       (- (buffer-size) omax))
+      (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)
+  (goto-char (rmail-msgbeg msg))
+  (forward-char 3)
+  (re-search-backward labels (prog1 (point) (end-of-line)) t))
+\f
+;;;; *** 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.
+Assumes that the visible text of the message is not changed by FUNCTION."
+  (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))
+       (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 "\^_")
+    (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 "\^_")
+       (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 "\^_\^L\n" stop t)
+    (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)
+  "Show message number N (prefix argument), counting from start of file."
+  (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))
+           (end (rmail-msgend n)))
+       (goto-char beg)
+       (forward-line 1)
+       (if (= (following-char) ?0)
+           (progn
+             (rmail-reformat-message beg end)
+             (rmail-set-attribute "unseen" nil))
+         (search-forward "\n*** EOOH ***\n" end t)
+         (narrow-to-region (point) end))
+       (goto-char (point-min))
+       (rmail-display-labels)
+       (run-hooks 'rmail-show-message-hook)
+       (if blurb
+           (message blurb))))))
+
+(defun rmail-next-message (n)
+  "Show following message whether deleted or not.
+With prefix argument 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 argument 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 argument N, moves forward N non-deleted messages,
+or backward if N is negative."
+  (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)
+       (rmail-show-message lastwin))
+    (if (< n 0)
+       (message "No previous nondeleted message"))
+    (if (> n 0)
+       (message "No following nondeleted message"))))
+
+(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-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)))
+
+(defvar rmail-search-last-regexp nil)
+(defun rmail-search (regexp &optional reversep)
+  "Show message containing next match for REGEXP.
+Search in reverse (earlier messages) with non-nil 2nd arg REVERSEP.
+Interactively, empty argument means use same regexp used last time,
+and reverse search is specified by a negative numeric arg."
+  (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 reversep)))
+  (message "%sRmail search for %s..."
+          (if reversep "Reverse " "")
+          regexp)
+  (rmail-maybe-set-message-counters)
+  (let ((omin (point-min))
+       (omax (point-max))
+       (opoint (point))
+       win
+       (msg rmail-current-message))
+    (unwind-protect
+       (progn
+         (widen)
+         ;; 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)))))
+      (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 "Searched failed: %s" regexp)))))
+\f
+;;;; *** 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))
+
+(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))))
+
+(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."
+  (interactive "P")
+  (rmail-set-attribute "deleted" t)
+  (rmail-next-undeleted-message (if backward -1 1)))
+
+(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))
+
+(defun rmail-expunge ()
+  "Actually erase all deleted messages in the file."
+  (interactive)
+  (message "Expunging deleted messages...")
+  ;; Discard any prior undo information.
+  (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)
+                         (= ?D (aref rmail-deleted-vector 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 itself.
+        (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)
+               (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)
+           (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))))
+\f
+;;;; *** Rmail Mailing Commands ***
+
+(defun rmail-mail ()
+  "Send mail in another window.
+While composing the message, use \\[mail-yank-original] to yank the
+original message into it."
+  (interactive)
+  (mail-other-window nil nil nil nil nil (current-buffer)))
+
+(defun rmail-continue ()
+  "Continue composing outgoing message previously being composed."
+  (interactive)
+  (mail-other-window 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")
+  ;;>> this gets set even if we abort. Can't do anything about it, though.
+  (rmail-set-attribute "answered" t)
+  (rmail-display-labels)
+  (let (from reply-to cc subject date to message-id resent-reply-to)
+    (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 resent-reply-to (mail-fetch-field "resent-reply-to" t)
+             from (mail-fetch-field "from")
+             reply-to (or resent-reply-to
+                          (mail-fetch-field "reply-to" nil t)
+                          from)
+             cc (cond (just-sender nil)
+                      (resent-reply-to (mail-fetch-field "resent-cc" t))
+                      (t (mail-fetch-field "cc" nil t)))
+             subject (or (and resent-reply-to
+                              (mail-fetch-field "resent-subject" t))
+                         (mail-fetch-field "subject"))
+             date (cond (resent-reply-to
+                         (mail-fetch-field "resent-date" t))
+                        ((mail-fetch-field "date")))
+             to (cond (resent-reply-to
+                       (mail-fetch-field "resent-to" t))
+                      ((mail-fetch-field "to" nil t))
+                      ;((mail-fetch-field "apparently-to")) ack gag barf
+                      (t ""))
+             message-id (cond (resent-reply-to
+                               (mail-fetch-field "resent-message-id" t))
+                              ((mail-fetch-field "message-id"))))))
+    (and subject
+        (string-match "\\`Re: " subject)
+        (setq subject (substring subject 4)))
+    (mail-other-window 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))))
+
+(defun rmail-make-in-reply-to-field (from date message-id)
+  (if mail-use-rfc822 (require 'rfc822))
+  (let (field)
+    (if (and mail-use-rfc822 from)
+       (let ((tem (car (rfc822-addresses from))))
+         (and message-id
+              (setq field (if (string-match
+                                (regexp-quote
+                                  (if (string-match "@[^@]*\\'" tem)
+                                      (substring tem
+                                                 0 (match-beginning 0))
+                                      tem))
+                                message-id)
+                              message-id
+                              (concat message-id " \"" tem "\""))
+                    message-id nil date nil))
+         (or field
+             (setq field (prin1-to-string tem))))
+;      (if message-id
+;          (setq field message-id message-id nil date nil)
+;          (setq field (car (rfc882-addresses from))))
+       )
+    (or field
+       (not from)
+       ;; Compute the sender for the in-reply-to; prefer full name.
+       (let* ((stop-pos (string-match "  *at \\|  *@ \\|  *<" from))
+              (start-pos (if stop-pos 0
+                           ;;>> this loses on nested ()'s
+                           (let ((pos (string-match " *(" from)))
+                             (if (not pos) nil
+                               (setq stop-pos (string-match ")" from pos))
+                               (if (zerop pos) 0 (+ 2 pos)))))))
+         (setq field (if stop-pos
+                         (substring from start-pos stop-pos)
+                         from))))
+    (if date (setq field (concat field "'s message of " date)))
+    (if message-id (setq field (concat field " " message-id)))
+    field))
+
+(defun rmail-forward ()
+  "Forward the current message to another user."
+  (interactive)
+  ;;>> this gets set even if we abort. Can't do anything about it, though.
+  (rmail-set-attribute "forwarded" t)
+  (let ((forward-buffer (current-buffer))
+       (subject (concat "["
+                        (mail-strip-quoted-names (mail-fetch-field "From"))
+                        ": " (or (mail-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))
+         (forward-line 1)
+         (insert-buffer forward-buffer)))))
+\f
+;;;; *** Rmail Specify Inbox Files ***
+
+(autoload 'set-rmail-inbox-list "rmailmsc"
+  "Set the inbox list of the current RMAIL file to FILE-NAME.
+This may be a list of file names separated by commas.
+If FILE-NAME is empty, remove any inbox list."
+  t)
+
+;;;; *** Rmail Commands for Labels ***
+
+(autoload 'rmail-add-label "rmailkwd"
+  "Add LABEL to labels associated with current RMAIL message.
+Completion is performed over known labels when reading."
+  t)
+
+(autoload 'rmail-kill-label "rmailkwd"
+  "Remove LABEL from labels associated with current RMAIL message.
+Completion is performed over known labels when reading."
+  t)
+
+(autoload 'rmail-next-labeled-message "rmailkwd"
+  "Show next message with LABEL.  Defaults to last label used.
+With prefix argument N moves forward N messages with this label."
+  t)
+
+(autoload 'rmail-previous-labeled-message "rmailkwd"
+  "Show previous message with LABEL.  Defaults to last label used.
+With prefix argument N moves backward N messages with this label."
+  t)
+
+;;;; *** Rmail Edit Mode ***
+
+(autoload 'rmail-edit-current-message "rmailedit"
+  "Edit the contents of the current message"
+  t)
+\f
+;;;; *** Rmail Summary Mode ***
+
+(autoload 'rmail-summary "rmailsum"
+  "Display a summary of all messages, one line per message."
+  t)
+
+(autoload 'rmail-summary-by-labels "rmailsum"
+  "Display a summary of all messages with one or more LABELS.
+LABELS should be a string containing the desired labels, separated by commas."
+  t)
+
+(autoload 'rmail-summary-by-recipients "rmailsum"
+  "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 names separated by commas."
+  t)
+\f
+;;;; *** Rmail output messages to files ***
+
+(autoload 'rmail-output-to-rmail-file "rmailout"
+  "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."
+  t)
+
+(autoload 'rmail-output "rmailout"
+  "Append this message to Unix mail file named FILE-NAME."
+  t)
+
+;;;; *** Rmail undigestification ***
+
+(autoload 'undigestify-rmail-message "undigest"
+  "Break up a digest message into its constituent messages.
+Leaves original message, deleted, before the undigestified messages."
+  t)
diff --git a/usr/src/contrib/emacs-18.57/lisp/rmailedit.el b/usr/src/contrib/emacs-18.57/lisp/rmailedit.el

new file mode 100644 (file)

index 0000000..1523f52
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rmailedit.el
@@ -0,0 +1,105 @@
+;; "RMAIL edit mode"  Edit the current message.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(require 'rmail)
+
+(defvar rmail-edit-map nil)
+(if rmail-edit-map
+    nil
+  (setq rmail-edit-map (copy-keymap text-mode-map))
+  (define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit)
+  (define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit))
+
+;; Rmail Edit mode is suitable only for specially formatted data.
+(put 'rmail-edit-mode 'mode-class 'special)
+
+(defun rmail-edit-mode ()
+  "Major mode for editing the contents of an RMAIL message.
+The editing commands are the same as in Text mode, together with two commands
+to return to regular RMAIL:
+  *  rmail-abort-edit cancels the changes
+     you have made and returns to RMAIL
+  *  rmail-cease-edit makes them permanent.
+\\{rmail-edit-map}"
+  (use-local-map rmail-edit-map)
+  (setq major-mode 'rmail-edit-mode)
+  (setq mode-name "RMAIL Edit")
+  (if (boundp 'mode-line-modified)
+      (setq mode-line-modified (default-value 'mode-line-modified))
+    (setq mode-line-format (default-value 'mode-line-format)))
+  (run-hooks 'text-mode-hook 'rmail-edit-mode-hook))
+
+(defun rmail-edit-current-message ()
+  "Edit the contents of this message."
+  (interactive)
+  (rmail-edit-mode)
+  (make-local-variable 'rmail-old-text)
+  (setq rmail-old-text (buffer-substring (point-min) (point-max)))
+  (setq buffer-read-only nil)
+  (set-buffer-modified-p (buffer-modified-p))
+  ;; Make mode line update.
+  (if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit)
+          (eq (key-binding "\C-c\C-]") 'rmail-abort-edit))
+      (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort")
+    (message (substitute-command-keys
+              "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
+
+(defun rmail-cease-edit ()
+  "Finish editing message; switch back to Rmail proper."
+  (interactive)
+  ;; Make sure buffer ends with a newline.
+  (save-excursion
+    (goto-char (point-max))
+    (if (/= (preceding-char) ?\n)
+       (insert "\n"))
+    ;; Adjust the marker that points to the end of this message.
+    (set-marker (aref rmail-message-vector (1+ rmail-current-message))
+               (point)))
+  (let ((old rmail-old-text))
+    ;; Update the mode line.
+    (set-buffer-modified-p (buffer-modified-p))
+    (rmail-mode-1)
+    (if (and (= (length old) (- (point-max) (point-min)))
+            (string= old (buffer-substring (point-min) (point-max))))
+       ()
+      (setq old nil)
+      (rmail-set-attribute "edited" t)
+      (if (boundp 'rmail-summary-vector)
+         (progn
+           (aset rmail-summary-vector (1- rmail-current-message) nil)
+           (save-excursion
+             (rmail-widen-to-current-msgbeg
+               (function (lambda ()
+                           (forward-line 2)
+                           (if (looking-at "Summary-line: ")
+                               (let ((buffer-read-only nil))
+                                 (delete-region (point)
+                                                (progn (forward-line 1)
+                                                       (point))))))))
+             (rmail-show-message))))))
+  (setq buffer-read-only t))
+
+(defun rmail-abort-edit ()
+  "Abort edit of current message; restore original contents."
+  (interactive)
+  (delete-region (point-min) (point-max))
+  (insert rmail-old-text)
+  (rmail-cease-edit))
+
diff --git a/usr/src/contrib/emacs-18.57/lisp/rmailkwd.el b/usr/src/contrib/emacs-18.57/lisp/rmailkwd.el

new file mode 100644 (file)

index 0000000..af48e0f
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rmailkwd.el
@@ -0,0 +1,260 @@
+;; "RMAIL" mail reader for Emacs.
+;; Copyright (C) 1985, 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; Global to all RMAIL buffers.  It exists primarily for the sake of
+;; completion.  It is better to use strings with the label functions
+;; and let them worry about making the label.
+
+(defvar rmail-label-obarray (make-vector 47 0))
+
+;; Named list of symbols representing valid message attributes in RMAIL.
+
+(defconst rmail-attributes
+  (cons 'rmail-keywords
+       (mapcar '(lambda (s) (intern s rmail-label-obarray))
+               '("deleted" "answered" "filed" "forwarded" "unseen" "edited"))))
+
+(defconst rmail-deleted-label (intern "deleted" rmail-label-obarray))
+
+;; Named list of symbols representing valid message keywords in RMAIL.
+
+(defvar rmail-keywords nil)
+\f
+(defun rmail-add-label (string)
+  "Add LABEL to labels associated with current RMAIL message.
+Completion is performed over known labels when reading."
+  (interactive (list (rmail-read-label "Add label")))
+  (rmail-set-label string t))
+
+(defun rmail-kill-label (string)
+  "Remove LABEL from labels associated with current RMAIL message.
+Completion is performed over known labels when reading."
+  (interactive (list (rmail-read-label "Remove label")))
+  (rmail-set-label string nil))
+
+(defun rmail-read-label (prompt)
+  (if (not rmail-keywords) (rmail-parse-file-keywords))
+  (let ((result
+        (completing-read (concat prompt
+                                 (if rmail-last-label
+                                     (concat " (default "
+                                             (symbol-name rmail-last-label)
+                                             "): ")
+                                   ": "))
+                         rmail-label-obarray
+                         nil
+                         nil)))
+    (if (string= result "")
+       rmail-last-label
+      (setq rmail-last-label (rmail-make-label result t)))))
+
+(defun rmail-set-label (l state &optional n)
+  (rmail-maybe-set-message-counters)
+  (if (not n) (setq n rmail-current-message))
+  (aset rmail-summary-vector (1- n) nil)
+  (let* ((attribute (rmail-attribute-p l))
+        (keyword (and (not attribute)
+                      (or (rmail-keyword-p l)
+                          (rmail-install-keyword l))))
+        (label (or attribute keyword)))
+    (if label
+       (let ((omax (- (buffer-size) (point-max)))
+             (omin (- (buffer-size) (point-min)))
+             (buffer-read-only nil)
+             (case-fold-search t))
+         (unwind-protect
+             (save-excursion
+               (widen)
+               (goto-char (rmail-msgbeg n))
+               (forward-line 1)
+               (if (not (looking-at "[01],"))
+                   nil
+                 (let ((start (1+ (point)))
+                       (bound))
+                   (narrow-to-region (point) (progn (end-of-line) (point)))
+                   (setq bound (point-max))
+                   (search-backward ",," nil t)
+                   (if attribute
+                       (setq bound (1+ (point)))
+                     (setq start (1+ (point))))
+                   (goto-char start)
+;                  (while (re-search-forward "[ \t]*,[ \t]*" nil t)
+;                    (replace-match ","))
+;                  (goto-char start)
+                   (if (re-search-forward
+                          (concat ", " (rmail-quote-label-name label) ",")
+                          bound
+                          'move)
+                       (if (not state) (replace-match ","))
+                     (if state (insert " " (symbol-name label) ",")))
+                   (if (eq label rmail-deleted-label)
+                       (rmail-set-message-deleted-p n state)))))
+           (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))
+           (if (= n rmail-current-message) (rmail-display-labels)))))))
+\f
+;; Commented functions aren't used by RMAIL but might be nice for user
+;; packages that do stuff with RMAIL.  Note that rmail-message-labels-p
+;; is in rmailsum now.
+
+;(defun rmail-message-attribute-p (attribute &optional n)
+;  "Returns t if ATTRIBUTE on NTH or current message."
+;  (rmail-message-labels-p (rmail-make-label attribute t) n))
+
+;(defun rmail-message-keyword-p (keyword &optional n)
+;  "Returns t if KEYWORD on NTH or current message."
+;  (rmail-message-labels-p (rmail-make-label keyword t) n t))
+
+;(defun rmail-message-label-p (label &optional n)
+;  "Returns symbol if LABEL (attribute or keyword) on NTH or current message."
+;  (rmail-message-labels-p (rmail-make-label label t) n 'all))
+
+;; Not used by RMAIL but might be nice for user package.
+
+;(defun rmail-parse-message-labels (&optional n)
+;  "Returns labels associated with NTH or current RMAIL message.
+;Results is a list of two lists.  The first is the message attributes
+;and the second is the message keywords.  Labels are represented as symbols."
+;  (let ((omin (- (buffer-size) (point-min)))
+;      (omax (- (buffer-size) (point-max)))
+;      (result))       
+;    (unwind-protect
+;      (save-excursion
+;        (let ((beg (rmail-msgbeg (or n rmail-current-message))))
+;          (widen)
+;          (goto-char beg)
+;          (forward-line 1)
+;          (if (looking-at "[01],")
+;              (save-restriction
+;                (narrow-to-region (point) (save-excursion (end-of-line) (point)))
+;                (rmail-nuke-whitespace)
+;                (goto-char (1+ (point-min)))
+;                (list (mail-parse-comma-list) (mail-parse-comma-list))))))
+;      (narrow-to-region (- (buffer-size) omin)
+;                       (- (buffer-size) omax))
+;      nil)))
+
+(defun rmail-attribute-p (s)
+  (let ((symbol (rmail-make-label s)))
+    (if (memq symbol (cdr rmail-attributes)) symbol)))
+
+(defun rmail-keyword-p (s)
+  (let ((symbol (rmail-make-label s)))
+    (if (memq symbol (cdr (rmail-keywords))) symbol)))
+
+(defun rmail-make-label (s &optional forcep)
+  (cond ((symbolp s) s)
+       (forcep (intern (downcase s) rmail-label-obarray))
+       (t  (intern-soft (downcase s) rmail-label-obarray))))
+
+(defun rmail-force-make-label (s)
+  (intern (downcase s) rmail-label-obarray))
+
+(defun rmail-quote-label-name (label)
+  (regexp-quote (symbol-name (rmail-make-label label t))))
+\f
+;; Motion on messages with keywords.
+
+(defun rmail-previous-labeled-message (n label)
+  "Show previous message with LABEL.  Defaults to last labels used.
+With prefix argument N moves backward N messages with these labels."
+  (interactive "p\nsMove to previous msg with labels: ")
+  (rmail-next-labeled-message (- n) label))
+
+(defun rmail-next-labeled-message (n labels)
+  "Show next message with LABEL.  Defaults to last labels used.
+With prefix argument N moves forward N messages with these labels."
+  (interactive "p\nsMove to next msg with labels: ")
+  (if (string= labels "")
+      (setq labels rmail-last-multi-labels))
+  (or labels
+      (error "No labels to find have been specified previously"))
+  (setq rmail-last-multi-labels labels)
+  (rmail-maybe-set-message-counters)
+  (let ((lastwin rmail-current-message)
+       (current rmail-current-message)
+       (regexp (concat ", ?\\("
+                       (mail-comma-list-regexp labels)
+                       "\\),")))
+    (save-restriction
+      (widen)
+      (while (and (> n 0) (< current rmail-total-messages))
+       (setq current (1+ current))
+       (if (rmail-message-labels-p current regexp)
+           (setq lastwin current n (1- n))))
+      (while (and (< n 0) (> current 1))
+       (setq current (1- current))
+       (if (rmail-message-labels-p current regexp)
+           (setq lastwin current n (1+ n)))))
+    (rmail-show-message lastwin)
+    (if (< n 0)
+       (message "No previous message with labels %s" labels))
+    (if (> n 0)
+       (message "No following message with labels %s" labels))))
+\f
+;;; Manipulate the file's Labels option.
+
+;; Return a list of symbols for all
+;; the keywords (labels) recorded in this file's Labels option.
+(defun rmail-keywords ()
+  (or rmail-keywords (rmail-parse-file-keywords)))
+
+;; Set rmail-keywords to a list of symbols for all
+;; the keywords (labels) recorded in this file's Labels option.
+(defun rmail-parse-file-keywords ()
+  (save-restriction
+    (save-excursion
+      (widen)
+      (goto-char 1)
+      (setq rmail-keywords
+           (if (search-forward "\nLabels:" (rmail-msgbeg 1) t)
+               (progn
+                 (narrow-to-region (point) (progn (end-of-line) (point)))
+                 (goto-char (point-min))
+                 (cons 'rmail-keywords
+                       (mapcar 'rmail-force-make-label
+                               (mail-parse-comma-list)))))))))
+
+;; Add WORD to the list in the file's Labels option.
+;; Any keyword used for the first time needs this done.
+(defun rmail-install-keyword (word)
+  (let ((keyword (rmail-make-label word t))
+       (keywords (rmail-keywords)))
+    (if (not (or (rmail-attribute-p keyword)
+                (rmail-keyword-p keyword)))
+       (let ((omin (- (buffer-size) (point-min)))
+             (omax (- (buffer-size) (point-max))))
+         (unwind-protect
+             (save-excursion
+               (widen)
+               (goto-char 1)
+               (let ((case-fold-search t)
+                     (buffer-read-only nil))
+                 (or (search-forward "\nLabels:" nil t)
+                     (progn
+                       (end-of-line)
+                       (insert "\nLabels:")))
+                 (delete-region (point) (progn (end-of-line) (point)))
+                 (setcdr keywords (cons keyword (cdr keywords)))
+                 (while (setq keywords (cdr keywords))
+                   (insert (symbol-name (car keywords)) ","))
+                 (delete-char -1)))
+           (narrow-to-region (- (buffer-size) omin)
+                             (- (buffer-size) omax)))))
+    keyword))
diff --git a/usr/src/contrib/emacs-18.57/lisp/rmailmsc.el b/usr/src/contrib/emacs-18.57/lisp/rmailmsc.el

new file mode 100644 (file)

index 0000000..833077c
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rmailmsc.el
@@ -0,0 +1,45 @@
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun set-rmail-inbox-list (file-name)
+  "Set the inbox list of the current RMAIL file to FILE-NAME.  This may be
+a list of file names separated by commas.  If FILE-NAME is empty, remove
+any 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 "Mail: " file-name "\n"))))))
+  (setq rmail-inbox-list (rmail-parse-file-inboxes))
+  (rmail-show-message rmail-current-message))
diff --git a/usr/src/contrib/emacs-18.57/lisp/rmailout.el b/usr/src/contrib/emacs-18.57/lisp/rmailout.el

new file mode 100644 (file)

index 0000000..3d587b8
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rmailout.el
@@ -0,0 +1,125 @@
+;; "RMAIL" mail reader for Emacs: output message to a file.
+;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; Temporary until Emacs always has this variable.
+(defvar rmail-delete-after-output nil
+  "*Non-nil means automatically delete a message that is copied to a file.")
+
+(defun rmail-output-to-rmail-file (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 (list (read-file-name
+                     (concat "Output message to Rmail file: (default "
+                             (file-name-nondirectory rmail-last-rmail-file)
+                             ") ")
+                     (file-name-directory rmail-last-rmail-file)
+                     rmail-last-rmail-file)))
+  (setq file-name (expand-file-name file-name))
+  (setq rmail-last-rmail-file file-name)
+  (rmail-maybe-set-message-counters)
+  (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")))
+  (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)
+           (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 (rmail-maybe-set-message-counters)
+                      (widen)
+                      (narrow-to-region (point-max) (point-max))))
+           (insert-buffer-substring cur beg end)
+           (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))))))))
+  (rmail-set-attribute "filed" t)
+  (and rmail-delete-after-output (rmail-delete-forward)))
+
+(defun rmail-output (file-name)
+  "Append this message to Unix mail file named FILE-NAME."
+  (interactive
+   (list
+    (read-file-name
+     (concat "Output message to Unix mail file"
+            (if rmail-last-file
+                (concat " (default "
+                        (file-name-nondirectory rmail-last-file)
+                        "): " )
+              ": "))                   
+     (and rmail-last-file (file-name-directory rmail-last-file))
+     rmail-last-file)))
+  (setq file-name (expand-file-name file-name))
+  (setq rmail-last-file file-name)
+  (let ((rmailbuf (current-buffer))
+       (tembuf (get-buffer-create " rmail-output"))
+       (case-fold-search t))
+    (save-excursion
+      (set-buffer tembuf)
+      (erase-buffer)
+      (insert-buffer-substring rmailbuf)
+      (insert "\n")
+      (goto-char (point-min))
+      (insert "From "
+             (or (mail-strip-quoted-names (mail-fetch-field "from"))
+                 "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.)
+      (while (search-forward "\nFrom " nil t)
+       (forward-char -5)
+       (insert ?>))
+      (append-to-file (point-min) (point-max) file-name))
+    (kill-buffer tembuf))
+  (if (equal major-mode 'rmail-mode)
+      (progn
+       (rmail-set-attribute "filed" t)
+       (and rmail-delete-after-output (rmail-delete-forward)))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/rmailsum.el b/usr/src/contrib/emacs-18.57/lisp/rmailsum.el

new file mode 100644 (file)

index 0000000..aa32363
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rmailsum.el
@@ -0,0 +1,433 @@
+;; "RMAIL" mail reader for Emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; summary things
+
+(defun rmail-summary ()
+  "Display a summary of all messages, one line per message."
+  (interactive)
+  (rmail-new-summary "All" nil))
+
+(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)
+                    'rmail-message-labels-p
+                    (concat ", \\(" (mail-comma-list-regexp labels) "\\),")))
+
+(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 names separated by commas."
+  (interactive "sRecipients to summarize by: \nP")
+  (rmail-new-summary
+   (concat "recipients " recipients)
+   'rmail-message-recipients-p
+   (mail-comma-list-regexp recipients) primary-only))
+
+(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-new-summary (description 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...")
+  (or (and rmail-summary-buffer
+          (buffer-name rmail-summary-buffer))
+      (setq rmail-summary-buffer
+           (generate-new-buffer (concat (buffer-name) "-summary"))))
+  (let ((summary-msgs ())
+       (new-summary-line-count 0))
+    (let ((msgnum 1)
+         (buffer-read-only nil))
+      (save-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 (rmail-make-summary-line msgnum)
+                           summary-msgs)))
+           (setq msgnum (1+ msgnum))))))
+    (let ((sbuf rmail-summary-buffer)
+         (rbuf (current-buffer))
+         (total rmail-total-messages)
+         (mesg rmail-current-message))
+      (pop-to-buffer sbuf)
+      (let ((buffer-read-only nil))
+       (erase-buffer)
+       (cond (summary-msgs
+              (princ (nreverse summary-msgs) sbuf)
+              (delete-char -1)
+              (subst-char-in-region 1 2 ?\( ?\ ))))
+      (setq buffer-read-only t)
+      (goto-char (point-min))
+      (rmail-summary-mode)
+      (make-local-variable 'minor-mode-alist)
+      (setq minor-mode-alist (list ": " description))
+      (setq rmail-buffer rbuf
+           rmail-total-messages total)
+      (rmail-summary-goto-msg mesg t)))
+  (message "Computing summary lines...done"))
+
+(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))))
+                   (t "??????"))))
+         "  "
+         (save-excursion
+           (if (not (re-search-forward "^From:[ \t]*" nil t))
+               "                         "
+             (let* ((from (mail-strip-quoted-names
+                           (buffer-substring
+                            (1- (point))
+                            (progn (end-of-line)
+                                   (skip-chars-backward " \t")
+                                   (point)))))
+                    len mch lo)
+               (if (string-match (concat "^"
+                                         (regexp-quote (user-login-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 9) 0) 0)
+                                                   ((< len (+ mch 16))
+                                                    (- len 25))
+                                                   (t (- mch 9))))
+                                    (min len (+ lo 25))))))))
+         "  #"
+         (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"))
+
+(defun rmail-summary-next-all (&optional number)
+  (interactive "p")
+  (forward-line (if number number 1))
+  (rmail-summary-goto-msg))
+
+(defun rmail-summary-previous-all (&optional number)
+  (interactive "p")
+  (forward-line (- (if number number 1)))
+  (rmail-summary-goto-msg))
+
+(defun rmail-summary-next-msg (&optional number)
+  (interactive "p")
+  (forward-line 0)
+  (and (> number 0) (forward-line 1))
+  (let ((count (if (< number 0) (- number) number))
+       (search (if (> number 0) 're-search-forward 're-search-backward))
+       end)
+    (while (and (> count 0) (funcall search "^.....[^D]" nil t))
+      (setq count (1- count)))
+    (rmail-summary-goto-msg)))
+
+(defun rmail-summary-previous-msg (&optional number)
+  (interactive "p")
+  (rmail-summary-next-msg (- (if number number 1))))
+
+(defun rmail-summary-delete-forward ()
+  (interactive)
+  (let (end)
+    (rmail-summary-goto-msg)
+    (pop-to-buffer rmail-buffer)
+    (rmail-delete-message)
+    (pop-to-buffer rmail-summary-buffer)
+    (let ((buffer-read-only nil))
+      (skip-chars-forward " ")
+      (skip-chars-forward "[0-9]")
+      (delete-char 1)
+      (insert "D"))
+    (rmail-summary-next-msg 1)))
+
+(defun rmail-summary-undelete ()
+  (interactive)
+  (let ((buffer-read-only nil))
+    (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
+          (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 ()
+  "Major mode in effect in Rmail summary buffer.
+A subset of the Rmail mode commands are supported in this mode. 
+As commands are issued in the summary buffer the corresponding
+mail message is displayed in the rmail buffer.
+
+n       Move to next undeleted message, or arg messages.
+p       Move to previous undeleted message, or arg messages.
+C-n    Move to next, or forward arg messages.
+C-p    Move to previous, or previous arg messages.
+j       Jump to the message at the cursor location.
+d       Delete the message at the cursor location and move to next message.
+u      Undelete this or previous deleted message.
+q      Quit Rmail.
+x      Exit and kill the summary window.
+space   Scroll message in other window forward.
+delete  Scroll message backward.
+
+Entering this mode calls value of hook variable rmail-summary-mode-hook."
+  (interactive)
+  (kill-all-local-variables)
+  (make-local-variable 'rmail-buffer)
+  (make-local-variable 'rmail-total-messages)
+  (setq major-mode 'rmail-summary-mode)
+  (setq mode-name "RMAIL Summary")
+  (use-local-map rmail-summary-mode-map)
+  (setq truncate-lines t)
+  (setq buffer-read-only t)
+  (set-syntax-table text-mode-syntax-table)
+  (run-hooks 'rmail-summary-mode-hook))
+
+(defun rmail-summary-goto-msg (&optional n nowarn)
+  (interactive "P")
+  (if (consp n) (setq n (prefix-numeric-value n)))
+  (if (eobp) (forward-line -1))
+  (beginning-of-line)
+  (let ((buf rmail-buffer)
+       (cur (point))
+       (curmsg (string-to-int
+                (buffer-substring (point)
+                                  (min (point-max) (+ 5 (point)))))))
+    (if (not n)
+       (setq n curmsg)
+      (if (< n 1)
+         (progn (message "No preceding message")
+                (setq n 1)))
+      (if (> n rmail-total-messages)
+         (progn (message "No following message")
+                (goto-char (point-max))
+                (rmail-summary-goto-msg)))
+      (goto-char (point-min))
+      (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t))
+         (progn (or nowarn (message "Message %d not found" n))
+                (setq n curmsg)
+                (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 " "))))
+    (beginning-of-line)
+    (pop-to-buffer buf)
+    (rmail-show-message n)
+    (pop-to-buffer rmail-summary-buffer)))
+
+(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 "j" 'rmail-summary-goto-msg)
+  (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
+  (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
+  (define-key rmail-summary-mode-map "\C-n" 'rmail-summary-next-all)
+  (define-key rmail-summary-mode-map "\C-p" 'rmail-summary-previous-all)
+  (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
+  (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
+  (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
+  (define-key rmail-summary-mode-map "x" 'rmail-summary-exit)
+  (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
+  (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward))
+
+(defun rmail-summary-scroll-msg-up (&optional dist)
+  "Scroll other window forward."
+  (interactive "P")
+  (let ((window (selected-window))
+       (new-window (display-buffer rmail-buffer)))
+    (unwind-protect
+       (progn
+         (select-window new-window)
+         (scroll-up dist))
+      (select-window window))))
+
+(defun rmail-summary-scroll-msg-down (&optional dist)
+  "Scroll other window backward."
+  (interactive "P")
+  (let ((window (selected-window))
+       (new-window (display-buffer rmail-buffer)))
+    (unwind-protect
+       (progn
+         (select-window new-window)
+         (scroll-down dist))
+      (select-window window))))
+
+(defun rmail-summary-quit ()
+  "Quit out of rmail and rmail summary."
+  (interactive)
+  (rmail-summary-exit)
+  (rmail-quit))
+
+(defun rmail-summary-exit ()
+  "Exit rmail summary, remaining within rmail."
+  (interactive)
+  (bury-buffer (current-buffer))
+  (if (get-buffer-window rmail-buffer)
+      ;; Select the window with rmail in it, then delete this window.
+      (select-window (prog1
+                        (get-buffer-window rmail-buffer)
+                      (delete-window (selected-window))))
+    ;; Switch to the rmail buffer in this window.
+    (switch-to-buffer rmail-buffer)))
diff --git a/usr/src/contrib/emacs-18.57/lisp/rnews.el b/usr/src/contrib/emacs-18.57/lisp/rnews.el

new file mode 100644 (file)

index 0000000..5dfe403
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rnews.el
@@ -0,0 +1,968 @@
+;;; USENET news reader for gnu emacs
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; 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, cleanuped 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 (provide 'rnews)      tower@prep 22 Apr 87
+(provide 'rnews)
+(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 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)
+  (if (boundp 'minor-mode-alist)
+      ;; Emacs versions 18.16 and up.
+      (setq mode-name '("NEWS" news-minor-modes))
+    ;; Earlier versions display minor-modes via a special mechanism.
+    (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 not subscribed to in file %s." news-startup-file)
+      (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 (file-exists-p file)
+       (let ((buffer-read-only ()))
+         (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)
+         (news-read-in-file file)
+         (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)
+  (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)))
+      (switch-to-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)))
+                        ;; dont 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 facist)
+; @@ 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))
+       ((< n 0) (setq n (- 26 (% (- n) 26))))
+       (t (setq n (% 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))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/rnewspost.el b/usr/src/contrib/emacs-18.57/lisp/rnewspost.el

new file mode 100644 (file)

index 0000000..83fc114
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/rnewspost.el
@@ -0,0 +1,385 @@
+;;; USENET news poster/mailer for GNU Emacs
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; 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
+(require 'sendmail)
+(require 'rnews)
+
+;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 dosen't have to autoload these functions.
+;;
+;;; >> Nuked by Mly to autoload those functions again, as the duplication of
+;;; >>  code was making maintenance too difficult.
+
+(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?" 'describe-mode)
+      (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-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)))
+
+(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")
+  (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 '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 rmail).
+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)
+  (insert "In article " news-reply-yank-message-id
+         " " news-reply-yank-from " writes:\n\n"))
+
+(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
+newsgroups names at your site:
+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, that are also in the Newsgroups: field:
+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 "~/.signature will be appended automatically."))
+
+(defun news-setup (to subject in-reply-to newsgroups replybuffer)
+  "Setup the news reply or posting buffer with the proper headers and in
+news-reply-mode."
+  (setq mail-reply-buffer replybuffer)
+  (let ((mail-setup-hook nil))
+    (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)
+         (beginning-of-line)
+         (kill-line 1)
+         (goto-char (point-max)))
+      (mail-setup to subject in-reply-to nil replybuffer))
+    ;;;(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
+            (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"))
+      (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 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 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
+(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)))
diff --git a/usr/src/contrib/emacs-18.57/lisp/scheme.el b/usr/src/contrib/emacs-18.57/lisp/scheme.el

new file mode 100644 (file)

index 0000000..733696e
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/scheme.el
@@ -0,0 +1,499 @@
+;; Scheme mode, and its idiosyncratic commands.
+;; Copyright (C) 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
+;; Adapted from Lisp mode by Bill Rozas, jinx@prep.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can 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.
+
+
+;; 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.
+
+;;; $Header: scheme.el,v 1.7 88/07/15 20:20:00 GMT cph Exp $
+
+(provide 'scheme)
+\f
+(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 ?\| "    ")
+
+      ;; Other atom delimiters
+      (modify-syntax-entry ?\( "()  ")
+      (modify-syntax-entry ?\) ")(  ")
+      (modify-syntax-entry ?\; "<   ")
+      (modify-syntax-entry ?\" "\"    ")
+      (modify-syntax-entry ?' "'   ")
+      (modify-syntax-entry ?` "'   ")
+
+      ;; Special characters
+      (modify-syntax-entry ?, "'   ")
+      (modify-syntax-entry ?@ "'   ")
+      (modify-syntax-entry ?# "'   ")
+      (modify-syntax-entry ?\\ "\\   ")))
+\f
+(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 'comment-start)
+  (setq comment-start ";")
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip ";+[ \t]*")
+  (make-local-variable 'comment-column)
+  (setq comment-column 40)
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'scheme-comment-indent)
+  (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)))
+\f
+(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.")
+\f
+(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-hook 'scheme-indent-hook "")
+
+(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)))))
+\f
+(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 overriden 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-hook)
+                          scheme-indent-hook
+                          (not retry)
+                          (setq desired-indent
+                                (funcall scheme-indent-hook
+                                         indent-point state)))))
+            ;; Use default indentation if not computed yet
+            (setq desired-indent (current-column))))
+      desired-indent)))
+\f
+(defun scheme-indent-hook (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-hook))
+           (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 "")
+\f
+(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-hook 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)))))
+\f
+;;; 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-hook 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-hook 0)
+(put 'case 'scheme-indent-hook 1)
+(put 'delay 'scheme-indent-hook 0)
+(put 'do 'scheme-indent-hook 2)
+(put 'lambda 'scheme-indent-hook 1)
+(put 'let 'scheme-indent-hook 'scheme-let-indent)
+(put 'let* 'scheme-indent-hook 1)
+(put 'letrec 'scheme-indent-hook 1)
+(put 'sequence 'scheme-indent-hook 0)
+
+(put 'call-with-input-file 'scheme-indent-hook 1)
+(put 'with-input-from-file 'scheme-indent-hook 1)
+(put 'with-input-from-port 'scheme-indent-hook 1)
+(put 'call-with-output-file 'scheme-indent-hook 1)
+(put 'with-output-to-file 'scheme-indent-hook 1)
+(put 'with-output-to-port 'scheme-indent-hook 1)
+\f
+;;;; MIT Scheme specific indentation.
+
+(if scheme-mit-dialect
+    (progn
+      (put 'fluid-let 'scheme-indent-hook 1)
+      (put 'in-package 'scheme-indent-hook 1)
+      (put 'let-syntax 'scheme-indent-hook 1)
+      (put 'local-declare 'scheme-indent-hook 1)
+      (put 'macro 'scheme-indent-hook 1)
+      (put 'make-environment 'scheme-indent-hook 0)
+      (put 'named-lambda 'scheme-indent-hook 1)
+      (put 'using-syntax 'scheme-indent-hook 1)
+
+      (put 'with-input-from-string 'scheme-indent-hook 1)
+      (put 'with-output-to-string 'scheme-indent-hook 0)
+      (put 'with-values 'scheme-indent-hook 1)
+
+      (put 'syntax-table-define 'scheme-indent-hook 2)
+      (put 'list-transform-positive 'scheme-indent-hook 1)
+      (put 'list-transform-negative 'scheme-indent-hook 1)
+      (put 'list-search-positive 'scheme-indent-hook 1)
+      (put 'list-search-negative 'scheme-indent-hook 1)
+
+      (put 'access-components 'scheme-indent-hook 1)
+      (put 'assignment-components 'scheme-indent-hook 1)
+      (put 'combination-components 'scheme-indent-hook 1)
+      (put 'comment-components 'scheme-indent-hook 1)
+      (put 'conditional-components 'scheme-indent-hook 1)
+      (put 'disjunction-components 'scheme-indent-hook 1)
+      (put 'declaration-components 'scheme-indent-hook 1)
+      (put 'definition-components 'scheme-indent-hook 1)
+      (put 'delay-components 'scheme-indent-hook 1)
+      (put 'in-package-components 'scheme-indent-hook 1)
+      (put 'lambda-components 'scheme-indent-hook 1)
+      (put 'lambda-components* 'scheme-indent-hook 1)
+      (put 'lambda-components** 'scheme-indent-hook 1)
+      (put 'open-block-components 'scheme-indent-hook 1)
+      (put 'pathname-components 'scheme-indent-hook 1)
+      (put 'procedure-components 'scheme-indent-hook 1)
+      (put 'sequence-components 'scheme-indent-hook 1)
+      (put 'unassigned\?-components 'scheme-indent-hook 1)
+      (put 'unbound\?-components 'scheme-indent-hook 1)
+      (put 'variable-components 'scheme-indent-hook 1)))
+\f
+(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))
+                 (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)))))))))
diff --git a/usr/src/contrib/emacs-18.57/lisp/scribe.el b/usr/src/contrib/emacs-18.57/lisp/scribe.el

new file mode 100644 (file)

index 0000000..257c93e
--- /dev/null
+++ b/usr/src/contrib/emacs-18.57/lisp/scribe.el
@@ -0,0 +1,307 @@
+;; scribe mode, and its ideosyncratic commands.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar 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 "\^cc" 'scribe-chapter)
+  (define-key scribe-mode-map "\^cS" 'scribe-section)
+  (define-key scribe-mode-map "\^cs" 'scribe-subsection)
+  (define-key scribe-mode-map "\^ce" 'scribe-insert-environment)
+  (define-key scribe-mode-map "\^c\^e" 'scribe-bracket-region-be)
+  (define-key scribe-mode-map "\^c[" 'scribe-begin)
+  (define-key scribe-mode-map "\^c]" 'scribe-end)
+  (define-key scribe-mode-map "\^ci" 'scribe-italicize-word)
+  (define-key scribe-mode-map "\^cb" 'scribe-bold-word)
+  (define-key scribe-mode-map "\^cu" 'scribe-underline-word))
+
+(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 '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)
+  "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)))))))
author	CSRG <csrg@ucbvax.Berkeley.EDU>
	Wed, 9 Jan 1991 07:03:53 +0000 (23:03 -0800)
committer	CSRG <csrg@ucbvax.Berkeley.EDU>
	Wed, 9 Jan 1991 07:03:53 +0000 (23:03 -0800)
usr/src/contrib/emacs-18.57/lisp/gdb.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/gosmacs.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/grow-vers.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/help.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/helper.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/icon.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/inc-vers.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/indent.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/info.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/informat.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/isearch.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/kermit.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/keypad.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/ledit.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/life.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/lisp-mode.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/lisp.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/loaddefs.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/loadup.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/lpr.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/macros.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/mail-utils.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/mailalias.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/makesum.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/man.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/medit.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/mh-e.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/mim-mode.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/mim-syntax.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/mlconvert.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/mlsupport.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/novice.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/nroff-mode.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/options.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/outline.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/page.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/paragraphs.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/paths.el-dist	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/picture.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/prolog.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rect.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/register.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/replace.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rfc822.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rmail.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rmailedit.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rmailkwd.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rmailmsc.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rmailout.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rmailsum.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rnews.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/rnewspost.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/scheme.el	[new file with mode: 0644]	patch \| blob
usr/src/contrib/emacs-18.57/lisp/scribe.el	[new file with mode: 0644]	patch \| blob