Initial revision

4 files changed, 1961 insertions, 0 deletions

diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
new file mode 100644
index 00000000000..a2f4d0e7d88
--- /dev/null
+++ b/lisp/cmuscheme.el
@@ -0,0 +1,430 @@
+;;; cmuscheme.el -- Scheme process in a buffer. Adapted from tea.el.
+;;; Copyright Olin Shivers (1988)
+;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
+;;; notice appearing here to the effect that you may use this code any
+;;; way you like, as long as you don't charge money for it, remove this
+;;; notice, or hold me liable for its results.
+;;;
+;;;    This is a customisation of comint-mode (see comint.el)
+;;;
+;;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
+;;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
+;;; 8/88
+;;;
+;;; Please send me bug reports, bug fixes, and extensions, so that I can
+;;; merge them into the master source.
+;;;
+;;; The changelog is at the end of this file.
+;;;
+;;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user
+;;; interface that communicates process state back to the superior emacs by
+;;; outputting special control sequences. The gnumacs package, xscheme.el, has
+;;; lots and lots of special purpose code to read these control sequences, and
+;;; so is very tightly integrated with the cscheme process. The cscheme
+;;; interrupt handler and debugger read single character commands in cbreak
+;;; mode; when this happens, xscheme.el switches to special keymaps that bind
+;;; the single letter command keys to emacs functions that directly send the
+;;; character to the scheme process.  Cmuscheme mode does *not* provide this
+;;; functionality. If you are a cscheme user, you may prefer to use the
+;;; xscheme.el/cscheme -emacs interaction.
+;;; 
+;;; Here's a summary of the pros and cons, as I see them.
+;;; xscheme: Tightly integrated with inferior cscheme process!  A few commands
+;;;	     not in cmuscheme. But. Integration is a bit of a hack.  Input
+;;;	     history only keeps the immediately prior input. Bizarre
+;;;	     keybindings.
+;;; 
+;;; cmuscheme: Not tightly integrated with inferior cscheme process.  But.
+;;;            Carefully integrated functionality with the entire suite of
+;;;            comint-derived CMU process modes. Keybindings reminiscent of
+;;;            Zwei and Hemlock. Good input history. A few commands not in
+;;;            xscheme.
+;;;  
+;;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
+;;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
+;;; Cscheme-specific; you must use cmuscheme.el.  Interested parties are
+;;; invited to port xscheme functionality on top of comint mode...
+
+;; YOUR .EMACS FILE
+;;=============================================================================
+;; Some suggestions for your .emacs file.
+;;
+;; ; If cmuscheme lives in some non-standard directory, you must tell emacs
+;; ; where to get it. This may or may not be necessary.
+;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
+;;
+;; ; Autoload run-scheme from file cmuscheme.el
+;; (autoload 'run-scheme "cmuscheme"
+;;           "Run an inferior Scheme process."
+;;           t)
+;;
+;; ; Files ending in ".scm" are Scheme source, 
+;; ; so put their buffers in scheme-mode.
+;; (setq auto-mode-alist 
+;;       (cons '("\\.scm$" . scheme-mode)  
+;;             auto-mode-alist))
+;;
+;; ; Define C-c t to run my favorite command in inferior scheme mode:
+;; (setq cmuscheme-load-hook
+;;       '((lambda () (define-key inferior-scheme-mode-map "\C-ct"
+;;                                'favorite-cmd))))
+;;;
+;;; Unfortunately, scheme.el defines run-scheme to autoload from xscheme.el.
+;;; This will womp your declaration to autoload run-scheme from cmuscheme.el
+;;; if you haven't loaded cmuscheme in before scheme. Three fixes:
+;;; - Put the autoload on your scheme mode hook and in your .emacs toplevel:
+;;;   (setq scheme-mode-hook
+;;;         '((lambda () (autoload 'run-scheme "cmuscheme"
+;;;                                "Run an inferior Scheme" t))))
+;;;   (autoload 'run-scheme "cmuscheme" "Run an inferior Scheme" t)
+;;;   Now when scheme.el autoloads, it will restore the run-scheme autoload.
+;;; - Load cmuscheme.el in your .emacs: (load-library 'cmuscheme)
+;;; - Change autoload declaration in scheme.el to point to cmuscheme.el:
+;;;   (autoload 'run-scheme "cmuscheme" "Run an inferior Scheme" t)
+;;;   *or* just delete the autoload declaration from scheme.el altogether,
+;;;   which will allow the autoload in your .emacs to have its say.
+
+(provide 'cmuscheme)
+(require 'scheme)
+(require 'comint)
+
+;;; INFERIOR SCHEME MODE STUFF
+;;;============================================================================
+
+(defvar inferior-scheme-mode-hook nil
+  "*Hook for customising inferior-scheme mode.")
+(defvar inferior-scheme-mode-map nil)
+
+(cond ((not inferior-scheme-mode-map)
+       (setq inferior-scheme-mode-map
+	     (full-copy-sparse-keymap comint-mode-map))
+       (define-key inferior-scheme-mode-map "\M-\C-x" ;gnu convention
+	           'scheme-send-definition)
+       (define-key inferior-scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp)
+       (define-key inferior-scheme-mode-map "\C-c\C-l" 'scheme-load-file)
+       (define-key inferior-scheme-mode-map "\C-c\C-k" 'scheme-compile-file)
+       (scheme-mode-commands inferior-scheme-mode-map))) 
+
+;; Install the process communication commands in the scheme-mode keymap.
+(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention
+(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention
+(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition)
+(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region)
+(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
+(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
+(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
+(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
+(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
+
+(defun inferior-scheme-mode ()
+  "Major mode for interacting with an inferior Scheme process.
+
+The following commands are available:
+\\{inferior-scheme-mode-map}
+
+A Scheme process can be fired up with M-x run-scheme.
+
+Customisation: Entry to this mode runs the hooks on comint-mode-hook and
+inferior-scheme-mode-hook (in that order).
+
+You can send text to the inferior Scheme process from other buffers containing
+Scheme source.  
+    switch-to-scheme switches the current buffer to the Scheme process buffer.
+    scheme-send-definition sends the current definition to the Scheme process.
+    scheme-compile-definition compiles the current definition.
+    scheme-send-region sends the current region to the Scheme process.
+    scheme-compile-region compiles the current region.
+
+    scheme-send-definition-and-go, scheme-compile-definition-and-go,
+        scheme-send-region-and-go, and scheme-compile-region-and-go
+        switch to the Scheme process buffer after sending their text.
+For information on running multiple processes in multiple buffers, see
+documentation for variable scheme-buffer.
+
+Commands:
+Return after the end of the process' output sends the text from the 
+    end of process to point.
+Return before the end of the process' output copies the sexp ending at point
+    to the end of the process' output, and sends it.
+Delete converts tabs to spaces as it moves back.
+Tab indents for Scheme; with argument, shifts rest
+    of expression rigidly with the current line.
+C-M-q does Tab on each line starting within following expression.
+Paragraphs are separated only by blank lines.  Semicolons start comments.
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it."
+  (interactive)
+  (comint-mode)
+  ;; Customise in inferior-scheme-mode-hook
+  (setq comint-prompt-regexp "^[^>]*>+ *") ; OK for cscheme, oaklisp, T,...
+  (scheme-mode-variables)
+  (setq major-mode 'inferior-scheme-mode)
+  (setq mode-name "Inferior Scheme")
+  (setq mode-line-process '(": %s"))
+  (use-local-map inferior-scheme-mode-map)
+  (setq comint-input-filter (function scheme-input-filter))
+  (setq comint-input-sentinel (function ignore))
+  (setq comint-get-old-input (function scheme-get-old-input))
+  (run-hooks 'inferior-scheme-mode-hook))
+
+(defun scheme-input-filter (str)
+  "Don't save anything matching inferior-scheme-filter-regexp"
+  (not (string-match inferior-scheme-filter-regexp str)))
+
+(defvar inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
+  "*Input matching this regexp are not saved on the history list.
+Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters.")
+
+(defun scheme-get-old-input ()
+  "Snarf the sexp ending at point"
+  (save-excursion
+    (let ((end (point)))
+      (backward-sexp)
+      (buffer-substring (point) end))))
+
+(defun scheme-args-to-list (string)
+  (let ((where (string-match "[ \t]" string)))
+    (cond ((null where) (list string))
+	  ((not (= where 0))
+	   (cons (substring string 0 where)
+		 (scheme-args-to-list (substring string (+ 1 where)
+						 (length string)))))
+	  (t (let ((pos (string-match "[^ \t]" string)))
+	       (if (null pos)
+		   nil
+		 (scheme-args-to-list (substring string pos
+						 (length string)))))))))
+
+(defvar scheme-program-name "scheme"
+  "*Program invoked by the run-scheme command")
+
+;;; Obsolete
+(defun scheme (&rest foo)
+  "Use run-scheme"
+  (interactive)
+  (message "Use run-scheme")
+  (ding))
+
+(defun run-scheme (cmd)
+  "Run an inferior Scheme process, input and output via buffer *scheme*.
+If there is a process already running in *scheme*, just switch to that buffer.
+With argument, allows you to edit the command line (default is value
+of scheme-program-name).  Runs the hooks from inferior-scheme-mode-hook
+\(after the comint-mode-hook is run).
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+
+  (interactive (list (if current-prefix-arg
+			 (read-string "Run Scheme: " scheme-program-name)
+			 scheme-program-name)))
+  (if (not (comint-check-proc "*scheme*"))
+      (let ((cmdlist (scheme-args-to-list cmd)))
+	(set-buffer (apply 'make-comint "scheme" (car cmdlist)
+			   nil (cdr cmdlist)))
+	(inferior-scheme-mode)))
+  (setq scheme-buffer "*scheme*")
+  (switch-to-buffer "*scheme*"))
+
+
+(defun scheme-send-region (start end)
+  "Send the current region to the inferior Scheme process."
+  (interactive "r")
+  (comint-send-region (scheme-proc) start end)
+  (comint-send-string (scheme-proc) "\n"))
+
+(defun scheme-send-definition ()
+  "Send the current definition to the inferior Scheme process."
+  (interactive)
+  (save-excursion
+   (end-of-defun)
+   (let ((end (point)))
+     (beginning-of-defun)
+     (scheme-send-region (point) end))))
+
+(defun scheme-send-last-sexp ()
+  "Send the previous sexp to the inferior Scheme process."
+  (interactive)
+  (scheme-send-region (save-excursion (backward-sexp) (point)) (point)))
+
+(defvar scheme-compile-exp-command "(compile '%s)"
+  "*Template for issuing commands to compile arbitrary Scheme expressions.")
+
+(defun scheme-compile-region (start end)
+  "Compile the current region in the inferior Scheme process
+\(A BEGIN is wrapped around the region: (BEGIN <region>))"
+  (interactive "r")
+  (comint-send-string (scheme-proc) (format scheme-compile-exp-command
+					    (format "(begin %s)"
+						    (buffer-substring start end))))
+  (comint-send-string (scheme-proc) "\n"))
+
+(defun scheme-compile-definition ()
+  "Compile the current definition in the inferior Scheme process."
+  (interactive)
+  (save-excursion
+   (end-of-defun)
+   (let ((end (point)))
+     (beginning-of-defun)
+     (scheme-compile-region (point) end))))
+
+(defun switch-to-scheme (eob-p)
+  "Switch to the scheme process buffer.
+With argument, positions cursor at end of buffer."
+  (interactive "P")
+  (if (get-buffer scheme-buffer)
+      (pop-to-buffer scheme-buffer)
+      (error "No current process buffer. See variable scheme-buffer."))
+  (cond (eob-p
+	 (push-mark)
+	 (goto-char (point-max)))))
+
+(defun scheme-send-region-and-go (start end)
+  "Send the current region to the inferior Scheme process,
+and switch to the process buffer."
+  (interactive "r")
+  (scheme-send-region start end)
+  (switch-to-scheme t))
+
+(defun scheme-send-definition-and-go ()
+  "Send the current definition to the inferior Scheme, 
+and switch to the process buffer."
+  (interactive)
+  (scheme-send-definition)
+  (switch-to-scheme t))
+
+(defun scheme-compile-definition-and-go ()
+  "Compile the current definition in the inferior Scheme, 
+and switch to the process buffer."
+  (interactive)
+  (scheme-compile-definition)
+  (switch-to-scheme t))
+
+(defun scheme-compile-region-and-go (start end)
+  "Compile the current region in the inferior Scheme, 
+and switch to the process buffer."
+  (interactive "r")
+  (scheme-compile-region start end)
+  (switch-to-scheme t))
+
+(defvar scheme-source-modes '(scheme-mode)
+  "*Used to determine if a buffer contains Scheme source code.
+If it's loaded into a buffer that is in one of these major modes, it's
+considered a scheme source file by scheme-load-file and scheme-compile-file.
+Used by these commands to determine defaults.")
+
+(defvar scheme-prev-l/c-dir/file nil
+  "Caches the (directory . file) pair used in the last scheme-load-file or
+scheme-compile-file command. Used for determining the default in the 
+next one.")
+
+(defun scheme-load-file (file-name)
+  "Load a Scheme file into the inferior Scheme process."
+  (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file
+				  scheme-source-modes t)) ; T because LOAD 
+                                                          ; needs an exact name
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
+				       (file-name-nondirectory file-name)))
+  (comint-send-string (scheme-proc) (concat "(load \""
+					    file-name
+					    "\"\)\n")))
+
+(defun scheme-compile-file (file-name)
+  "Compile a Scheme file in the inferior Scheme process."
+  (interactive (comint-get-source "Compile Scheme file: "
+				  scheme-prev-l/c-dir/file
+				  scheme-source-modes
+				  nil)) ; NIL because COMPILE doesn't
+                                        ; need an exact name.
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
+				       (file-name-nondirectory file-name)))
+  (comint-send-string (scheme-proc) (concat "(compile-file \""
+					    file-name
+					    "\"\)\n")))
+
+
+(defvar scheme-buffer nil "*The current scheme process buffer.
+
+MULTIPLE PROCESS SUPPORT
+===========================================================================
+Cmuscheme.el supports, in a fairly simple fashion, running multiple Scheme
+processes. To run multiple Scheme processes, you start the first up with
+\\[run-scheme]. It will be in a buffer named *scheme*. Rename this buffer
+with \\[rename-buffer]. You may now start up a new process with another
+\\[run-scheme]. It will be in a new buffer, named *scheme*. You can
+switch between the different process buffers with \\[switch-to-buffer].
+
+Commands that send text from source buffers to Scheme processes --
+like scheme-send-definition or scheme-compile-region -- have to choose a
+process to send to, when you have more than one Scheme process around. This
+is determined by the global variable scheme-buffer. Suppose you
+have three inferior Schemes running:
+    Buffer	Process
+    foo		scheme
+    bar		scheme<2>
+    *scheme*    scheme<3>
+If you do a \\[scheme-send-definition-and-go] command on some Scheme source
+code, what process do you send it to?
+
+- If you're in a process buffer (foo, bar, or *scheme*), 
+  you send it to that process.
+- If you're in some other buffer (e.g., a source file), you
+  send it to the process attached to buffer scheme-buffer.
+This process selection is performed by function scheme-proc.
+
+Whenever \\[run-scheme] fires up a new process, it resets scheme-buffer
+to be the new process's buffer. If you only run one process, this will
+do the right thing. If you run multiple processes, you can change
+scheme-buffer to another process buffer with \\[set-variable].
+
+More sophisticated approaches are, of course, possible. If you find youself
+needing to switch back and forth between multiple processes frequently,
+you may wish to consider ilisp.el, a larger, more sophisticated package
+for running inferior Lisp and Scheme processes. The approach taken here is
+for a minimal, simple implementation. Feel free to extend it.")
+
+(defun scheme-proc ()
+  "Returns the current scheme process. See variable scheme-buffer."
+  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-scheme-mode)
+				      (current-buffer)
+				      scheme-buffer))))
+    (or proc
+	(error "No current process. See variable scheme-buffer"))))
+
+
+;;; Do the user's customisation...
+
+(defvar cmuscheme-load-hook nil
+  "This hook is run when cmuscheme is loaded in.
+This is a good place to put keybindings.")
+	
+(run-hooks 'cmuscheme-load-hook)
+
+
+;;; CHANGE LOG
+;;; ===========================================================================
+;;; 8/88 Olin
+;;; Created. 
+;;;
+;;; 2/15/89 Olin
+;;; Removed -emacs flag from process invocation. It's only useful for
+;;; cscheme, and makes cscheme assume it's running under xscheme.el,
+;;; which messes things up royally. A bug.
+;;;
+;;; 5/22/90 Olin
+;;; - Upgraded to use comint-send-string and comint-send-region.
+;;; - run-scheme now offers to let you edit the command line if
+;;;   you invoke it with a prefix-arg. M-x scheme is redundant, and
+;;;   has been removed.
+;;; - Explicit references to process "scheme" have been replaced with
+;;;   (scheme-proc). This allows better handling of multiple process bufs.
+;;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
+;;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist
+;;;   and friends, but interested hackers might find a useful application
+;;;   of this facility.
+;;;
+;;; 3/12/90 Olin
+;;; - scheme-load-file and scheme-compile-file no longer switch-to-scheme.
+;;;   Tale suggested this.
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
new file mode 100644
index 00000000000..51e7d4954cb
--- /dev/null
+++ b/lisp/dabbrev.el
@@ -0,0 +1,258 @@
+;; Dynamic abbreviation package for GNU 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.
+
+
+; DABBREVS - "Dynamic abbreviations" hack, originally written by Don Morrison
+; for Twenex Emacs.  Converted to mlisp by Russ Fish.  Supports the table
+; feature to avoid hitting the same expansion on re-expand, and the search
+; size limit variable.  Bugs fixed from the Twenex version are flagged by
+; comments starting with ;;; .
+; 
+; converted to elisp by Spencer Thomas.
+; Thoroughly cleaned up by Richard Stallman.
+;  
+; If anyone feels like hacking at it, Bob Keller (Keller@Utah-20) first
+; suggested the beast, and has some good ideas for its improvement, but
+; doesn?tknow TECO (the lucky devil...).  One thing that should definitely
+; be done is adding the ability to search some other buffer(s) if you can?t
+; find the expansion you want in the current one.
+
+;; (defun dabbrevs-help ()
+;;   "Give help about dabbrevs."
+;;   (interactive)
+;;   (&info "emacs" "dabbrevs")	; Select the specific info node.
+;; )
+(provide 'dabbrevs)
+
+(defvar dabbrevs-limit nil
+  "*Limits region searched by `dabbrevs-expand' to this many chars away.")
+(make-variable-buffer-local 'dabbrevs-limit)
+
+(defvar dabbrevs-backward-only nil
+  "*If non-NIL, `dabbrevs-expand' only looks backwards.")
+
+; State vars for dabbrevs-re-expand.
+(defvar last-dabbrevs-table nil
+  "Table of expansions seen so far (local)")
+(make-variable-buffer-local 'last-dabbrevs-table)
+
+(defvar last-dabbrevs-abbreviation ""
+  "Last string we tried to expand (local).")
+(make-variable-buffer-local 'last-dabbrevs-abbreviation)
+
+(defvar last-dabbrevs-direction 0
+  "Direction of last dabbrevs search (local)")
+(make-variable-buffer-local 'last-dabbrevs-direction)
+
+(defvar last-dabbrevs-abbrev-location nil
+  "Location last abbreviation began (local).")
+(make-variable-buffer-local 'last-dabbrevs-abbrev-location)
+
+(defvar last-dabbrevs-expansion nil
+    "Last expansion of an abbreviation. (local)")
+(make-variable-buffer-local 'last-dabbrevs-expansion)
+
+(defvar last-dabbrevs-expansion-location nil
+  "Location the last expansion was found. (local)")
+(make-variable-buffer-local 'last-dabbrevs-expansion-location)
+
+;;;###autoload
+(defun dabbrev-expand (arg)
+  "Expand previous word \"dynamically\".
+Expands to the most recent, preceding word for which this is a prefix.
+If no suitable preceding word is found, words following point are considered.
+
+If `case-fold-search' and `case-replace' are non-nil (usually true)
+then the substituted word may be case-adjusted to match the abbreviation
+that you had typed.  This takes place if the substituted word, as found,
+is all lower case, or if it is at the beginning of a sentence and only
+its first letter was upper case.
+
+A positive prefix arg 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."
+  (interactive "*P")
+  (let (abbrev expansion old which loc n pattern
+	(do-case (and case-fold-search case-replace)))
+    ;; abbrev -- the abbrev to expand
+    ;; expansion -- the expansion found (eventually) or nil until then
+    ;; old -- the text currently in the buffer
+    ;;    (the abbrev, or the previously-made expansion)
+    ;; loc -- place where expansion is found
+    ;;    (to start search there for next expansion if requested later)
+    ;; do-case -- non-nil if should transform case when substituting.
+    (save-excursion
+      (if (and (null arg)
+	       (eq last-command this-command)
+	       last-dabbrevs-abbrev-location)
+	  (progn
+	    (setq abbrev last-dabbrevs-abbreviation)
+	    (setq old last-dabbrevs-expansion)
+	    (setq which last-dabbrevs-direction))
+	(setq which (if (null arg)
+			(if dabbrevs-backward-only 1 0)
+		        (prefix-numeric-value arg)))
+	(setq loc (point))
+	(forward-word -1)
+	(setq last-dabbrevs-abbrev-location (point)) ; Original location.
+	(setq abbrev (buffer-substring (point) loc))
+	(setq old abbrev)
+	(setq last-dabbrevs-expansion-location nil)
+	(setq last-dabbrev-table nil))  	; Clear table of things seen.
+
+      (setq pattern (concat "\\b" (regexp-quote abbrev) "\\(\\sw\\|\\s_\\)+"))
+      ;; Try looking backward unless inhibited.
+      (if (>= which 0)
+	  (progn 
+	    (setq n (max 1 which))
+	    (if last-dabbrevs-expansion-location
+		(goto-char last-dabbrevs-expansion-location))
+	    (while (and (> n 0)
+			(setq expansion (dabbrevs-search pattern t do-case)))
+	      (setq loc (point-marker))
+	      (setq last-dabbrev-table (cons expansion last-dabbrev-table))
+	      (setq n (1- n)))
+	    (or expansion
+		(setq last-dabbrevs-expansion-location nil))
+	    (setq last-dabbrevs-direction (min 1 which))))
+
+      (if (and (<= which 0) (not expansion)) ; Then look forward.
+	  (progn 
+	    (setq n (max 1 (- which)))
+	    (if last-dabbrevs-expansion-location
+		(goto-char last-dabbrevs-expansion-location))
+	    (while (and (> n 0)
+			(setq expansion (dabbrevs-search pattern nil do-case)))
+	      (setq loc (point-marker))
+	      (setq last-dabbrev-table (cons expansion last-dabbrev-table))
+	      (setq n (1- n)))
+	    (setq last-dabbrevs-direction -1))))
+
+    (if (not expansion)
+	(let ((first (string= abbrev old)))
+	  (setq last-dabbrevs-abbrev-location nil)
+	  (if (not first)
+	      (progn (undo-boundary)
+		     (delete-backward-char (length old))
+		     (insert abbrev)))
+	  (error (if first
+		     "No dynamic expansion for \"%s\" found."
+		     "No further dynamic expansions for \"%s\" found.")
+		 abbrev))
+      ;; Success: stick it in and return.
+      (undo-boundary)
+      (search-backward old)
+      ;; Make case of replacement conform to case of abbreviation
+      ;; provided (1) that kind of thing is enabled in this buffer
+      ;; and (2) the replacement itself is all lower case.
+      ;; First put back the original abbreviation with its original
+      ;; case pattern.
+      (save-excursion
+	(replace-match abbrev t 'literal))
+      (search-forward abbrev)
+      (let ((do-case (and do-case
+			  (string= (substring expansion 1)
+				   (downcase (substring expansion 1))))))
+	;; First put back the original abbreviation with its original
+	;; case pattern.
+	(save-excursion
+	  (replace-match abbrev t 'literal))
+	(search-forward abbrev)
+	(replace-match (if do-case (downcase expansion) expansion)
+		       (not do-case)
+		       'literal))
+      ;; Save state for re-expand.
+      (setq last-dabbrevs-abbreviation abbrev)
+      (setq last-dabbrevs-expansion expansion)
+      (setq last-dabbrevs-expansion-location loc))))
+
+;;;###autoload
+(define-key esc-map "/" 'dabbrev-expand)
+
+
+;; Search function used by dabbrevs library.  
+;; First arg is string to find as prefix of word.  Second arg is
+;; t for reverse search, nil for forward.  Variable dabbrevs-limit
+;; controls the maximum search region size.
+
+;; Table of expansions already seen is examined in buffer last-dabbrev-table,
+;; so that only distinct possibilities are found by dabbrevs-re-expand.
+;; Note that to prevent finding the abbrev itself it must have been
+;; entered in the table.
+
+;; IGNORE-CASE non-nil means treat case as insignificant while
+;; looking for a match and when comparing with previous matches.
+;; Also if that's non-nil and the match is found at the beginning of a sentence
+;; and is in lower case except for the initial
+;; then it is converted to all lower case for return.
+
+;; Value is the expansion, or nil if not found.  After a successful
+;; search, point is left right after the expansion found.
+
+(defun dabbrevs-search (pattern reverse ignore-case)
+  (let (missing result (case-fold-search ignore-case))
+    (save-restriction 	    ; Uses restriction for limited searches.
+      (if dabbrevs-limit
+	  (narrow-to-region last-dabbrevs-abbrev-location
+			    (+ (point)
+			       (* dabbrevs-limit (if reverse -1 1)))))
+      ;; Keep looking for a distinct expansion.
+      (setq result nil)
+      (setq missing nil)
+      (while  (and (not result) (not missing))
+	; Look for it, leave loop if search fails.
+	(setq missing
+	      (not (if reverse
+		       (re-search-backward pattern nil t)
+		       (re-search-forward pattern nil t))))
+
+	(if (not missing)
+	    (progn
+	      (setq result (buffer-substring (match-beginning 0)
+					     (match-end 0)))
+	      (let* ((test last-dabbrev-table))
+		(while (and test
+			    (not
+			     (if ignore-case
+				 (string= (downcase (car test))
+					  (downcase result))
+			       (string= (car test) result))))
+		  (setq test (cdr test)))
+		(if test (setq result nil))))))	; if already in table, ignore
+      (if result
+	  (save-excursion
+	    (let ((beg (match-beginning 0)))
+	      (goto-char beg)
+	      (and ignore-case
+		   (string= (substring result 1)
+			    (downcase (substring result 1)))
+		   (if (string= paragraph-start
+				(concat "^$\\|" page-delimiter))
+		       (and (re-search-backward sentence-end nil t)
+			    (= (match-end 0) beg))
+		     (forward-char 1)
+		     (backward-sentence)
+		     (= (point) beg))
+		   (setq result (downcase result))))))
+      result)))
diff --git a/lisp/gnuspost.el b/lisp/gnuspost.el
new file mode 100644
index 00000000000..d40982d1def
--- /dev/null
+++ b/lisp/gnuspost.el
@@ -0,0 +1,672 @@
+;;; Post news commands for GNUS newsreader
+;; Copyright (C) 1989 Fujitsu Laboratories LTD.
+;; Copyright (C) 1989, 1990 Masanobu UMEDA
+;; $Header: gnuspost.el,v 1.2 90/03/23 13:25:16 umerin Locked $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+(provide 'gnuspost)
+(require 'gnus)
+
+(defvar gnus-organization-file "/usr/lib/news/organization"
+  "*Local news organization file.")
+
+(defvar gnus-post-news-buffer "*post-news*")
+(defvar gnus-winconf-post-news nil)
+
+(autoload 'news-reply-mode "rnewspost")
+
+;;; Post news commands of GNUS Group Mode and Subject Mode
+
+(defun gnus-Group-post-news ()
+  "Post an article."
+  (interactive)
+  ;; Save window configuration.
+  (setq gnus-winconf-post-news (current-window-configuration))
+  (unwind-protect
+      (gnus-post-news)
+    (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
+	     (not (zerop (buffer-size))))
+	;; Restore last window configuration.
+	(set-window-configuration gnus-winconf-post-news)))
+  ;; We don't want to return to Subject buffer nor Article buffer later.
+  (if (get-buffer gnus-Subject-buffer)
+      (bury-buffer gnus-Subject-buffer))
+  (if (get-buffer gnus-Article-buffer)
+      (bury-buffer gnus-Article-buffer)))
+
+(defun gnus-Subject-post-news ()
+  "Post an article."
+  (interactive)
+  (gnus-Subject-select-article t nil)
+  ;; Save window configuration.
+  (setq gnus-winconf-post-news (current-window-configuration))
+  (unwind-protect
+      (progn
+	(switch-to-buffer gnus-Article-buffer)
+	(widen)
+	(delete-other-windows)
+	(gnus-post-news))
+    (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
+	     (not (zerop (buffer-size))))
+	;; Restore last window configuration.
+	(set-window-configuration gnus-winconf-post-news)))
+  ;; We don't want to return to Article buffer later.
+  (bury-buffer gnus-Article-buffer))
+
+(defun gnus-Subject-post-reply (yank)
+  "Post a reply article.
+If prefix argument YANK is non-nil, original article is yanked automatically."
+  (interactive "P")
+  (gnus-Subject-select-article t nil)
+  ;; Check Followup-To: poster.
+  (set-buffer gnus-Article-buffer)
+  (if (and gnus-use-followup-to
+	   (string-equal "poster" (gnus-fetch-field "followup-to"))
+	   (or (not (eq gnus-use-followup-to t))
+	       (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? "))))
+      ;; Mail to the poster.  GNUS is now RFC1036 compliant.
+      (gnus-Subject-mail-reply yank)
+    ;; Save window configuration.
+    (setq gnus-winconf-post-news (current-window-configuration))
+    (unwind-protect
+	(progn
+	  (switch-to-buffer gnus-Article-buffer)
+	  (widen)
+	  (delete-other-windows)
+	  (gnus-news-reply yank))
+      (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
+	       (not (zerop (buffer-size))))
+	  ;; Restore last window configuration.
+	  (set-window-configuration gnus-winconf-post-news)))
+    ;; We don't want to return to Article buffer later.
+    (bury-buffer gnus-Article-buffer)))
+
+(defun gnus-Subject-post-reply-with-original ()
+  "Post a reply article with original article."
+  (interactive)
+  (gnus-Subject-post-reply t))
+
+(defun gnus-Subject-cancel-article ()
+  "Cancel an article you posted."
+  (interactive)
+  (gnus-Subject-select-article t nil)
+  (gnus-eval-in-buffer-window gnus-Article-buffer
+    (gnus-cancel-news)))
+
+
+;;; Post a News using NNTP
+
+;;;###autoload
+(fset 'sendnews 'gnus-post-news)
+;;;###autoload
+(fset 'postnews 'gnus-post-news)
+;;;###autoload
+(defun gnus-post-news ()
+  "Begin editing a new USENET news article to be posted.
+Type \\[describe-mode] once editing the article to get a list of commands."
+  (interactive)
+  (if (or (not gnus-novice-user)
+	  (y-or-n-p "Are you sure you want to post to all of USENET? "))
+      (let ((artbuf (current-buffer))
+	    (newsgroups			;Default newsgroup.
+	     (if (eq major-mode 'gnus-Article-mode) gnus-newsgroup-name))
+	    (subject nil)
+	    (distribution nil))
+	(save-restriction
+	  (and (not (zerop (buffer-size)))
+	       ;;(equal major-mode 'news-mode)
+	       (equal major-mode 'gnus-Article-mode)
+	       (progn
+		 ;;(news-show-all-headers)
+		 (gnus-Article-show-all-headers)
+		 (narrow-to-region (point-min)
+				   (progn (goto-char (point-min))
+					  (search-forward "\n\n")
+					  (point)))))
+	  (setq news-reply-yank-from (mail-fetch-field "from"))
+	  (setq news-reply-yank-message-id (mail-fetch-field "message-id")))
+	(pop-to-buffer gnus-post-news-buffer)
+	(news-reply-mode)
+	(gnus-overload-functions)
+	(if (and (buffer-modified-p)
+		 (> (buffer-size) 0)
+		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
+	    ;; Continue composition.
+	    ;; Make news-reply-yank-original work on the current article.
+	    (setq mail-reply-buffer artbuf)
+	  (erase-buffer)
+	  (if gnus-interactive-post
+	      ;; Newsgroups, subject and distribution are asked for.
+	      ;; Suggested by yuki@flab.fujitsu.junet.
+	      (progn
+		;; Subscribed newsgroup names are required for
+		;; completing read of newsgroup.
+		(or gnus-newsrc-assoc
+		    (gnus-read-newsrc-file))
+		;; Which do you like? (UMERIN)
+		;; (setq newsgroups (read-string "Newsgroups: " "general"))
+		(or newsgroups		;Use the default newsgroup.
+		    (setq newsgroups
+			  (completing-read "Newsgroup: " gnus-newsrc-assoc
+					   nil 'require-match
+					   newsgroups ;Default newsgroup.
+					   )))
+		(setq subject (read-string "Subject: "))
+		(setq distribution
+		      (substring newsgroups 0 (string-match "\\." newsgroups)))
+		(if (string-equal distribution newsgroups)
+		    ;; Newsgroup may be general or control. In this
+		    ;; case, use default distribution.
+		    (setq distribution gnus-default-distribution))
+		(setq distribution
+		      (read-string "Distribution: " distribution))
+		;; An empty string is ok to ignore gnus-default-distribution.
+		;;(if (string-equal distribution "")
+		;;    (setq distribution nil))
+		))
+	  (news-setup () subject () newsgroups artbuf)
+	  ;; Make sure the article is posted by GNUS.
+	  ;;(mail-position-on-field "Posting-Software")
+	  ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
+	  ;; Insert Distribution: field.
+	  ;; Suggested by ichikawa@flab.fujitsu.junet.
+	  (mail-position-on-field "Distribution")
+	  (insert (or distribution gnus-default-distribution ""))
+	  ;; Handle author copy using FCC field.
+	  (if gnus-author-copy
+	      (progn
+		(mail-position-on-field "FCC")
+		(insert gnus-author-copy)))
+	  (if gnus-interactive-post
+	      ;; All fields are filled in.
+	      (goto-char (point-max))
+	    ;; Move point to Newsgroup: field.
+	    (goto-char (point-min))
+	    (end-of-line))
+	  ))
+    (message "")))
+
+(defun gnus-news-reply (&optional yank)
+  "Compose and post a reply (aka a followup) to the current article on USENET.
+While composing the followup, use \\[news-reply-yank-original] to yank the
+original message into it."
+  (interactive)
+  (if (or (not gnus-novice-user)
+	  (y-or-n-p "Are you sure you want to followup to all of USENET? "))
+      (let (from cc subject date to followup-to newsgroups message-of
+		 references distribution message-id
+		 (artbuf (current-buffer)))
+	(save-restriction
+	  (and (not (zerop (buffer-size)))
+	       ;;(equal major-mode 'news-mode)
+	       (equal major-mode 'gnus-Article-mode)
+	       (progn
+		 ;; (news-show-all-headers)
+		 (gnus-Article-show-all-headers)
+		 (narrow-to-region (point-min)
+				   (progn (goto-char (point-min))
+					  (search-forward "\n\n")
+					  (point)))))
+	  (setq from (mail-fetch-field "from"))
+	  (setq	news-reply-yank-from from)
+	  (setq	subject (mail-fetch-field "subject"))
+	  (setq	date (mail-fetch-field "date"))
+	  (setq followup-to (mail-fetch-field "followup-to"))
+	  ;; Ignore Followup-To: poster.
+	  (if (or (null gnus-use-followup-to) ;Ignore followup-to: field.
+		  (string-equal "" followup-to)	;Bogus header.
+		  (string-equal "poster" followup-to))
+	      (setq followup-to nil))
+	  (setq	newsgroups (or followup-to (mail-fetch-field "newsgroups")))
+	  (setq	references (mail-fetch-field "references"))
+	  (setq	distribution (mail-fetch-field "distribution"))
+	  (setq	message-id (mail-fetch-field "message-id"))
+	  (setq	news-reply-yank-message-id message-id))
+	(pop-to-buffer gnus-post-news-buffer)
+	(news-reply-mode)
+	(gnus-overload-functions)
+	(if (and (buffer-modified-p)
+		 (> (buffer-size) 0)
+		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
+	    ;; Continue composition.
+	    ;; Make news-reply-yank-original work on current article.
+	    (setq mail-reply-buffer artbuf)
+	  (erase-buffer)
+	  (and subject
+	       (setq subject
+		     (concat "Re: " (gnus-simplify-subject subject 're-only))))
+	  (and from
+	       (progn
+		 (let ((stop-pos
+			(string-match "  *at \\|  *@ \\| *(\\| *<" from)))
+		   (setq message-of
+			 (concat
+			  (if stop-pos (substring from 0 stop-pos) from)
+			  "'s message of "
+			  date)))))
+	  (news-setup nil subject message-of newsgroups artbuf)
+	  (if followup-to
+	      (progn (news-reply-followup-to)
+		     (insert followup-to)))
+	  ;; Fold long references line to follow RFC1036.
+	  (mail-position-on-field "References")
+	  (let ((begin (point))
+		(fill-column 79)
+		(fill-prefix "\t"))
+	    (if references
+		(insert references))
+	    (if (and references message-id)
+		(insert " "))
+	    (if message-id
+		(insert message-id))
+	    ;; The region must end with a newline to fill the region
+	    ;; without inserting extra newline.
+	    (fill-region-as-paragraph begin (1+ (point))))
+	  ;; Make sure the article is posted by GNUS.
+	  ;;(mail-position-on-field "Posting-Software")
+	  ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
+	  ;; Distribution must be the same as original article.
+	  (mail-position-on-field "Distribution")
+	  (insert (or distribution ""))
+	  ;; Handle author copy using FCC field.
+	  (if gnus-author-copy
+	      (progn
+		(mail-position-on-field "FCC")
+		(insert gnus-author-copy)))
+	  (goto-char (point-max)))
+	;; Yank original article automatically.
+	(if yank
+	    (let ((last (point)))
+	      (goto-char (point-max))
+	      (news-reply-yank-original nil)
+	      (goto-char last)))
+	)
+    (message "")))
+
+(defun gnus-inews-news ()
+  "Send a news message."
+  (interactive)
+  (let* ((case-fold-search nil)
+	 (server-running (gnus-server-opened)))
+    (save-excursion
+      ;; It is possible to post a news without reading news using
+      ;; `gnus' before.
+      ;; Suggested by yuki@flab.fujitsu.junet.
+      (gnus-start-news-server)		;Use default server.
+      ;; NNTP server must be opened before current buffer is modified.
+      (widen)
+      (goto-char (point-min))
+      (run-hooks 'news-inews-hook)
+      (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...")
+      ;; Post to NNTP server. 
+      (if (gnus-inews-article)
+	  (message "Posting to USENET... done")
+	;; We cannot signal an error.
+	(ding) (message "Article rejected: %s" (gnus-status-message)))
+      (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))
+    ;; If NNTP server is opened by gnus-inews-news, close it by myself.
+    (or server-running
+	(gnus-close-server))
+    (and (fboundp 'bury-buffer) (bury-buffer))
+    ;; Restore last window configuration.
+    (and gnus-winconf-post-news
+	 (set-window-configuration gnus-winconf-post-news))
+    (setq gnus-winconf-post-news nil)
+    ))
+
+(defun gnus-cancel-news ()
+  "Cancel an article you posted."
+  (interactive)
+  (if (yes-or-no-p "Do you really want to cancel this article? ")
+      (let ((from nil)
+	    (newsgroups nil)
+	    (message-id nil)
+	    (distribution nil))
+	(save-excursion
+	  ;; Get header info. from original article.
+	  (save-restriction
+	    (gnus-Article-show-all-headers)
+	    (goto-char (point-min))
+	    (search-forward "\n\n")
+	    (narrow-to-region (point-min) (point))
+	    (setq from (mail-fetch-field "from"))
+	    (setq newsgroups (mail-fetch-field "newsgroups"))
+	    (setq message-id (mail-fetch-field "message-id"))
+	    (setq distribution (mail-fetch-field "distribution")))
+	  ;; Verify if the article is absolutely user's by comparing
+	  ;; user id with value of its From: field.
+	  (if (not
+	       (string-equal
+		(downcase (mail-strip-quoted-names from))
+		(downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
+	      (progn
+		(ding) (message "This article is not yours"))
+	    ;; Make control article.
+	    (set-buffer (get-buffer-create " *GNUS-posting*"))
+	    (buffer-flush-undo (current-buffer))
+	    (erase-buffer)
+	    (insert "Newsgroups: " newsgroups "\n"
+		    "Subject: cancel " message-id "\n"
+		    "Control: cancel " message-id "\n"
+		    ;; We should not use the value of
+		    ;;  `gnus-default-distribution' as default value,
+		    ;;  because distribution must be as same as original
+		    ;;  article.
+		    "Distribution: " (or distribution "") "\n"
+		    )
+	    ;; Prepare article headers.
+	    (gnus-inews-insert-headers)
+	    (goto-char (point-max))
+	    ;; Insert empty line.
+	    (insert "\n")
+	    ;; Send the control article to NNTP server.
+	    (message "Canceling your article...")
+	    (if (gnus-request-post)
+		(message "Canceling your article... done")
+	      (ding) (message "Failed to cancel your article"))
+	    (kill-buffer (current-buffer))
+	    )))
+    ))
+
+
+;;; Lowlevel inews interface
+
+(defun gnus-inews-article ()
+  "NNTP inews interface."
+  (let ((signature
+	 (if gnus-signature-file
+	     (expand-file-name gnus-signature-file nil)))
+	(distribution nil)
+	(artbuf (current-buffer))
+	(tmpbuf (get-buffer-create " *GNUS-posting*")))
+    (save-excursion
+      (set-buffer tmpbuf)
+      (buffer-flush-undo (current-buffer))
+      (erase-buffer)
+      (insert-buffer-substring artbuf)
+      ;; Get distribution.
+      (save-restriction
+	(goto-char (point-min))
+	(search-forward "\n\n")
+	(narrow-to-region (point-min) (point))
+	(setq distribution (mail-fetch-field "distribution")))
+      (widen)
+      (if signature
+	  (progn
+	    ;; Change signature file by distribution.
+	    ;; Suggested by hyoko@flab.fujitsu.junet.
+	    (if (file-exists-p (concat signature "-" distribution))
+		(setq signature (concat signature "-" distribution)))
+	    ;; Insert signature.
+	    (if (file-exists-p signature)
+		(progn
+		  (goto-char (point-max))
+		  (insert "--\n")
+		  (insert-file-contents signature)))
+	    ))
+      ;; Prepare article headers.
+      (save-restriction
+	(goto-char (point-min))
+	(search-forward "\n\n")
+	(narrow-to-region (point-min) (point))
+	(gnus-inews-insert-headers)
+	;; Save author copy of posted article. The article must be
+	;;  copied before being posted because `gnus-request-post'
+	;;  modifies the buffer.
+	(let ((case-fold-search t))
+	  ;; Find and handle any FCC fields.
+	  (goto-char (point-min))
+	  (if (re-search-forward "^FCC:" nil t)
+	      (gnus-inews-do-fcc))))
+      (widen)
+      ;; Run final inews hooks.
+      (run-hooks 'gnus-Inews-article-hook)
+      ;; Post an article to NNTP server.
+      ;; Return NIL if post failed.
+      (prog1
+	  (gnus-request-post)
+	(kill-buffer (current-buffer)))
+      )))
+
+(defun gnus-inews-do-fcc ()
+  "Process FCC: fields."
+  (let ((fcc-list nil)
+	(fcc-file nil)
+	(case-fold-search t))		;Should ignore case.
+    (save-excursion
+      (save-restriction
+	(goto-char (point-min))
+	(while (re-search-forward "^FCC:[ \t]*" nil t)
+	  (setq fcc-list (cons (buffer-substring (point)
+						 (progn
+						   (end-of-line)
+						   (skip-chars-backward " \t")
+						   (point)))
+			       fcc-list))
+	  (delete-region (match-beginning 0)
+			 (progn (forward-line 1) (point))))
+	;; Process FCC operations.
+	(widen)
+	(while fcc-list
+	  (setq fcc-file (car fcc-list))
+	  (setq fcc-list (cdr fcc-list))
+	  (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
+		 (let ((program (substring fcc-file
+					   (match-beginning 1) (match-end 1))))
+		   ;; Suggested by yuki@flab.fujitsu.junet.
+		   ;; Send article to named program.
+		   (call-process-region (point-min) (point-max) shell-file-name
+					nil nil nil "-c" program)
+		   ))
+		(t
+		 ;; Suggested by hyoko@flab.fujitsu.junet.
+		 ;; Save article in Unix mail format by default.
+		 (funcall (or gnus-author-copy-saver 'rmail-output) fcc-file)
+		 ))
+	  )
+	))
+    ))
+
+(defun gnus-inews-insert-headers ()
+  "Prepare article headers.
+Path:, From:, Subject: and Distribution: are generated.
+Message-ID:, Date: and Organization: are optional."
+  (save-excursion
+    (let ((date (gnus-inews-date))
+	  (message-id (gnus-inews-message-id))
+	  (organization (gnus-inews-organization)))
+      ;; Insert from the top of headers.
+      (goto-char (point-min))
+      (insert "Path: " (gnus-inews-path) "\n")
+      (insert "From: " (gnus-inews-user-name) "\n")
+      ;; If there is no subject, make Subject: field.
+      (or (mail-fetch-field "subject")
+	  (insert "Subject: \n"))
+      ;; Insert random headers.
+      (if message-id
+	  (insert "Message-ID: " message-id "\n"))
+      (if date
+	  (insert "Date: " date "\n"))
+      (if organization
+	  (let ((begin (point))
+		(fill-column 79)
+		(fill-prefix "\t"))
+	    (insert "Organization: " organization "\n")
+	    (fill-region-as-paragraph begin (point))))
+      (or (mail-fetch-field "distribution")
+	  (insert "Distribution: \n"))
+      )))
+
+(defun gnus-inews-path ()
+  "Return uucp path."
+  (let ((login-name (gnus-inews-login-name)))
+    (cond ((null gnus-use-generic-path)
+	   (concat gnus-nntp-server "!" login-name))
+	  ((stringp gnus-use-generic-path)
+	   ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
+	   (concat gnus-use-generic-path "!" login-name))
+	  (t login-name))
+    ))
+
+(defun gnus-inews-user-name ()
+  "Return user's network address as `NAME@DOMAIN (FULL NAME)'."
+  (let ((login-name (gnus-inews-login-name))
+	(full-name (gnus-inews-full-name)))
+    (concat login-name "@" (gnus-inews-domain-name gnus-use-generic-from)
+	    ;; User's full name.
+	    (cond ((string-equal full-name "") "")
+		  ((string-equal full-name "&")	;Unix hack.
+		   (concat " (" login-name ")"))
+		  (t
+		   (concat " (" full-name ")")))
+	    )))
+
+(defun gnus-inews-login-name ()
+  "Return user login name.
+Got from the variable `gnus-user-login-name', the environment variables
+USER and LOGNAME, and the function `user-login-name'."
+  (or gnus-user-login-name
+      (getenv "USER") (getenv "LOGNAME") (user-login-name)))
+
+(defun gnus-inews-full-name ()
+  "Return user full name.
+Got from the variable `gnus-user-full-name', the environment variable
+NAME, and the function `user-full-name'."
+  (or gnus-user-full-name
+      (getenv "NAME") (user-full-name)))
+
+(defun gnus-inews-domain-name (&optional genericfrom)
+  "Return user's domain name.
+If optional argument GENERICFROM is a string, use it as the domain
+name; if it is non-nil, strip of local host name from the domain name.
+If the function `system-name' returns full internet name and the
+domain is undefined, the domain name is got from it."
+  (let ((domain (or (if (stringp genericfrom) genericfrom)
+		    (getenv "DOMAINNAME")
+		    gnus-your-domain
+		    ;; Function `system-name' may return full internet name.
+		    ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
+		    (if (string-match "\\." (system-name))
+			(substring (system-name) (match-end 0)))
+		    (read-string "Domain name (no host): ")))
+	(host (or (if (string-match "\\." (system-name))
+		      (substring (system-name) 0 (match-beginning 0)))
+		  (system-name))))
+    (if (string-equal "." (substring domain 0 1))
+	(setq domain (substring domain 1)))
+    (if (null gnus-your-domain)
+	(setq gnus-your-domain domain))
+    ;; Support GENERICFROM as same as standard Bnews system.
+    ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
+    (cond ((null genericfrom)
+	   (concat host "." domain))
+	  ;;((stringp genericfrom) genericfrom)
+	  (t domain))
+    ))
+
+(defun gnus-inews-message-id ()
+  "Generate unique Message-ID for user."
+  ;; Message-ID should not contain a slash and should be terminated by
+  ;; a number.  I don't know the reason why it is so.
+  (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">"))
+
+(defun gnus-inews-unique-id ()
+  "Generate unique ID from user name and current time."
+  (let ((date (current-time-string))
+	(name (gnus-inews-login-name)))
+    (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
+		      date)
+	(concat (upcase name) "."
+		(substring date (match-beginning 6) (match-end 6)) ;Year
+		(substring date (match-beginning 1) (match-end 1)) ;Month
+		(substring date (match-beginning 2) (match-end 2)) ;Day
+		(substring date (match-beginning 3) (match-end 3)) ;Hour
+		(substring date (match-beginning 4) (match-end 4)) ;Minute
+		(substring date (match-beginning 5) (match-end 5)) ;Second
+		)
+      (error "Cannot understand current-time-string: %s." date))
+    ))
+
+(defun gnus-inews-date ()
+  "Bnews date format string of today.  Time zone is ignored."
+  ;; Insert buggy date (time zone is ignored), but I don't worry about
+  ;; it since inews will rewrite it.
+  (let ((date (current-time-string)))
+    (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
+		      date)
+	(concat (substring date (match-beginning 2) (match-end 2)) ;Day
+		" "
+		(substring date (match-beginning 1) (match-end 1)) ;Month
+		" "
+		(substring date (match-beginning 4) (match-end 4)) ;Year
+		" "
+		(substring date (match-beginning 3) (match-end 3))) ;Time
+      (error "Cannot understand current-time-string: %s." date))
+    ))
+
+(defun gnus-inews-organization ()
+  "Return user's organization.
+The ORGANIZATION environment variable is used if defined.
+If not, the variable `gnus-your-organization' is used instead.
+If the value begins with a slash, it is taken as the name of a file
+containing the organization."
+  ;; The organization must be got in this order since the ORGANIZATION
+  ;; environment variable is intended for user specific while
+  ;; gnus-your-organization is for machine or organization specific.
+  (let ((organization (or (getenv "ORGANIZATION")
+			  gnus-your-organization
+			  (expand-file-name "~/.organization" nil))))
+    (and (stringp organization)
+	 (string-equal (substring organization 0 1) "/")
+	 ;; Get it from the user and system file.
+	 ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath).
+	 (let ((dist (mail-fetch-field "distribution")))
+	   (setq organization
+		 (cond ((file-exists-p (concat organization "-" dist))
+			(concat organization "-" dist))
+		       ((file-exists-p organization) organization)
+		       ((file-exists-p gnus-organization-file)
+			gnus-organization-file)
+		       (t organization)))
+	   ))
+    (cond ((not (stringp organization)) nil)
+	  ((and (string-equal (substring organization 0 1) "/")
+		(file-exists-p organization))
+	   ;; If the first character is `/', assume it is the name of
+	   ;; a file containing the organization.
+	   (save-excursion
+	     (let ((tmpbuf (get-buffer-create " *GNUS organization*")))
+	       (set-buffer tmpbuf)
+	       (erase-buffer)
+	       (insert-file-contents organization)
+	       (prog1 (buffer-string)
+		 (kill-buffer tmpbuf))
+	       )))
+	  (t organization))
+    ))
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
new file mode 100644
index 00000000000..7f78c28d970
--- /dev/null
+++ b/lisp/progmodes/inf-lisp.el
@@ -0,0 +1,601 @@
+;;; -*-Emacs-Lisp-*- cmulisp.el
+;;; Copyright Olin Shivers (1988).
+;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
+;;; notice appearing here to the effect that you may use this code any
+;;; way you like, as long as you don't charge money for it, remove this
+;;; notice, or hold me liable for its results.
+
+;;; This replaces the standard inferior-lisp mode.
+;;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
+;;; Please send me bug reports, bug fixes, and extensions, so that I can
+;;; merge them into the master source.
+;;;
+;;; Change log at end of file.
+
+;;; This file defines a a lisp-in-a-buffer package (cmulisp mode) built on top
+;;; of comint mode.  Cmulisp mode is similar to, and intended to replace, its
+;;; counterpart in the standard gnu emacs release. This replacements is more
+;;; featureful, robust, and uniform than the released version.  The key
+;;; bindings are also more compatible with the bindings of Hemlock and Zwei
+;;; (the Lisp Machine emacs).
+
+;;; Since this mode is built on top of the general command-interpreter-in-
+;;; a-buffer mode (comint mode), it shares a common base functionality, 
+;;; and a common set of bindings, with all modes derived from comint mode.
+;;; This makes these modes easier to use.
+
+;;; For documentation on the functionality provided by comint mode, and
+;;; the hooks available for customising it, see the file comint.el.
+;;; For further information on cmulisp mode, see the comments below.
+
+;;; Needs fixin:
+;;; The load-file/compile-file default mechanism could be smarter -- it
+;;; doesn't know about the relationship between filename extensions and
+;;; whether the file is source or executable. If you compile foo.lisp
+;;; with compile-file, then the next load-file should use foo.bin for
+;;; the default, not foo.lisp. This is tricky to do right, particularly
+;;; because the extension for executable files varies so much (.o, .bin,
+;;; .lbin, .mo, .vo, .ao, ...).
+;;;
+;;; It would be nice if cmulisp (and inferior scheme, T, ...) modes
+;;; had a verbose minor mode wherein sending or compiling defuns, etc.
+;;; would be reflected in the transcript with suitable comments, e.g.
+;;; ";;; redefining fact". Several ways to do this. Which is right?
+;;;
+;;; When sending text from a source file to a subprocess, the process-mark can 
+;;; move off the window, so you can lose sight of the process interactions.
+;;; Maybe I should ensure the process mark is in the window when I send
+;;; text to the process? Switch selectable?
+
+(require 'comint)
+(provide 'cmulisp)
+
+;; YOUR .EMACS FILE
+;;=============================================================================
+;; Some suggestions for your .emacs file.
+;;
+;; ; If cmulisp lives in some non-standard directory, you must tell emacs
+;; ; where to get it. This may or may not be necessary.
+;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
+;;
+;; ; Autoload cmulisp from file cmulisp.el
+;; (autoload 'cmulisp "cmulisp"
+;;           "Run an inferior Lisp process."
+;;           t)
+;;
+;; ; Define C-c t to run my favorite command in cmulisp mode:
+;; (setq cmulisp-load-hook
+;;       '((lambda () 
+;;           (define-key cmulisp-mode-map "\C-ct" 'favorite-cmd))))
+
+
+;;; Brief Command Documentation:
+;;;============================================================================
+;;; Comint Mode Commands: (common to cmulisp and all comint-derived modes)
+;;;
+;;; m-p	    comint-previous-input    	    Cycle backwards in input history
+;;; m-n	    comint-next-input  	    	    Cycle forwards
+;;; m-c-r   comint-previous-input-matching  Search backwards in input history
+;;; return  comint-send-input
+;;; c-a     comint-bol                      Beginning of line; skip prompt.
+;;; c-d	    comint-delchar-or-maybe-eof	    Delete char unless at end of buff.
+;;; c-c c-u comint-kill-input	    	    ^u
+;;; c-c c-w backward-kill-word    	    ^w
+;;; c-c c-c comint-interrupt-subjob 	    ^c
+;;; c-c c-z comint-stop-subjob	    	    ^z
+;;; c-c c-\ comint-quit-subjob	    	    ^\
+;;; c-c c-o comint-kill-output		    Delete last batch of process output
+;;; c-c c-r comint-show-output		    Show last batch of process output
+;;;         send-invisible                  Read line w/o echo & send to proc
+;;;         comint-continue-subjob	    Useful if you accidentally suspend
+;;;					        top-level job.
+;;; comint-mode-hook is the comint mode hook.
+
+;;; CMU Lisp Mode Commands:
+;;; c-m-x   lisp-send-defun     This binding is a gnu convention.
+;;; c-c c-l lisp-load-file  	Prompt for file name; tell Lisp to load it.
+;;; c-c c-k lisp-compile-file	Prompt for file name; tell Lisp to kompile it.
+;;; 	    	    	    	Filename completion is available, of course.
+;;;
+;;; Additionally, these commands are added to the key bindings of Lisp mode:
+;;; c-m-x   lisp-eval-defun         This binding is a gnu convention.
+;;; c-c c-e lisp-eval-defun 	    Send the current defun to Lisp process.
+;;; c-x c-e lisp-eval-last-sexp     Send the previous sexp to Lisp process.
+;;; c-c m-e lisp-eval-defun-and-go  After sending the defun, switch-to-lisp.
+;;; c-c c-r lisp-eval-region        Send the current region to Lisp process.
+;;; c-c m-r lisp-eval-region-and-go After sending the region, switch-to-lisp.
+;;; c-c c-c lisp-compile-defun      Compile the current defun in Lisp process.
+;;; c-c m-c lisp-compile-defun-and-go After compiling defun, switch-to-lisp.
+;;; c-c c-z switch-to-lisp          Switch to the Lisp process buffer.
+;;; c-c c-l lisp-load-file          (See above. In a Lisp file buffer, default
+;;; c-c c-k lisp-compile-file        is to load/compile the current file.)
+;;; c-c c-d lisp-describe-sym	    Query Lisp for a symbol's description.
+;;; c-c c-a lisp-show-arglist	    Query Lisp for function's arglist.
+;;; c-c c-f lisp-show-function-documentation Query Lisp for a function's doc.
+;;; c-c c-v lisp-show-variable-documentation Query Lisp for a variable's doc.
+
+;;; cmulisp	    	    	    Fires up the Lisp process.
+;;; lisp-compile-region     	    Compile all forms in the current region.
+;;; lisp-compile-region-and-go      After compiling region, switch-to-lisp.
+;;;
+;;; CMU Lisp Mode Variables:
+;;; cmulisp-filter-regexp	    Match this => don't get saved on input hist
+;;; inferior-lisp-program   	    Name of Lisp program run-lisp executes
+;;; inferior-lisp-load-command	    Customises lisp-load-file
+;;; cmulisp-mode-hook  	    
+;;; inferior-lisp-prompt	    Initialises comint-prompt-regexp.
+;;;				    Backwards compatibility.
+;;; lisp-source-modes               Anything loaded into a buffer that's in
+;;;                                 one of these modes is considered Lisp 
+;;;                                 source by lisp-load/compile-file.
+
+;;; Read the rest of this file for more information.
+
+(defvar cmulisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'"
+  "*What not to save on inferior Lisp's input history
+Input matching this regexp is not saved on the input history in cmulisp
+mode. Default is whitespace followed by 0 or 1 single-letter :keyword 
+(as in :a, :c, etc.)")
+
+(defvar cmulisp-mode-map nil)
+(cond ((not cmulisp-mode-map)
+       (setq cmulisp-mode-map
+	     (full-copy-sparse-keymap comint-mode-map))
+       (lisp-mode-commands cmulisp-mode-map)
+       (define-key cmulisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp)
+       (define-key cmulisp-mode-map "\C-c\C-l" 'lisp-load-file)
+       (define-key cmulisp-mode-map "\C-c\C-k" 'lisp-compile-file)
+       (define-key cmulisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
+       (define-key cmulisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
+       (define-key cmulisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
+       (define-key cmulisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)))
+
+;;; These commands augment Lisp mode, so you can process Lisp code in
+;;; the source files.
+(define-key lisp-mode-map "\M-\C-x"  'lisp-eval-defun)     ; Gnu convention
+(define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; Gnu convention
+(define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun)
+(define-key lisp-mode-map "\C-c\M-e" 'lisp-eval-defun-and-go)
+(define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region)
+(define-key lisp-mode-map "\C-c\M-r" 'lisp-eval-region-and-go)
+(define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun)
+(define-key lisp-mode-map "\C-c\M-c" 'lisp-compile-defun-and-go)
+(define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp)
+(define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file)
+(define-key lisp-mode-map "\C-c\C-k" 'lisp-compile-file)  ; "kompile" file
+(define-key lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
+(define-key lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
+(define-key lisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
+(define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)
+
+
+(defvar inferior-lisp-program "lisp"
+  "*Program name for invoking an inferior Lisp with `cmulisp'.")
+
+(defvar inferior-lisp-load-command "(load \"%s\")\n"
+  "*Format-string for building a Lisp expression to load a file.
+This format string should use %s to substitute a file name
+and should result in a Lisp expression that will command the inferior Lisp
+to load that file.  The default works acceptably on most Lisps.
+The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\\n\"
+produces cosmetically superior output for this application,
+but it works only in Common Lisp.")
+
+(defvar inferior-lisp-prompt "^[^> ]*>+:? *"
+  "Regexp to recognise prompts in the inferior Lisp.
+Defaults to \"^[^> ]*>+:? *\", which works pretty good for Lucid, kcl,
+and franz. This variable is used to initialise comint-prompt-regexp in the 
+cmulisp buffer.
+
+More precise choices:
+Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
+franz: \"^\\(->\\|<[0-9]*>:\\) *\"
+kcl: \"^>+ *\"
+
+This is a fine thing to set in your .emacs file.")
+
+(defvar cmulisp-mode-hook '()
+  "*Hook for customising cmulisp mode")
+
+(defun cmulisp-mode () 
+  "Major mode for interacting with an inferior Lisp process.  
+Runs a Lisp interpreter as a subprocess of Emacs, with Lisp I/O through an
+Emacs buffer.  Variable inferior-lisp-program controls which Lisp interpreter
+is run.  Variables inferior-lisp-prompt, cmulisp-filter-regexp and
+inferior-lisp-load-command can customize this mode for different Lisp
+interpreters.
+
+For information on running multiple processes in multiple buffers, see
+documentation for variable cmulisp-buffer.
+
+\\{cmulisp-mode-map}
+
+Customisation: Entry to this mode runs the hooks on comint-mode-hook and
+cmulisp-mode-hook (in that order).
+
+You can send text to the inferior Lisp process from other buffers containing
+Lisp source.  
+    switch-to-lisp switches the current buffer to the Lisp process buffer.
+    lisp-eval-defun sends the current defun to the Lisp process.
+    lisp-compile-defun compiles the current defun.
+    lisp-eval-region sends the current region to the Lisp process.
+    lisp-compile-region compiles the current region.
+
+    lisp-eval-defun-and-go, lisp-compile-defun-and-go,
+        lisp-eval-region-and-go, and lisp-compile-region-and-go
+        switch to the Lisp process buffer after sending their text.
+
+Commands:
+Return after the end of the process' output sends the text from the 
+    end of process to point.
+Return before the end of the process' output copies the sexp ending at point
+    to the end of the process' output, and sends it.
+Delete converts tabs to spaces as it moves back.
+Tab indents for Lisp; with argument, shifts rest
+    of expression rigidly with the current line.
+C-M-q does Tab on each line starting within following expression.
+Paragraphs are separated only by blank lines.  Semicolons start comments.
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it."
+  (interactive)
+  (comint-mode)
+  (setq comint-prompt-regexp inferior-lisp-prompt)
+  (setq major-mode 'cmulisp-mode)
+  (setq mode-name "CMU Lisp")
+  (setq mode-line-process '(": %s"))
+  (if (string-match "^18.4" emacs-version) ; hack.
+      (lisp-mode-variables)    ; This is right for 18.49  
+      (lisp-mode-variables t)) ; This is right for 18.50
+  (use-local-map cmulisp-mode-map)    ;c-c c-k for "kompile" file
+  (setq comint-get-old-input (function lisp-get-old-input))
+  (setq comint-input-filter (function lisp-input-filter))
+  (setq comint-input-sentinel 'ignore)
+  (run-hooks 'cmulisp-mode-hook))
+
+(defun lisp-get-old-input ()
+  "Snarf the sexp ending at point"
+  (save-excursion
+    (let ((end (point)))
+      (backward-sexp)
+      (buffer-substring (point) end))))
+
+(defun lisp-input-filter (str)
+  "Don't save anything matching cmulisp-filter-regexp"
+  (not (string-match cmulisp-filter-regexp str)))
+
+(defun cmulisp ()
+  "Run an inferior Lisp process, input and output via buffer *cmulisp*.
+If there is a process already running in *cmulisp*, just switch to that buffer.
+Takes the program name from the variable inferior-lisp-program.
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+  (interactive)
+  (cond ((not (comint-check-proc "*cmulisp*"))
+	 (set-buffer (make-comint "cmulisp" inferior-lisp-program))
+	 (cmulisp-mode)))
+  (setq cmulisp-buffer "*cmulisp*")
+  (switch-to-buffer "*cmulisp*"))
+
+(defun lisp-eval-region (start end)
+  "Send the current region to the inferior Lisp process."
+  (interactive "r")
+  (comint-send-region (cmulisp-proc) start end)
+  (comint-send-string (cmulisp-proc) "\n"))
+
+(defun lisp-eval-defun ()
+  "Send the current defun to the inferior Lisp process."
+  (interactive)
+  (save-excursion
+   (end-of-defun)
+   (let ((end (point)))
+     (beginning-of-defun)
+     (lisp-eval-region (point) end))))
+
+(defun lisp-eval-last-sexp ()
+  "Send the previous sexp to the inferior Lisp process."
+  (interactive)
+  (lisp-eval-region (save-excursion (backward-sexp) (point)) (point)))
+
+;;; CommonLisp COMPILE sux. 
+(defun lisp-compile-region (start end)
+  "Compile the current region in the inferior Lisp process."
+  (interactive "r")
+  (comint-send-string (cmulisp-proc)
+    (format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n"
+	    (buffer-substring start end))))
+			 
+(defun lisp-compile-defun ()
+  "Compile the current defun in the inferior Lisp process."
+  (interactive)
+  (save-excursion
+    (end-of-defun)
+    (let ((e (point)))
+      (beginning-of-defun)
+      (lisp-compile-region (point) e))))
+
+(defun switch-to-lisp (eob-p)
+  "Switch to the inferior Lisp process buffer.
+With argument, positions cursor at end of buffer."
+  (interactive "P")
+  (if (get-buffer cmulisp-buffer)
+      (pop-to-buffer cmulisp-buffer)
+      (error "No current process buffer. See variable cmulisp-buffer."))
+  (cond (eob-p
+	 (push-mark)
+	 (goto-char (point-max)))))
+
+(defun lisp-eval-region-and-go (start end)
+  "Send the current region to the inferior Lisp, 
+and switch to the process buffer."
+  (interactive "r")
+  (lisp-eval-region start end)
+  (switch-to-lisp t))
+
+(defun lisp-eval-defun-and-go ()
+  "Send the current defun to the inferior Lisp, 
+and switch to the process buffer."
+  (interactive)
+  (lisp-eval-defun)
+  (switch-to-lisp t))
+
+(defun lisp-compile-region-and-go (start end)
+  "Compile the current region in the inferior Lisp, 
+and switch to the process buffer."
+  (interactive "r")
+  (lisp-compile-region start end)
+  (switch-to-lisp t))
+
+(defun lisp-compile-defun-and-go ()
+  "Compile the current defun in the inferior Lisp, 
+and switch to the process buffer."
+  (interactive)
+  (lisp-compile-defun)
+  (switch-to-lisp t))
+
+;;; A version of the form in H. Shevis' soar-mode.el package. Less robust.
+;(defun lisp-compile-sexp (start end)
+;  "Compile the s-expression bounded by START and END in the inferior lisp.
+;If the sexp isn't a DEFUN form, it is evaluated instead."
+;    (cond ((looking-at "(defun\\s +")
+;	   (goto-char (match-end 0))
+;	   (let ((name-start (point)))
+;	     (forward-sexp 1)
+;	     (process-send-string "cmulisp" (format "(compile '%s #'(lambda "
+;						 (buffer-substring name-start
+;								   (point)))))
+;	   (let ((body-start (point)))
+;	     (goto-char start) (forward-sexp 1) ; Can't use end-of-defun.
+;	     (process-send-region "cmulisp" (buffer-substring body-start (point))))
+;	   (process-send-string "cmulisp" ")\n"))
+;	  (t (lisp-eval-region start end)))))
+;
+;(defun lisp-compile-region (start end)
+;  "Each s-expression in the current region is compiled (if a DEFUN)
+;or evaluated (if not) in the inferior lisp."
+;  (interactive "r")
+;  (save-excursion
+;    (goto-char start) (end-of-defun) (beginning-of-defun) ; error check
+;    (if (< (point) start) (error "region begins in middle of defun"))
+;    (goto-char start)
+;    (let ((s start))
+;      (end-of-defun)
+;      (while (<= (point) end) ; Zip through
+;	(lisp-compile-sexp s (point)) ; compiling up defun-sized chunks.
+;	(setq s (point))
+;	(end-of-defun))
+;      (if (< s end) (lisp-compile-sexp s end)))))
+;;;
+;;; End of HS-style code
+
+
+(defvar lisp-prev-l/c-dir/file nil
+  "Saves the (directory . file) pair used in the last lisp-load-file or
+lisp-compile-file command. Used for determining the default in the 
+next one.")
+
+(defvar lisp-source-modes '(lisp-mode)
+  "*Used to determine if a buffer contains Lisp source code.
+If it's loaded into a buffer that is in one of these major modes, it's
+considered a Lisp source file by lisp-load-file and lisp-compile-file.
+Used by these commands to determine defaults.")
+
+(defun lisp-load-file (file-name)
+  "Load a Lisp file into the inferior Lisp process."
+  (interactive (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file
+				  lisp-source-modes nil)) ; NIL because LOAD
+                                                   ; doesn't need an exact name
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
+				     (file-name-nondirectory file-name)))
+  (comint-send-string (cmulisp-proc)
+		      (format inferior-lisp-load-command file-name)))
+
+
+(defun lisp-compile-file (file-name)
+  "Compile a Lisp file in the inferior Lisp process."
+  (interactive (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file
+				  lisp-source-modes nil)) ; NIL = don't need
+                                                          ; suffix .lisp
+  (comint-check-source file-name) ; Check to see if buffer needs saved.
+  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
+				     (file-name-nondirectory file-name)))
+  (comint-send-string (cmulisp-proc) (concat "(compile-file \""
+					     file-name
+					     "\"\)\n")))
+
+
+
+;;; Documentation functions: function doc, var doc, arglist, and
+;;; describe symbol.
+;;; ===========================================================================
+
+;;; Command strings
+;;; ===============
+
+(defvar lisp-function-doc-command
+  "(let ((fn '%s))
+     (format t \"Documentation for ~a:~&~a\"
+	     fn (documentation fn 'function))
+     (values))\n"
+  "Command to query inferior Lisp for a function's documentation.")
+
+(defvar lisp-var-doc-command
+  "(let ((v '%s))
+     (format t \"Documentation for ~a:~&~a\"
+	     v (documentation v 'variable))
+     (values))\n"
+  "Command to query inferior Lisp for a variable's documentation.")
+
+(defvar lisp-arglist-command
+  "(let ((fn '%s))
+     (format t \"Arglist for ~a: ~a\" fn (arglist fn))
+     (values))\n"
+  "Command to query inferior Lisp for a function's arglist.")
+
+(defvar lisp-describe-sym-command
+  "(describe '%s)\n"
+  "Command to query inferior Lisp for a variable's documentation.")
+
+
+;;; Ancillary functions
+;;; ===================
+
+;;; Reads a string from the user.
+(defun lisp-symprompt (prompt default)
+  (list (let* ((prompt (if default
+			   (format "%s (default %s): " prompt default)
+			   (concat prompt ": ")))
+	       (ans (read-string prompt)))
+	  (if (zerop (length ans)) default ans))))
+
+
+;;; Adapted from function-called-at-point in help.el.
+(defun lisp-fn-called-at-pt ()
+  "Returns the name of the function called in the current call.
+Nil if it can't find one."
+  (condition-case nil
+      (save-excursion
+	(save-restriction
+	  (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
+	  (backward-up-list 1)
+	  (forward-char 1)
+	  (let ((obj (read (current-buffer))))
+	    (and (symbolp obj) obj))))
+    (error nil)))
+
+
+;;; Adapted from variable-at-point in help.el.
+(defun lisp-var-at-pt ()
+  (condition-case ()
+      (save-excursion
+	(forward-sexp -1)
+	(skip-chars-forward "'")
+	(let ((obj (read (current-buffer))))
+	  (and (symbolp obj) obj)))
+    (error nil)))
+
+
+;;; Documentation functions: fn and var doc, arglist, and symbol describe.
+;;; ======================================================================
+
+(defun lisp-show-function-documentation (fn)
+  "Send a command to the inferior Lisp to give documentation for function FN.
+See variable lisp-function-doc-command."
+  (interactive (lisp-symprompt "Function doc" (lisp-fn-called-at-pt)))
+  (comint-proc-query (cmulisp-proc) (format lisp-function-doc-command fn)))
+
+(defun lisp-show-variable-documentation (var)
+  "Send a command to the inferior Lisp to give documentation for function FN.
+See variable lisp-var-doc-command."
+  (interactive (lisp-symprompt "Variable doc" (lisp-var-at-pt)))
+  (comint-proc-query (cmulisp-proc) (format lisp-var-doc-command var)))
+
+(defun lisp-show-arglist (fn)
+  "Sends an query to the inferior Lisp for the arglist for function FN.
+See variable lisp-arglist-command."
+  (interactive (lisp-symprompt "Arglist" (lisp-fn-called-at-pt)))
+  (comint-proc-query (cmulisp-proc) (format lisp-arglist-command fn)))
+
+(defun lisp-describe-sym (sym)
+  "Send a command to the inferior Lisp to describe symbol SYM.
+See variable lisp-describe-sym-command."
+  (interactive (lisp-symprompt "Describe" (lisp-var-at-pt)))
+  (comint-proc-query (cmulisp-proc) (format lisp-describe-sym-command sym)))
+
+
+(defvar cmulisp-buffer nil "*The current cmulisp process buffer.
+
+MULTIPLE PROCESS SUPPORT
+===========================================================================
+Cmulisp.el supports, in a fairly simple fashion, running multiple Lisp
+processes. To run multiple Lisp processes, you start the first up with
+\\[cmulisp]. It will be in a buffer named *cmulisp*. Rename this buffer
+with \\[rename-buffer]. You may now start up a new process with another
+\\[cmulisp]. It will be in a new buffer, named *cmulisp*. You can
+switch between the different process buffers with \\[switch-to-buffer].
+
+Commands that send text from source buffers to Lisp processes --
+like lisp-eval-defun or lisp-show-arglist -- have to choose a process
+to send to, when you have more than one Lisp process around. This
+is determined by the global variable cmulisp-buffer. Suppose you
+have three inferior lisps running:
+    Buffer	Process
+    foo		cmulisp
+    bar		cmulisp<2>
+    *cmulisp*   cmulisp<3>
+If you do a \\[lisp-eval-defun-and-go] command on some Lisp source code, 
+what process do you send it to?
+
+- If you're in a process buffer (foo, bar, or *cmulisp*), 
+  you send it to that process.
+- If you're in some other buffer (e.g., a source file), you
+  send it to the process attached to buffer cmulisp-buffer.
+This process selection is performed by function cmulisp-proc.
+
+Whenever \\[cmulisp] fires up a new process, it resets cmulisp-buffer
+to be the new process's buffer. If you only run one process, this will
+do the right thing. If you run multiple processes, you can change
+cmulisp-buffer to another process buffer with \\[set-variable].
+
+More sophisticated approaches are, of course, possible. If you find youself
+needing to switch back and forth between multiple processes frequently,
+you may wish to consider ilisp.el, a larger, more sophisticated package
+for running inferior Lisp processes. The approach taken here is for a
+minimal, simple implementation. Feel free to extend it.")
+
+(defun cmulisp-proc ()
+  "Returns the current cmulisp process. See variable cmulisp-buffer."
+  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lisp-mode)
+				      (current-buffer)
+				      cmulisp-buffer))))
+    (or proc
+	(error "No current process. See variable cmulisp-buffer"))))
+
+
+;;; Do the user's customisation...
+;;;===============================
+(defvar cmulisp-load-hook nil
+  "This hook is run when cmulisp is loaded in.
+This is a good place to put keybindings.")
+	
+(run-hooks 'cmulisp-load-hook)
+
+;;; CHANGE LOG
+;;; ===========================================================================
+;;; 5/24/90 Olin
+;;; - Split cmulisp and cmushell modes into separate files. 
+;;;   Not only is this a good idea, it's apparently the way it'll be rel 19.
+;;; - Upgraded process sends to use comint-send-string instead of
+;;;   process-send-string.
+;;; - Explicit references to process "cmulisp" have been replaced with
+;;;   (cmulisp-proc). This allows better handling of multiple process bufs.
+;;; - Added process query and var/function/symbol documentation
+;;;   commands. Based on code written by Douglas Roberts.
+;;; - Added lisp-eval-last-sexp, bound to C-x C-e.
+;;;
+;;; 9/20/90 Olin
+;;; Added a save-restriction to lisp-fn-called-at-pt. This bug and fix
+;;; reported by Lennart Staflin.
+;;;
+;;; 3/12/90 Olin
+;;; - lisp-load-file and lisp-compile-file no longer switch-to-lisp.
+;;;   Tale suggested this.