Initial revision

3 files changed, 1574 insertions, 0 deletions

diff --git a/lisp/comint.el b/lisp/comint.el
new file mode 100644
index 00000000000..0a81e2f5f1a
--- /dev/null
+++ b/lisp/comint.el
@@ -0,0 +1,866 @@
+;;; -*-Emacs-Lisp-*- General command interpreter in a window stuff
+;;; Copyright (C) 1989 Free Software Foundation, Inc.
+;;; Original author: Olin Shivers <olin.shivers@cs.cmu.edu>  Aug 1988
+
+;;; This file is part of GNU Emacs.
+
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
+
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; This file defines a general command-interpreter-in-a-buffer package
+;;; (comint mode). The idea is that you can build specific process-in-a-buffer
+;;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, ....
+;;; This way, all these specific packages share a common base functionality, 
+;;; and a common set of bindings, which makes them easier to use (and
+;;; saves code, implementation time, etc., etc.).
+
+;;; For documentation on the functionality provided by comint mode, and
+;;; the hooks available for customising it, see the comments below.
+;;; For further information on the standard derived modes (shell, 
+;;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
+
+;;; For hints on converting existing process modes to use comint-mode
+;;; instead of shell-mode, see the notes at the end of this file.
+
+(require 'history)
+(provide 'comint)
+(defconst comint-version "2.01")
+
+
+;;; Not bound by default in comint-mode
+;;; send-invisible                      Read a line w/o echo, and send to proc
+;;; (These are bound in shell-mode)
+;;; comint-dynamic-complete             Complete filename at point.
+;;; comint-dynamic-list-completions     List completions in help buffer.
+;;; comint-replace-by-expanded-filename Expand and complete filename at point;
+;;;                                     replace with expanded/completed name.
+(defvar comint-mode-map nil)
+
+(if comint-mode-map
+    nil
+  (setq comint-mode-map (make-sparse-keymap))
+  (define-key comint-mode-map "\C-a" 'comint-bol)
+  (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
+  (define-key comint-mode-map "\C-m" 'comint-send-input)
+  (define-key comint-mode-map "\M-p" 'comint-previous-input)
+  (define-key comint-mode-map "\M-n" 'comint-next-input)
+  (define-key comint-mode-map "\M-s" 'comint-previous-similar-input)
+  (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob) ; tty ^C
+  (define-key comint-mode-map "\C-c\C-f" 'comint-continue-subjob)  ; shell "fg"
+  (define-key comint-mode-map "\C-c\C-l" 'comint-show-output)
+  (define-key comint-mode-map "\C-c\C-o" 'comint-flush-output)     ; tty ^O
+  (define-key comint-mode-map "\C-c\C-r" 'comint-history-search-backward)
+  (define-key comint-mode-map "\C-c\C-s" 'comint-history-search-forward)
+  (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)       ; tty ^U
+  (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)      ; tty ^W
+  (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)      ; tty ^Z
+  (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob))    ; tty ^\
+
+;;; Buffer Local Variables:
+;;;============================================================================
+;;; Comint mode buffer local variables:
+;;;     comint-prompt-regexp    - string       comint-bol uses to match prompt.
+;;;     comint-last-input-end   - marker       For comint-flush-output command
+;;;     input-ring-size         - integer      For the input history
+;;;     input-ring              - ring             mechanism
+;;;     input-ring-index        - marker           ...
+;;;     comint-last-input-match - string           ...
+;;;     comint-get-old-input    - function     Hooks for specific 
+;;;     comint-input-sentinel   - function         process-in-a-buffer
+;;;     comint-input-filter     - function         modes.
+;;;     comint-input-send       - function
+;;;     comint-eol-on-send      - boolean
+
+(make-variable-buffer-local
+ (defvar comint-prompt-regexp "^"
+  "*Regexp to recognise prompts in the inferior process.  Defaults to \"^\".
+
+Good choices:
+  Canonical Lisp: \"^[^> \n]*>+:? *\" (Lucid, Franz, KCL, T, cscheme, oaklisp)
+  Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
+  Franz: \"^\\(->\\|<[0-9]*>:\\) *\"
+  KCL and T: \"^>+ *\"
+  shell: \"^[^#$%>\n]*[#$%>] *\"
+
+This is a good thing to set in mode hooks."))
+
+(make-variable-buffer-local
+ (defvar input-ring-size 30 "Size of input history ring."))
+
+;;; Here are the per-interpreter hooks.
+(make-variable-buffer-local
+ (defvar comint-get-old-input (function comint-get-old-input-default)
+   "Function that submits old text in comint mode.
+This function is called when return is typed while the point is in old text.
+It returns the text to be submitted as process input.  The default is
+comint-get-old-input-default, which grabs the current line, and strips off
+leading text matching comint-prompt-regexp."))
+
+(make-variable-buffer-local
+ (defvar comint-input-sentinel (function ignore)
+   "Called on each input submitted to comint mode process by comint-send-input.
+Thus it can, for instance, track cd/pushd/popd commands issued to the csh."))
+
+(make-variable-buffer-local
+ (defvar comint-input-filter
+   (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
+   "Predicate for filtering additions to input history.
+Only inputs answering true to this function are saved on the input
+history list. Default is to save anything that isn't all whitespace"))
+
+(defvar comint-mode-hook '()
+  "Called upon entry into comint-mode")
+
+(defun comint-mode ()
+  "Major mode for interacting with an inferior interpreter.
+Interpreter name is same as buffer name, sans the asterisks.
+Return at end of buffer sends line as input.
+Return not at end copies rest of line to end and sends it.
+
+This mode is typically customised to create inferior-lisp-mode,
+shell-mode, et cetera.  This can be done by setting the hooks
+comint-input-sentinel, comint-input-filter, and comint-get-old-input
+to appropriate functions, and the variable comint-prompt-regexp
+to the appropriate regular expression.
+
+An input history is maintained of size input-ring-size, and
+can be accessed with the commands comint-next-input [\\[comint-next-input]] and 
+comint-previous-input [\\[comint-previous-input]]. Commands not keybound by
+default are send-invisible, comint-dynamic-complete, and 
+comint-list-dynamic-completions.
+
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it.
+
+\\{comint-mode-map}
+
+Entry to this mode runs the hooks on comint-mode-hook."
+  (interactive)
+  (make-local-variable 'input-ring)
+  (put 'input-ring 'preserved t)
+  (kill-all-local-variables)
+  (setq major-mode 'comint-mode
+        mode-name "Comint"
+        mode-line-process '(": %s"))
+  (use-local-map comint-mode-map)
+  (set (make-local-variable 'comint-last-input-match) "")
+  (set (make-local-variable 'comint-last-similar--string) "")
+  (set (make-local-variable 'input-ring-index) 0)
+  (set (make-local-variable 'comint-last-input-end) (make-marker))
+  (set-marker comint-last-input-end (point-max))
+  (run-hooks 'comint-mode-hook))
+
+(defun comint-check-proc (buffer-name)
+  "True if there is a running or stopped process associated with BUFFER."
+  (let ((proc (get-buffer-process buffer-name)))
+    (and proc (memq (process-status proc) '(run stop)))))
+
+(defun comint-mark ()
+  ;; Returns the process-mark of the current-buffer
+  (process-mark (get-buffer-process (current-buffer))))
+
+;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
+;;; for the second argument (program).
+(defun make-comint (name program &optional startfile &rest switches)
+  (let* ((buffer (get-buffer-create (concat "*" name "*")))
+         (proc (get-buffer-process buffer)))
+    ;; If no process, or nuked process, crank up a new one and put buffer in
+    ;; comint mode. Otherwise, leave buffer and existing process alone.
+    (cond ((not (comint-check-proc))
+           (save-excursion
+             (set-buffer buffer)
+             (comint-mode)) ; Install local vars, mode, keymap, ...
+           (comint-exec buffer name program startfile switches)))
+    buffer))
+
+(defun comint-exec (buffer name command startfile switches)
+  "Fires up a process in buffer for comint modes.
+Blasts any old process running in the buffer.  Doesn't set the buffer mode.
+You can use this to cheaply run a series of processes in the same buffer."
+  (or command (error "No program for comint process"))
+  (save-excursion
+    (set-buffer buffer)
+    (let ((proc (get-buffer-process buffer)))   ; Blast any old process.
+      (if proc (delete-process proc)))
+    ;; Crank up a new process
+    (let ((proc (comint-exec-1 name buffer command switches)))
+      ;; Jump to the end, and set the process mark.
+      (set-marker (comint-mark) (goto-char (point-max)))
+      ;; Feed it the startfile.
+      (cond (startfile
+             ;;This is guaranteed to wait long enough
+             ;;but has bad results if the comint does not prompt at all
+             ;;      (while (= size (buffer-size))
+             ;;        (sleep-for 1))
+             ;;I hope 1 second is enough!
+             (sleep-for 1)
+             (goto-char (point-max))
+             (insert-file-contents startfile)
+             (setq startfile (buffer-substring (point) (point-max)))
+             (delete-region (point) (point-max))
+             (comint-send-string proc startfile)))
+    buffer))
+
+;;; This auxiliary function cranks up the process for comint-exec in
+;;; the appropriate environment. It is twice as long as it should be
+;;; because emacs has two distinct mechanisms for manipulating the
+;;; process environment, selected at compile time with the
+;;; MAINTAIN-ENVIRONMENT #define. In one case, process-environment
+;;; is bound; in the other it isn't.
+
+(defun comint-exec-1 (name buffer command switches)
+  (if (boundp 'process-environment) ; Not a completely reliable test.
+      (let ((process-environment
+             (comint-update-env process-environment
+                                (list (format "TERMCAP=emacs:co#%d:tc=unknown"
+                                              (screen-width))
+                                      "TERM=emacs"
+                                      "EMACS=t"))))
+        (apply 'start-process name buffer command switches))
+      (let ((tcapv (getenv "TERMCAP"))
+            (termv (getenv "TERM"))
+            (emv   (getenv "EMACS")))
+        (unwind-protect
+             (progn (setenv "TERMCAP" (format "emacs:co#%d:tc=unknown"
+                                              (screen-width)))
+                    (setenv "TERM" "emacs")
+                    (setenv "EMACS" "t")
+                    (apply 'start-process name buffer command switches))
+          (setenv "TERMCAP" tcapv)
+          (setenv "TERM"    termv)
+          (setenv "EMACS"   emv)))))
+
+;; This is just (append new old-env) that compresses out shadowed entries.
+;; It's also pretty ugly, mostly due to elisp's horrible iteration structures.
+(defun comint-update-env (old-env new)
+  (let ((ans (reverse new))
+        (vars (mapcar (function (lambda (vv)
+                        (and (string-match "^[^=]*=" vv)
+                             (substring vv 0 (match-end 0)))))
+                      new)))
+    (while old-env
+      (let* ((vv (car old-env)) ; vv is var=value
+             (var (and (string-match "^[^=]*=" vv)
+                       (substring vv 0 (match-end 0)))))
+        (setq old-env (cdr old-env))
+        (cond ((not (and var (member var vars)))
+               (if var (setq var (cons var vars)))
+               (setq ans (cons vv ans))))))
+    (nreverse ans)))
+
+;;; Input history retrieval commands
+;;; M-p -- previous input    M-n -- next input
+;;; C-c r -- previous input matching
+;;; ===========================================================================
+
+(defun comint-previous-input (arg)
+  "Cycle backwards through input history."
+  (interactive "*p")
+  (let ((len (ring-length input-ring)))
+    (if (<= len 0) (error "Empty input ring"))
+    (if (< (point) (comint-mark))
+        (delete-region (comint-mark) (goto-char (point-max))))
+    (cond ((eq last-command 'comint-previous-input)
+           (delete-region (mark) (point)))
+          ((eq last-command 'comint-previous-similar-input)
+           (delete-region (comint-mark) (point)))
+          (t                          
+           (setq input-ring-index
+                 (if (> arg 0) -1
+                   (if (< arg 0) 1 0)))
+           (push-mark (point))))
+    (setq input-ring-index (comint-mod (+ input-ring-index arg) len))
+    (message "%d" (1+ input-ring-index))
+    (insert (ring-ref input-ring input-ring-index))
+    (setq this-command 'comint-previous-input)))
+
+(defun comint-next-input (arg)
+  "Cycle forwards through input history."
+  (interactive "*p")
+  (comint-previous-input (- arg)))
+
+(defun comint-previous-input-matching (str)
+  "Searches backwards through input history for substring match."
+  (interactive (let* ((last-command last-command) ; preserve around r-f-m
+                      (s (read-from-minibuffer 
+                         (format "Command substring (default %s): "
+                                 comint-last-input-match))))
+                 (list (if (string= s "") comint-last-input-match s))))
+; (interactive "sCommand substring: ")
+  (setq comint-last-input-match str) ; update default
+  (if (not (eq last-command 'comint-previous-input))
+      (setq input-ring-index -1))
+  (let ((str (regexp-quote str))
+        (len (ring-length input-ring))
+        (n (+ input-ring-index 1)))
+    (while (and (< n len) (not (string-match str (ring-ref input-ring n))))
+      (setq n (+ n 1)))
+    (cond ((< n len)
+           (comint-previous-input (- n input-ring-index)))
+          (t (if (eq last-command 'comint-previous-input) 
+                 (setq this-command 'comint-previous-input))
+             (error "Not found")))))
+
+;;;
+;;; Similar input -- contributed by ccm and highly winning.
+;;;
+;;; Reenter input, removing back to the last insert point if it exists. 
+;;;
+(defun comint-previous-similar-input (arg)
+  "Reenters the last input that matches the string typed so far.  If repeated 
+successively older inputs are reentered.  If arg is 1, it will go back
+in the history, if -1 it will go forward."
+  (interactive "p")
+  (if (< (point) (comint-mark))
+      (error "Not after process mark"))
+  (if (not (eq last-command 'comint-previous-similar-input))
+      (setq input-ring-index -1
+            comint-last-similar-string
+            (buffer-substring (comint-mark) (point))))
+  (let* ((size (length comint-last-similar-string))
+         (len (ring-length input-ring))
+         (n (+ input-ring-index arg))
+         entry)
+    (while (and (< n len) 
+                (or (< (length (setq entry (ring-ref input-ring n))) size)
+                    (not (equal comint-last-similar-string 
+                                (substring entry 0 size)))))
+      (setq n (+ n arg)))
+    (cond ((< n len)
+           (setq input-ring-index n)
+           (if (eq last-command 'comint-previous-similar-input)
+               (delete-region (comint-mark) (point)))
+           (insert (substring entry size)))
+          (t (error "Not found")))))
+
+(defun comint-send-input (&optional terminator delete)
+  "Send input to process, followed by a linefeed or optional TERMINATOR.
+After the process output mark, sends all text from the process mark to
+end of buffer as input to the process.  Before the process output mark, calls
+value of variable comint-get-old-input to retrieve old input, replaces it in
+the input region (from the end of process output to the end of the buffer) and
+then sends it.  In either case, the value of variable comint-input-sentinel is
+called on the input before sending it.  The input is entered into the input
+history ring, if value of variable comint-input-filter returns non-nil when
+called on the input.
+
+If optional second argument DELETE is non-nil, then the input is deleted from
+the end of the buffer.  This is useful if the process unconditionally echoes
+input.  Processes which use TERMINATOR or DELETE should have a command wrapper
+which provides them bound to RET; see telnet.el for an example.
+
+comint-get-old-input, comint-input-sentinel, and comint-input-filter are chosen
+according to the command interpreter running in the buffer.  For example,
+
+If the interpreter is the csh,
+ comint-get-old-input defaults:  takes the current line, discard any
+   initial string matching regexp comint-prompt-regexp.
+ comint-input-sentinel:  monitors input for \"cd\", \"pushd\", and \"popd\" 
+   commands.  When it sees one, it changes the default directory of the buffer.
+ comint-input-filter defaults:  returns t if the input isn't all whitespace.
+
+If the comint is Lucid Common Lisp, 
+ comint-get-old-input:  snarfs the sexp ending at point.
+ comint-input-sentinel:  does nothing.
+ comint-input-filter:  returns nil if the input matches input-filter-regexp,
+        which matches (1) all whitespace (2) :a, :c, etc.
+
+Similar functions are used for other process modes."
+  (interactive)
+  ;; Note that the input string does not include its terminal newline.
+  (if (not (get-buffer-process (current-buffer)))
+      (error "Current buffer has no process")
+    (let* ((pmark (comint-mark))
+           (input (if (>= (point) pmark)
+                      (buffer-substring pmark (goto-char (point-max)))
+                    (let ((copy (funcall comint-get-old-input)))
+                      (delete-region pmark (goto-char (point-max)))
+                      (insert copy)
+                      copy))))
+      (set-marker comint-last-input-end (point))
+      (setq input-ring-index 0)
+      (if (funcall comint-input-filter input) (ring-insert input-ring input))
+      (funcall comint-input-sentinel input)
+      (comint-send-string nil (concat input (or terminator "\n")))
+      (if delete (delete-region mark (point))
+        (insert "\n"))
+      (set-marker (comint-mark) (point)))))
+
+(defun comint-get-old-input-default ()
+  "Default for comint-get-old-input:  use the current line sans prompt."
+  (save-excursion
+    (comint-bol)
+    (buffer-substring (point) (progn (end-of-line) (point)))))
+
+(defun comint-bol (arg)
+  "Goes to the beginning of line, then skips past the prompt, if any.
+With a prefix argument, (\\[universal-argument]), then doesn't skip prompt.
+
+The prompt skip is done by passing over text matching the regular expression
+comint-prompt-regexp, a buffer local variable."
+  (interactive "P")
+  (beginning-of-line)
+  (or arg (if (looking-at comint-prompt-regexp) (goto-char (match-end 0)))))
+
+;;; These two functions are for entering text you don't want echoed or
+;;; saved -- typically passwords to ftp, telnet, or somesuch.
+;;; Just enter M-x send-invisible and type in your line.
+(defun comint-read-noecho (prompt)
+  "Prompting with PROMPT, read a single line of text without echoing.
+The text can still be recovered (temporarily) with \\[view-lossage].  This
+may be a security bug for some applications."
+  (let ((echo-keystrokes 0)
+        (answ "")
+        tem)
+    (if (and (stringp prompt) (not (string= (message prompt) "")))
+        (message prompt))
+    (while (not (or (= (setq tem (read-char)) ?\^m)
+                    (= tem ?\n)))
+      (setq answ (concat answ (char-to-string tem))))
+    (message "")
+    answ))
+
+(defun send-invisible (str)
+  "Read a string without echoing, and send it to the current buffer's process.
+A newline is also sent.  String is not saved on comint input history list.
+Security bug: your string can still be temporarily recovered with \\[view-lossage]."
+; (interactive (list (comint-read-noecho "Enter non-echoed text")))
+  (interactive "P") ; Defeat snooping via C-x esc
+  (let ((proc (get-buffer-process (current-buffer))))
+    (if (not proc) (error "Current buffer has no process")
+        (comint-send-string proc
+                            (if (stringp str) str
+                                (comint-read-noecho "Enter non-echoed text")))
+        (comint-send-string proc "\n"))))
+
+
+;;; Low-level process communication
+
+(defvar comint-input-chunk-size 512
+  "*Long inputs send to comint processes are broken up into chunks of this size.
+If your process is choking on big inputs, try lowering the value.")
+
+(defun comint-send-string (proc str)
+  "Send PROCESS the contents of STRING as input.
+This is equivalent to process-send-string, except that long input strings
+are broken up into chunks of size comint-input-chunk-size. Processes
+are given a chance to output between chunks. This can help prevent processes
+from hanging when you send them long inputs on some OS's."
+  (let* ((len (length str))
+         (i (min len comint-input-chunk-size)))
+    (process-send-string proc (substring str 0 i))
+    (while (< i len)
+      (let ((next-i (+ i comint-input-chunk-size)))
+        (accept-process-output)
+        (process-send-string proc (substring str i (min len next-i)))
+        (setq i next-i)))))
+
+(defun comint-send-region (proc start end)
+  "Sends to PROC the region delimited by START and END.
+This is a replacement for process-send-region that tries to keep
+your process from hanging on long inputs. See comint-send-string."
+  (comint-send-string proc (buffer-substring start end)))
+
+
+;;; Random input hackage
+
+(defun comint-flush-output ()
+  "Kill all output from interpreter since last input."
+  (interactive)
+  (save-excursion
+    (goto-char (comint-mark))
+    (beginning-of-line)
+    (delete-region (1+ comint-last-input-end) (point))
+    (insert "*** output flushed ***\n")))
+
+(defun comint-show-output ()
+  "Start display of the current window at line preceding start of last output.
+\"Last output\" is considered to start at the line following the last command
+entered to the process."
+  (interactive)
+  (goto-char comint-last-input-end)
+  (beginning-of-line)
+  (set-window-start (selected-window) (point))
+  (comint-bol))
+
+(defun comint-interrupt-subjob ()
+  "Sent an interrupt signal to the current subprocess.
+If the process-connection-type is via ptys, the signal is sent to the current
+process group of the pseudoterminal which Emacs is using to communicate with
+the subprocess.  If the process is a job-control shell, this means the
+shell's current subjob.  If the process connection is via pipes, the signal is
+sent to the immediate subprocess."
+  (interactive)
+  (interrupt-process nil t))
+
+(defun comint-kill-subjob ()
+  "Send a kill signal to the current subprocess.
+See comint-interrupt-subjob for a description of \"current subprocess\"."
+  (interactive)
+  (kill-process nil t))
+
+(defun comint-quit-subjob ()
+  "Send a quit signal to the current subprocess.
+See comint-interrupt-subjob for a description of \"current subprocess\"."
+  (interactive)
+  (quit-process nil t))
+
+(defun comint-stop-subjob ()
+  "Stop the current subprocess.
+See comint-interrupt-subjob for a description of \"current subprocess\".
+
+WARNING: if there is no current subjob, you can end up suspending
+the top-level process running in the buffer.  If you accidentally do
+this, use \\[comint-continue-subjob] to resume the process.   (This is not a
+problem with most shells, since they ignore this signal.)"
+  (interactive)
+  (stop-process nil t))
+
+(defun comint-continue-subjob ()
+  "Send a continue signal to current subprocess.
+See comint-interrupt-subjob for a description of \"current subprocess\".
+Useful if you accidentally suspend the top-level process."
+  (interactive)
+  (continue-process nil t))
+
+(defun comint-kill-input ()
+  "Kill from current command through point."
+  (interactive)
+  (let ((pmark (comint-mark)))
+    (if (> (point) pmark)
+        (kill-region pmark (point))
+      (error "Nothing to kill"))))
+
+(defun comint-delchar-or-maybe-eof (arg)
+  "Delete ARG characters forward, or send an EOF to process if at end of buffer."
+  (interactive "p")
+  (if (eobp)
+      (process-send-eof)
+    (delete-char arg)))
+
+;;; Support for source-file processing commands.
+;;;============================================================================
+;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
+;;; commands that process files of source text (e.g. loading or compiling
+;;; files). So the corresponding process-in-a-buffer modes have commands
+;;; for doing this (e.g., lisp-load-file). The functions below are useful
+;;; for defining these commands.
+;;;
+;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
+;;; and Soar, in that they don't know anything about file extensions.
+;;; So the compile/load interface gets the wrong default occasionally.
+;;; The load-file/compile-file default mechanism could be smarter -- it
+;;; doesn't know about the relationship between filename extensions and
+;;; whether the file is source or executable. If you compile foo.lisp
+;;; with compile-file, then the next load-file should use foo.bin for
+;;; the default, not foo.lisp. This is tricky to do right, particularly
+;;; because the extension for executable files varies so much (.o, .bin,
+;;; .lbin, .mo, .vo, .ao, ...).
+
+
+;;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing
+;;; commands.
+;;;
+;;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
+;;; want to save the buffer before issuing any process requests to the command
+;;; interpreter.
+;;;
+;;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt
+;;; for the file to process.
+
+;;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes)
+;;;============================================================================
+;;; This function computes the defaults for the load-file and compile-file
+;;; commands for tea, soar, lisp, and scheme modes. 
+;;; 
+;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last 
+;;; source-file processing command. NIL if there hasn't been one yet.
+;;; - SOURCE-MODES is a list used to determine what buffers contain source
+;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source.
+;;; Typically, (lisp-mode) or (scheme-mode).
+;;; 
+;;; If the command is given while the cursor is inside a string, *and*
+;;; the string is an existing filename, *and* the filename is not a directory,
+;;; then the string is taken as default. This allows you to just position
+;;; your cursor over a string that's a filename and have it taken as default.
+;;;
+;;; If the command is given in a file buffer whose major mode is in
+;;; SOURCE-MODES, then the the filename is the default file, and the
+;;; file's directory is the default directory.
+;;; 
+;;; If the buffer isn't a source file buffer (e.g., it's the process buffer),
+;;; then the default directory & file are what was used in the last source-file
+;;; processing command (i.e., PREVIOUS-DIR/FILE).  If this is the first time
+;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
+;;; is the cwd, with no default file. (\"no default file\" = nil)
+;;; 
+;;; SOURCE-REGEXP is typically going to be something like (tea-mode)
+;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
+;;; for Soar programs, etc.
+;;; 
+;;; The function returns a pair: (default-directory . default-file).
+
+(defun comint-source-default (previous-dir/file source-modes)
+  (cond ((and buffer-file-name (memq major-mode source-modes))
+         (cons (file-name-directory    buffer-file-name)
+               (file-name-nondirectory buffer-file-name)))
+        (previous-dir/file)
+        (t
+         (cons default-directory nil))))
+
+;;; (COMINT-CHECK-SOURCE fname)
+;;;============================================================================
+;;; Prior to loading or compiling (or otherwise processing) a file (in the
+;;; process-in-a-buffer modes), this function can be called on the filename.
+;;; If the file is loaded into a buffer, and the buffer is modified, the user
+;;; is queried to see if he wants to save the buffer before proceeding with
+;;; the load or compile.
+
+(defun comint-check-source (fname)
+  (let ((buff (get-file-buffer fname)))
+    (if (and buff
+             (buffer-modified-p buff)
+             (y-or-n-p (format "Save buffer %s first? "
+                               (buffer-name buff))))
+        ;; save BUFF.
+        (let ((old-buffer (current-buffer)))
+          (set-buffer buff)
+          (save-buffer)
+          (set-buffer old-buffer)))))
+
+;;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
+;;;============================================================================
+;;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter
+;;; commands that process source files (like loading or compiling a file).
+;;; It prompts for the filename, provides a default, if there is one,
+;;; and returns the result filename.
+;;; 
+;;; See COMINT-SOURCE-DEFAULT for more on determining defaults.
+;;; 
+;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
+;;; from the last source processing command.  SOURCE-MODES is a list of major
+;;; modes used to determine what file buffers contain source files.  (These
+;;; two arguments are used for determining defaults). If MUSTMATCH-P is true,
+;;; then the filename reader will only accept a file that exists.
+;;; 
+;;; A typical use:
+;;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file
+;;;                                 '(lisp-mode) t))
+
+;;; This is pretty stupid about strings. It decides we're in a string
+;;; if there's a quote on both sides of point on the current line.
+(defun comint-extract-string ()
+  "Returns string around point that starts the current line or nil." 
+  (save-excursion
+    (let* ((point (point))
+           (bol (progn (beginning-of-line) (point)))
+           (eol (progn (end-of-line) (point)))
+           (start (progn (goto-char point) 
+                         (and (search-backward "\"" bol t) 
+                              (1+ (point)))))
+           (end (progn (goto-char point)
+                       (and (search-forward "\"" eol t)
+                            (1- (point))))))
+      (and start end
+           (buffer-substring start end)))))
+
+(defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p)
+  (let* ((def (comint-source-default prev-dir/file source-modes))
+         (stringfile (comint-extract-string))
+         (sfile-p (and stringfile
+                       (file-exists-p stringfile)
+                       (not (file-directory-p stringfile))))
+         (defdir  (if sfile-p (file-name-directory stringfile)
+                      (car def)))
+         (deffile (if sfile-p (file-name-nondirectory stringfile)
+                      (cdr def)))
+         (ans (read-file-name (if deffile (format "%s(default %s) "
+                                                  prompt    deffile)
+                                  prompt)
+                              defdir
+                              (concat defdir deffile)
+                              mustmatch-p)))
+    (list (expand-file-name (substitute-in-file-name ans)))))
+
+
+;;; Simple process query facility.
+;;; ===========================================================================
+;;; This function is for commands that want to send a query to the process
+;;; and show the response to the user. For example, a command to get the
+;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
+;;; to an inferior Common Lisp process.
+;;; 
+;;; This simple facility just sends strings to the inferior process and pops
+;;; up a window for the process buffer so you can see what the process
+;;; responds with.  We don't do anything fancy like try to intercept what the
+;;; process responds with and put it in a pop-up window or on the message
+;;; line. We just display the buffer. Low tech. Simple. Works good.
+
+;;; Send to the inferior process PROC the string STR. Pop-up but do not select
+;;; a window for the inferior process so that its response can be seen.
+(defun comint-proc-query (proc str)
+  (let* ((proc-buf (process-buffer proc))
+         (proc-mark (process-mark proc)))
+    (display-buffer proc-buf)
+    (set-buffer proc-buf) ; but it's not the selected *window*
+    (let ((proc-win (get-buffer-window proc-buf))
+          (proc-pt (marker-position proc-mark)))
+      (comint-send-string proc str) ; send the query
+      (accept-process-output proc)  ; wait for some output
+      ;; Try to position the proc window so you can see the answer.
+      ;; This is bogus code. If you delete the (sit-for 0), it breaks.
+      ;; I don't know why. Wizards invited to improve it.
+      (if (not (pos-visible-in-window-p proc-pt proc-win))
+          (let ((opoint (window-point proc-win)))
+            (set-window-point proc-win proc-mark) (sit-for 0)
+            (if (not (pos-visible-in-window-p opoint proc-win))
+                (push-mark opoint)
+                (set-window-point proc-win opoint)))))))
+
+
+;;; Filename completion in a buffer
+;;; ===========================================================================
+;;; Useful completion functions, courtesy of the Ergo group.
+;;; M-<Tab> will complete the filename at the cursor as much as possible
+;;; M-? will display a list of completions in the help buffer.
+
+;;; Three commands:
+;;; comint-dynamic-complete             Complete filename at point.
+;;; comint-dynamic-list-completions     List completions in help buffer.
+;;; comint-replace-by-expanded-filename Expand and complete filename at point;
+;;;                                     replace with expanded/completed name.
+
+;;; These are not installed in the comint-mode keymap. But they are
+;;; available for people who want them.  Shell-mode-map uses them, though.
+
+(defun comint-match-partial-pathname ()
+  "Returns the string of an existing filename or causes an error."
+  (if (save-excursion (backward-char 1) (looking-at "\\s ")) ""
+      (save-excursion
+        (re-search-backward "[^~/A-Za-z0-9---_.$#,]+")
+        (re-search-forward "[~/A-Za-z0-9---_.$#,]+")
+        (substitute-in-file-name 
+         (buffer-substring (match-beginning 0) (match-end 0))))))
+
+(defun comint-replace-by-expanded-filename ()
+  "Replace the filename at point with its expanded, canonicalised completion.
+\"Expanded\" means environment variables (e.g., $HOME) and ~'s are
+replaced with the corresponding directories.  \"Canonicalised\" means ..
+and . are removed, and the filename is made absolute instead of relative.
+See functions expand-file-name and substitute-in-file-name.  See also
+comint-dynamic-complete."
+  (interactive)
+  (let* ((pathname (comint-match-partial-pathname))
+         (pathdir (file-name-directory pathname))
+         (pathnondir (file-name-nondirectory pathname))
+         (completion (file-name-completion pathnondir
+                                           (or pathdir default-directory))))
+    (cond ((null completion)
+           (error "No completions"))
+          ((eql completion t)
+           (message "Sole completion"))
+          (t                            ; this means a string was returned.
+           (delete-region (match-beginning 0) (match-end 0))
+           (insert (expand-file-name (concat pathdir completion)))))))
+
+(defun comint-dynamic-complete ()
+  "Complete the filename at point.
+This function is similar to comint-replace-by-expanded-filename, except
+that it won't change parts of the filename already entered in the buffer; 
+it just adds completion characters to the end of the filename."
+  (interactive)
+  (let* ((pathname (comint-match-partial-pathname))
+         (pathdir (file-name-directory pathname))
+         (pathnondir (file-name-nondirectory pathname))
+         (completion (file-name-completion pathnondir
+                                           (or pathdir default-directory))))
+    (cond ((null completion)
+           (error "No completions"))
+          ((eql completion t)
+           (error "Sole completion"))
+          (t                            ; this means a string was returned.
+           (goto-char (match-end 0))
+           (insert (substring completion (length pathnondir)))))))
+
+(defun comint-dynamic-list-completions ()
+  "List all possible completions of the filename at point."
+  (interactive)
+  (let* ((pathname (comint-match-partial-pathname))
+         (pathdir (file-name-directory pathname))
+         (pathnondir (file-name-nondirectory pathname))
+         (completions
+          (file-name-all-completions pathnondir
+                                     (or pathdir default-directory))))
+    (cond ((null completions)
+           (error "No completions"))
+          (t
+           (let ((conf (current-window-configuration)))
+             (with-output-to-temp-buffer " *Completions*"
+               (display-completion-list completions))
+             (sit-for 0)
+             (message "Hit space to flush.")
+             (let ((ch (read-char)))
+               (if (= ch ?\ )
+                   (set-window-configuration conf)
+                   (setq unread-command-char ch))))))))
+
+
+;;; Converting process modes to use comint mode
+;;; ===========================================================================
+;;; Renaming variables
+;;;   Most of the work is renaming variables and functions.
+;;;   These are the common ones.
+
+;;; Local variables --
+;;;     last-input-end                  comint-last-input-end
+;;;     last-input-start                <unnecessary>
+;;;     shell-prompt-pattern            comint-prompt-regexp
+;;;     shell-set-directory-error-hook  <no equivalent>
+;;; Miscellaneous --
+;;;     shell-set-directory     <unnecessary>
+;;;     shell-mode-map          comint-mode-map
+;;; Commands --
+;;;     shell-send-input        comint-send-input
+;;;     shell-send-eof          comint-delchar-or-maybe-eof
+;;;     kill-shell-input        comint-kill-input
+;;;     interrupt-shell-subjob  comint-interrupt-subjob
+;;;     stop-shell-subjob       comint-stop-subjob
+;;;     quit-shell-subjob       comint-quit-subjob
+;;;     kill-shell-subjob       comint-kill-subjob
+;;;     kill-output-from-shell  comint-kill-output
+;;;     show-output-from-shell  comint-show-output
+;;;     copy-last-shell-input   Use comint-previous-input/comint-next-input
+;;;
+;;; LAST-INPUT-START is no longer necessary because inputs are stored on the
+;;; input history ring. SHELL-SET-DIRECTORY is gone, its functionality taken
+;;; over by SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-sentinel.
+;;; Comint mode does not provide functionality equivalent to 
+;;; shell-set-directory-error-hook; it is gone.
+;;; 
+;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do
+;;; *not* create the comint-mode local variables in your foo-mode function.
+;;; This is not modular.  Instead, call comint-mode, and let *it* create the
+;;; necessary comint-specific local variables. Then create the
+;;; foo-mode-specific local variables in foo-mode.  Set the buffer's keymap to
+;;; be foo-mode-map, and its mode to be foo-mode.  Set the comint-mode hooks
+;;; (comint-prompt-regexp, comint-input-filter, comint-input-sentinel,
+;;; comint-get-old-input) that need to be different from the defaults.  Call
+;;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself;
+;;; comint-mode will take care of it. 
+;;;
+;;; Note that make-comint is different from make-shell in that it
+;;; doesn't have a default program argument. If you give make-shell
+;;; a program name of NIL, it cleverly chooses one of explicit-shell-name,
+;;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument
+;;; of NIL, it barfs. Adjust your code accordingly...
diff --git a/lisp/shell.el b/lisp/shell.el
new file mode 100644
index 00000000000..64c069bf05d
--- /dev/null
+++ b/lisp/shell.el
@@ -0,0 +1,392 @@
+;; -*-Emacs-Lisp-*- run a shell in an Emacs window
+;; Copyright (C) 1985, 1986, 1987, 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.
+
+;;; Hacked from tea.el and shell.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
+
+;;; Since this mode is built on top of the general command-interpreter-in-
+;;; a-buffer mode (comint mode), it shares a common base functionality, 
+;;; and a common set of bindings, with all modes derived from comint mode.
+
+;;; For documentation on the functionality provided by comint mode, and
+;;; the hooks available for customising it, see the file comint.el.
+
+;;; Needs fixin:
+;;; When sending text from a source file to a subprocess, the process-mark can 
+;;; move off the window, so you can lose sight of the process interactions.
+;;; Maybe I should ensure the process mark is in the window when I send
+;;; text to the process? Switch selectable?
+
+(require 'comint)
+(provide 'shell)
+
+(defvar shell-popd-regexp "popd"
+  "*Regexp to match subshell commands equivalent to popd.")
+
+(defvar shell-pushd-regexp "pushd"
+  "*Regexp to match subshell commands equivalent to pushd.")
+
+(defvar shell-cd-regexp "cd"
+  "*Regexp to match subshell commands equivalent to cd.")
+
+(defvar explicit-shell-file-name nil
+  "*If non-nil, is file name to use for explicitly requested inferior shell.")
+
+(defvar explicit-csh-args
+  (if (eq system-type 'hpux)
+      ;; -T persuades HP's csh not to think it is smarter
+      ;; than us about what terminal modes to use.
+      '("-i" "-T")
+    '("-i"))
+  "*Args passed to inferior shell by M-x shell, if the shell is csh.
+Value is a list of strings, which may be nil.")
+
+(defvar shell-dirstack nil
+  "List of directories saved by pushd in this buffer's shell.")
+
+(defvar shell-dirstack-query "dirs"
+  "Command used by shell-resync-dirlist to query shell.")
+
+(defvar shell-mode-map ())
+(cond ((not shell-mode-map)
+       (setq shell-mode-map (copy-keymap comint-mode-map))
+       (define-key shell-mode-map "\t" 'comint-dynamic-complete)
+       (define-key shell-mode-map "\M-?"  'comint-dynamic-list-completions)))
+
+(defvar shell-mode-hook '()
+  "*Hook for customising shell mode")
+
+
+;;; Basic Procedures
+;;; ===========================================================================
+;;;
+
+(defun shell-mode ()
+  "Major mode for interacting with an inferior shell.
+Return after the end of the process' output sends the text from the 
+    end of process to the end of the current line.
+Return before end of process output copies rest of line to end (skipping
+    the prompt) and sends it.
+M-x send-invisible reads a line of text without echoing it, and sends it to
+    the shell.
+
+If you accidentally suspend your process, use \\[comint-continue-subjob]
+to continue it.
+
+cd, pushd and popd commands given to the shell are watched by Emacs to keep
+this buffer's default directory the same as the shell's working directory.
+M-x dirs queries the shell and resyncs Emacs' idea of what the current 
+    directory stack is.
+M-x dirtrack-toggle turns directory tracking on and off.
+
+\\{shell-mode-map}
+Customisation: Entry to this mode runs the hooks on comint-mode-hook and
+shell-mode-hook (in that order).
+
+Variables shell-cd-regexp, shell-pushd-regexp and shell-popd-regexp are used
+to match their respective commands."
+  (interactive)
+  (comint-mode)
+  (setq major-mode 'shell-mode
+        mode-name "Shell"
+        comint-prompt-regexp shell-prompt-pattern
+        comint-input-sentinel 'shell-directory-tracker)
+  (use-local-map shell-mode-map)
+  (make-local-variable 'shell-dirstack)
+  (set (make-local-variable 'shell-dirtrackp) t)
+  (run-hooks 'shell-mode-hook))
+
+
+(defun shell ()
+  "Run an inferior shell, with I/O through buffer *shell*.
+If buffer exists but shell process is not running, make new shell.
+If buffer exists and shell process is running, just switch to buffer *shell*.
+
+The shell to use comes from the first non-nil variable found from these:
+explicit-shell-file-name in Emacs, ESHELL in the environment or SHELL in the
+environment.  If none is found, /bin/sh is used.
+
+If a file ~/.emacs_SHELLNAME exists, it is given as initial input, simulating
+a start-up file for the shell like .profile or .cshrc.  Note that this may
+lose due to a timing error if the shell discards input when it starts up.
+
+The buffer is put in shell-mode, giving commands for sending input
+and controlling the subjobs of the shell.
+
+The shell file name, sans directories, is used to make a symbol name
+such as `explicit-csh-arguments'.  If that symbol is a variable,
+its value is used as a list of arguments when invoking the shell.
+Otherwise, one argument `-i' is passed to the shell.
+
+\(Type \\[describe-mode] in the shell buffer for a list of commands.)"
+  (interactive)
+  (cond ((not (comint-check-proc "*shell*"))
+         (let* ((prog (or explicit-shell-file-name
+                          (getenv "ESHELL")
+                          (getenv "SHELL")
+                          "/bin/sh"))
+                (name (file-name-nondirectory prog))
+                (startfile (concat "~/.emacs_" name))
+                (xargs-name (intern-soft (concat "explicit-" name "-args"))))
+           (set-buffer (apply 'make-comint "shell" prog
+                              (if (file-exists-p startfile) startfile)
+                              (if (and xargs-name (boundp xargs-name))
+                                  (symbol-value xargs-name)
+                                  '("-i"))))
+           (shell-mode))))
+  (switch-to-buffer "*shell*"))
+
+
+;;; Directory tracking
+;;; ===========================================================================
+;;; This code provides the shell mode input sentinel
+;;;     SHELL-DIRECTORY-TRACKER
+;;; that tracks cd, pushd, and popd commands issued to the shell, and
+;;; changes the current directory of the shell buffer accordingly.
+;;;
+;;; This is basically a fragile hack, although it's more accurate than
+;;; the original version in shell.el. It has the following failings:
+;;; 1. It doesn't know about the cdpath shell variable.
+;;; 2. It only spots the first command in a command sequence. E.g., it will
+;;;    miss the cd in "ls; cd foo"
+;;; 3. More generally, any complex command (like ";" sequencing) is going to
+;;;    throw it. Otherwise, you'd have to build an entire shell interpreter in
+;;;    emacs lisp.  Failing that, there's no way to catch shell commands where
+;;;    cd's are buried inside conditional expressions, aliases, and so forth.
+;;;
+;;; The whole approach is a crock. Shell aliases mess it up. File sourcing
+;;; messes it up. You run other processes under the shell; these each have
+;;; separate working directories, and some have commands for manipulating
+;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
+;;; commands that do *not* effect the current w.d. at all, but look like they
+;;; do (e.g., the cd command in ftp).  In shells that allow you job
+;;; control, you can switch between jobs, all having different w.d.'s. So
+;;; simply saying %3 can shift your w.d..
+;;;
+;;; The solution is to relax, not stress out about it, and settle for
+;;; a hack that works pretty well in typical circumstances. Remember
+;;; that a half-assed solution is more in keeping with the spirit of Unix, 
+;;; anyway. Blech.
+;;;
+;;; One good hack not implemented here for users of programmable shells
+;;; is to program up the shell w.d. manipulation commands to output
+;;; a coded command sequence to the tty. Something like
+;;;     ESC | <cwd> |
+;;; where <cwd> is the new current working directory. Then trash the
+;;; directory tracking machinery currently used in this package, and
+;;; replace it with a process filter that watches for and strips out
+;;; these messages.
+
+;;; REGEXP is a regular expression. STR is a string. START is a fixnum.
+;;; Returns T if REGEXP matches STR where the match is anchored to start
+;;; at position START in STR. Sort of like LOOKING-AT for strings.
+(defun shell-front-match (regexp str start)
+  (eq start (string-match regexp str start)))
+
+(defun shell-directory-tracker (str)
+  "Tracks cd, pushd and popd commands issued to the shell.
+This function is called on each input passed to the shell.
+It watches for cd, pushd and popd commands and sets the buffer's
+default directory to track these commands.
+
+You may toggle this tracking on and off with M-x dirtrack-toggle.
+If emacs gets confused, you can resync with the shell with M-x dirs.
+
+See variables shell-cd-regexp, shell-pushd-regexp, and shell-popd-regexp.
+Environment variables are expanded, see function substitute-in-file-name."
+  (condition-case err
+    (cond (shell-dirtrackp
+           (string-match "^\\s *" str) ; skip whitespace
+           (let ((bos (match-end 0))
+                 (x nil))
+             (cond ((setq x (shell-match-cmd-w/optional-arg shell-popd-regexp
+                                                               str bos))
+                    (shell-process-popd (substitute-in-file-name x)))
+                   ((setq x (shell-match-cmd-w/optional-arg shell-pushd-regexp
+                                                               str bos))
+                    (shell-process-pushd (substitute-in-file-name x)))
+                   ((setq x (shell-match-cmd-w/optional-arg shell-cd-regexp
+                                                               str bos))
+                    (shell-process-cd (substitute-in-file-name x)))))))
+    (error (message (car (cdr err))))))
+
+
+;;; Try to match regexp CMD to string, anchored at position START.
+;;; CMD may be followed by a single argument. If a match, then return
+;;; the argument, if there is one, or the empty string if not. If
+;;; no match, return nil.
+
+(defun shell-match-cmd-w/optional-arg (cmd str start)
+  (and (shell-front-match cmd str start)
+       (let ((eoc (match-end 0))) ; end of command
+         (cond ((shell-front-match "\\s *\\(\;\\|$\\)" str eoc)
+                "")                     ; no arg
+               ((shell-front-match "\\s +\\([^ \t\;]+\\)\\s *\\(\;\\|$\\)"
+                                      str eoc)
+                (substring str (match-beginning 1) (match-end 1))) ; arg
+               (t nil))))) ; something else.
+;;; The first regexp is [optional whitespace, (";" or the end of string)].
+;;; The second regexp is [whitespace, (an arg), optional whitespace,
+;;;     (";" or end of string)].
+
+
+;;; popd [+n]
+(defun shell-process-popd (arg)
+  (let ((num (if (zerop (length arg)) 0 ; no arg means +0
+                 (shell-extract-num arg))))
+    (if (and num (< num (length shell-dirstack)))
+        (if (= num 0) ; condition-case because the CD could lose.
+            (condition-case nil (progn (cd (car shell-dirstack))
+                                       (setq shell-dirstack
+                                             (cdr shell-dirstack))
+                                       (shell-dirstack-message))
+              (error (message "Couldn't cd.")))
+            (let* ((ds (cons nil shell-dirstack))
+                   (cell (nthcdr (- num 1) ds)))
+              (rplacd cell (cdr (cdr cell)))
+              (setq shell-dirstack (cdr ds))
+              (shell-dirstack-message)))
+        (message "Bad popd."))))
+
+
+;;; cd [dir]
+(defun shell-process-cd (arg)
+  (condition-case nil (progn (cd (if (zerop (length arg)) (getenv "HOME")
+                                     arg))
+                             (shell-dirstack-message))
+           (error (message "Couldn't cd."))))
+
+
+;;; pushd [+n | dir]
+(defun shell-process-pushd (arg)
+  (if (zerop (length arg))
+      ;; no arg -- swap pwd and car of shell stack
+      (condition-case nil (if shell-dirstack
+                              (let ((old default-directory))
+                                (cd (car shell-dirstack))
+                                (setq shell-dirstack
+                                      (cons old (cdr shell-dirstack)))
+                                (shell-dirstack-message))
+                              (message "Directory stack empty."))
+        (message "Couldn't cd."))
+
+      (let ((num (shell-extract-num arg)))
+        (if num                         ; pushd +n
+            (if (> num (length shell-dirstack))
+                (message "Directory stack not that deep.")
+                (let* ((ds (cons default-directory shell-dirstack))
+                       (dslen (length ds))
+                       (front (nthcdr num ds))
+                       (back (reverse (nthcdr (- dslen num) (reverse ds))))
+                       (new-ds (append front back)))
+                  (condition-case nil
+                      (progn (cd (car new-ds))
+                             (setq shell-dirstack (cdr new-ds))
+                             (shell-dirstack-message))
+                    (error (message "Couldn't cd.")))))
+               
+            ;; pushd <dir>
+            (let ((old-wd default-directory))
+              (condition-case nil
+                  (progn (cd arg)
+                         (setq shell-dirstack
+                               (cons old-wd shell-dirstack))
+                         (shell-dirstack-message))
+                (error (message "Couldn't cd."))))))))
+
+;; If STR is of the form +n, for n>0, return n. Otherwise, nil.
+(defun shell-extract-num (str)
+  (and (string-match "^\\+[1-9][0-9]*$" str)
+       (string-to-int str)))
+
+
+(defun shell-dirtrack-toggle ()
+  "Turn directory tracking on and off in a shell buffer."
+  (interactive)
+  (setq shell-dirtrackp (not shell-dirtrackp))
+  (message "directory tracking %s."
+           (if shell-dirtrackp "ON" "OFF")))
+
+;;; For your typing convenience:
+(fset 'dirtrack-toggle 'shell-dirtrack-toggle)
+
+
+(defun shell-resync-dirs ()
+  "Resync the buffer's idea of the current directory stack.
+This command queries the shell with the command bound to 
+shell-dirstack-query (default \"dirs\"), reads the next
+line output and parses it to form the new directory stack.
+DON'T issue this command unless the buffer is at a shell prompt.
+Also, note that if some other subprocess decides to do output
+immediately after the query, its output will be taken as the
+new directory stack -- you lose. If this happens, just do the
+command again."
+  (interactive)
+  (let* ((proc (get-buffer-process (current-buffer)))
+         (pmark (process-mark proc)))
+    (goto-char pmark)
+    (insert shell-dirstack-query) (insert "\n")
+    (sit-for 0) ; force redisplay
+    (comint-send-string proc shell-dirstack-query) 
+    (comint-send-string proc "\n")
+    (set-marker pmark (point))
+    (let ((pt (point))) ; wait for 1 line
+      ;; This extra newline prevents the user's pending input from spoofing us.
+      (insert "\n") (backward-char 1)
+      (while (not (looking-at ".+\n"))
+        (accept-process-output proc)
+        (goto-char pt)))
+    (goto-char pmark) (delete-char 1) ; remove the extra newline
+    ;; That's the dirlist. grab it & parse it.
+    (let* ((dl (buffer-substring (match-beginning 0) (- (match-end 0) 1)))
+           (dl-len (length dl))
+           (ds '())                     ; new dir stack
+           (i 0))
+      (while (< i dl-len)
+        ;; regexp = optional whitespace, (non-whitespace), optional whitespace
+        (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
+        (setq ds (cons (substring dl (match-beginning 1) (match-end 1))
+                       ds))
+        (setq i (match-end 0)))
+      (let ((ds (reverse ds)))
+        (condition-case nil
+            (progn (cd (car ds))
+                   (setq shell-dirstack (cdr ds))
+                   (shell-dirstack-message))
+          (error (message "Couldn't cd.")))))))
+
+;;; For your typing convenience:
+(fset 'dirs 'shell-resync-dirs)
+
+
+;;; Show the current dirstack on the message line.
+;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
+;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
+;;; All the commands that mung the buffer's dirstack finish by calling
+;;; this guy.
+(defun shell-dirstack-message ()
+  (let ((msg "")
+        (ds (cons default-directory shell-dirstack)))
+    (while ds
+      (let ((dir (car ds)))
+        (if (string-match (format "^%s\\(/\\|$\\)" (getenv "HOME")) dir)
+            (setq dir (concat "~/" (substring dir (match-end 0)))))
+        (if (string-equal dir "~/") (setq dir "~"))
+        (setq msg (concat msg dir " "))
+        (setq ds (cdr ds))))
+    (message msg)))
diff --git a/lisp/subr.el b/lisp/subr.el
new file mode 100644
index 00000000000..512867ee3c0
--- /dev/null
+++ b/lisp/subr.el
@@ -0,0 +1,316 @@
+;; Basic lisp subroutines 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 one-window-p (&optional arg)
+  "Returns non-nil if there is only one window.
+Optional arg NOMINI non-nil means don't count the minibuffer
+even if it is active."
+  (eq (selected-window)
+      (next-window (selected-window) (if arg 'arg))))
+
+(defun walk-windows (proc &optional minibuf all-screens)
+  "Cycle through all visible windows, calling PROC for each one.
+PROC is called with a window as argument.
+Optional second arg MINIBUF t means count the minibuffer window
+even if not active.  If MINIBUF is neither t nor nil it means
+not to count the minibuffer even if it is active.
+Optional third arg ALL-SCREENS t means include all windows in all screens;
+otherwise cycle within the selected screen."
+  (let* ((walk-windows-start (selected-window))
+         (walk-windows-current walk-windows-start))
+    (while (progn
+             (setq walk-windows-current
+                   (next-window walk-windows-current minibuf all-screens))
+             (funcall proc walk-windows-current)
+             (not (eq walk-windows-current walk-windows-start))))))
+
+(defun read-quoted-char (&optional prompt)
+  "Like `read-char', except that if the first character read is an octal
+digit, we read up to two more octal digits and return the character
+represented by the octal number consisting of those digits.
+Optional argument PROMPT specifies a string to use to prompt the user."
+  (let ((count 0) (code 0) char)
+    (while (< count 3)
+      (let ((inhibit-quit (zerop count))
+            (help-form nil))
+        (and prompt (message "%s-" prompt))
+        (setq char (read-char))
+        (if inhibit-quit (setq quit-flag nil)))
+      (cond ((null char))
+            ((and (<= ?0 char) (<= char ?7))
+             (setq code (+ (* code 8) (- char ?0))
+                   count (1+ count))
+             (and prompt (message (setq prompt
+                                        (format "%s %c" prompt char)))))
+            ((> count 0)
+             (setq unread-command-char char count 259))
+            (t (setq code char count 259))))
+    (logand 255 code)))
+
+(defun error (&rest args)
+  "Signal an error, making error message by passing all args to `format'."
+  (while t
+    (signal 'error (list (apply 'format args)))))
+
+(defun undefined ()
+  (interactive)
+  (ding))
+
+;Prevent the \{...} documentation construct
+;from mentioning keys that run this command.
+(put 'undefined 'suppress-keymap t)
+
+(defun suppress-keymap (map &optional nodigits)
+  "Make MAP override all normally self-inserting keys to be undefined.
+Normally, as an exception, digits and minus-sign are set to make prefix args,
+but optional second arg NODIGITS non-nil treats them like other chars."
+  (let ((i 0))
+    (while (<= i 127)
+      (if (eql (lookup-key global-map (char-to-string i)) 'self-insert-command)
+          (define-key map (char-to-string i) 'undefined))
+      (setq i (1+ i))))
+  (or nodigits
+      (let (loop)
+        (define-key map "-" 'negative-argument)
+        ;; Make plain numbers do numeric args.
+        (setq loop ?0)
+        (while (<= loop ?9)
+          (define-key map (char-to-string loop) 'digit-argument)
+          (setq loop (1+ loop))))))
+
+;; now in fns.c
+;(defun nth (n list)
+;  "Returns the Nth element of LIST.
+;N counts from zero.  If LIST is not that long, nil is returned."
+;  (car (nthcdr n list)))
+;
+;(defun copy-alist (alist)
+;  "Return a copy of ALIST.
+;This is a new alist which represents the same mapping
+;from objects to objects, but does not share the alist structure with ALIST.
+;The objects mapped (cars and cdrs of elements of the alist)
+;are shared, however."
+;  (setq alist (copy-sequence alist))
+;  (let ((tail alist))
+;    (while tail
+;      (if (consp (car tail))
+;         (setcar tail (cons (car (car tail)) (cdr (car tail)))))
+;      (setq tail (cdr tail))))
+;  alist)
+
+;Moved to keymap.c
+;(defun copy-keymap (keymap)
+;  "Return a copy of KEYMAP"  
+;  (while (not (keymapp keymap))
+;    (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
+;  (if (vectorp keymap)
+;      (copy-sequence keymap)
+;      (copy-alist keymap)))
+
+(defun substitute-key-definition (olddef newdef keymap)
+  "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
+In other words, OLDDEF is replaced with NEWDEF where ever it appears.
+Prefix keymaps reached from KEYMAP are not checked recursively;
+perhaps they ought to be."
+  (if (arrayp keymap)
+      (let ((len (length keymap))
+            (i 0))
+        (while (< i len)
+          (if (eq (aref keymap i) olddef)
+              (aset keymap i newdef))
+          (setq i (1+ i))))
+    (while keymap
+      (if (eq (cdr-safe (car-safe keymap)) olddef)
+          (setcdr (car keymap) newdef))
+      (setq keymap (cdr keymap)))))
+
+;; Avoids useless byte-compilation.
+;; In the future, would be better to fix byte compiler
+;; not to really compile in cases like this,
+;; and use defun here.
+(fset 'ignore '(lambda (&rest ignore) nil))
+
+
+; old names
+(fset 'make-syntax-table 'copy-syntax-table)
+(fset 'dot 'point)
+(fset 'dot-marker 'point-marker)
+(fset 'dot-min 'point-min)
+(fset 'dot-max 'point-max)
+(fset 'window-dot 'window-point)
+(fset 'set-window-dot 'set-window-point)
+(fset 'read-input 'read-string)
+(fset 'send-string 'process-send-string)
+(fset 'send-region 'process-send-region)
+(fset 'show-buffer 'set-window-buffer)
+(fset 'buffer-flush-undo 'buffer-disable-undo)
+
+; alternate names
+(fset 'string= 'string-equal)
+(fset 'string< 'string-lessp)
+(fset 'move-marker 'set-marker)
+(fset 'eql 'eq)
+(fset 'not 'null)
+(fset 'numberp 'integerp)
+(fset 'rplaca 'setcar)
+(fset 'rplacd 'setcdr)
+(fset 'beep 'ding) ;preserve lingual purtity
+(fset 'indent-to-column 'indent-to)
+(fset 'backward-delete-char 'delete-backward-char)
+
+(defvar global-map nil
+  "Default global keymap mapping Emacs keyboard input into commands.
+The value is a keymap which is usually (but not necessarily) Emacs's
+global map.")
+
+(defvar ctl-x-map nil
+  "Default keymap for C-x commands.
+The normal global definition of the character C-x indirects to this keymap.")
+
+(defvar esc-map nil
+  "Default keymap for ESC (meta) commands.
+The normal global definition of the character ESC indirects to this keymap.")
+
+(defvar mouse-map nil
+  "Keymap for mouse commands from the X window system.")
+
+(defun run-hooks (&rest hooklist)
+  "Takes hook names and runs each one in turn.  Major mode functions use this.
+Each argument should be a symbol, a hook variable.
+These symbols are processed in the order specified.
+If a hook symbol has a non-nil value, that value may be a function
+or a list of functions to be called to run the hook.
+If the value is a function, it is called with no arguments.
+If it is a list, the elements are called, in order, with no arguments."
+  (while hooklist
+    (let ((sym (car hooklist)))
+      (and (boundp sym)
+           (symbol-value sym)
+           (let ((value (symbol-value sym)))
+             (if (and (listp value) (not (eq (car value) 'lambda)))
+                 (mapcar 'funcall value)
+               (funcall value)))))
+    (setq hooklist (cdr hooklist))))
+
+;; Tell C code how to call this function.
+(defconst run-hooks 'run-hooks
+  "Variable by which C primitives find the function `run-hooks'.
+Don't change it.")
+
+(defun add-hook (hook function)
+  "Add to the value of HOOK the function FUNCTION unless already present.
+HOOK should be a symbol, and FUNCTION may be any valid function.
+HOOK's value should be a list of functions, not a single function.
+If HOOK is void, it is first set to nil."
+  (or (boundp hook) (set hook nil))
+  (or (if (consp function)
+          ;; Clever way to tell whether a given lambda-expression
+          ;; is equal to anything in the hook.
+          (let ((tail (assoc (cdr function) (symbol-value hook))))
+            (equal function tail))
+        (memq function (symbol-value hook)))
+      (set hook (cons function hook))))
+
+(defun momentary-string-display (string pos &optional exit-char message) 
+  "Momentarily display STRING in the buffer at POS.
+Display remains until next character is typed.
+If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed;
+otherwise it is then available as input (as a command if nothing else).
+Display MESSAGE (optional fourth arg) in the echo area.
+If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
+  (or exit-char (setq exit-char ?\ ))
+  (let ((buffer-read-only nil)
+        (modified (buffer-modified-p))
+        (name buffer-file-name)
+        insert-end)
+    (unwind-protect
+        (progn
+          (save-excursion
+            (goto-char pos)
+            ;; defeat file locking... don't try this at home, kids!
+            (setq buffer-file-name nil)
+            (insert-before-markers string)
+            (setq insert-end (point)))
+          (message (or message "Type %s to continue editing.")
+                   (single-key-description exit-char))
+          (let ((char (read-char)))
+            (or (eq char exit-char)
+                (setq unread-command-char char))))
+      (if insert-end
+          (save-excursion
+            (delete-region pos insert-end)))
+      (setq buffer-file-name name)
+      (set-buffer-modified-p modified))))
+
+(defun start-process-shell-command (name buffer &rest args)
+  "Start a program in a subprocess.  Return the process object for it.
+Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
+NAME is name for process.  It is modified if necessary to make it unique.
+BUFFER is the buffer or (buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is command name, the name of a shell command.
+Remaining arguments are the arguments for the command.
+Wildcards and redirection are handle as usual in the shell."
+  (if (eq system-type 'vax-vms)
+      (apply 'start-process name buffer args)
+    (start-process name buffer shell-file-name "-c"
+                   (concat "exec " (mapconcat 'identity args " ")))))
+
+(defun eval-after-load (file form)
+  "Arrange that, if FILE is ever loaded, FORM will be run at that time.
+This makes or adds to an entry on `after-load-alist'.
+FILE should be the name of a library, with no directory name."
+  (or (assoc file after-load-alist)
+      (setq after-load-alist (cons (list file) after-load-alist)))
+  (nconc (assoc file after-load-alist) (list form))
+  form)
+
+(defun eval-next-after-load (file)
+  "Read the following input sexp, and run it whenever FILE is loaded.
+This makes or adds to an entry on `after-load-alist'.
+FILE should be the name of a library, with no directory name."
+  (eval-after-load file (read)))
+
+(defun user-original-login-name ()
+  "Return user's login name from original login.
+This tries to remain unaffected by `su', by looking in environment variables."
+  (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
+
+(defun force-mode-line-update (&optional all)
+  "Force the mode-line of the current buffer to be redisplayed.
+With optional non-nil ALL then force then force redisplay of all mode-lines."
+  (if all (save-excursion (set-buffer (other-buffer))))
+  (set-buffer-modified-p (buffer-modified-p)))
+
+(defun keyboard-translate (from to)
+  "Translate character FROM to TO at a low level.
+This function creates a `keyboard-translate-table' if necessary
+and then modifies one entry in it."
+  (or (boundp 'keyboard-translate-table)
+      (let ((table (make-string 256))
+            (i 0))
+        (while (< i 256)
+          (aset table i i)
+          (setq i (1+ i)))
+        (setq keyboard-translate-table table)))
+  (aset keyboard-translate-table from to))