(select-safe-coding-system): Check coding-category-list more rigidly.
[bpt/emacs.git] / lisp / shell.el
index 03d06ca..d3ec4ee 100644 (file)
@@ -1,9 +1,9 @@
 ;;; shell.el --- specialized comint.el for running the shell.
 
-;; Copyright (C) 1988, 93, 94, 95, 96, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 93, 94, 95, 96, 1997, 2000 Free Software Foundation, Inc.
 
 ;; Author: Olin Shivers <shivers@cs.cmu.edu> then
-;;     Simon Marshall <simon@gnu.ai.mit.edu>
+;;     Simon Marshall <simon@gnu.org>
 ;; Maintainer: FSF
 ;; Keywords: processes
 
@@ -29,7 +29,7 @@
 ;; Please send me bug reports, bug fixes, and extensions, so that I can
 ;; merge them into the master source.
 ;;     - Olin Shivers (shivers@cs.cmu.edu)
-;;     - Simon Marshall (simon@gnu.ai.mit.edu)
+;;     - Simon Marshall (simon@gnu.org)
 
 ;; This file defines a a shell-in-a-buffer package (shell mode) built
 ;; on top of comint mode.  This is actually cmushell with things
@@ -78,7 +78,7 @@
 ;; c-c c-\ comint-quit-subjob             ^\
 ;; c-c c-o comint-kill-output             Delete last batch of process output
 ;; c-c c-r comint-show-output             Show last batch of process output
-;; c-c c-h comint-dynamic-list-input-ring  List input history
+;; c-c c-l comint-dynamic-list-input-ring  List input history
 ;;         send-invisible                  Read line w/o echo & send to proc
 ;;         comint-continue-subjob         Useful if you accidentally suspend
 ;;                                             top-level job
   :group 'shell)
 
 ;;;###autoload
-(defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *"
+(defcustom shell-dumb-shell-regexp "cmd\\(proxy\\)?\\.exe"
+  "Regexp to match shells that don't save their command history.
+For shells that match this regexp, Emacs will write out the
+command history when the shell finishes."
+  :type 'regexp
+  :group 'shell)
+
+(defcustom shell-prompt-pattern "^[^#$%>\n]*[#$%>] *"
   "Regexp to match prompts in the inferior shell.
 Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well.
 This variable is used to initialise `comint-prompt-regexp' in the 
 shell buffer.
 
+This variable is only used if the variable
+`comint-use-prompt-regexp-instead-of-fields' is non-nil.
+
 The pattern should probably not match more than one line.  If it does,
 Shell mode may become confused trying to distinguish prompt from input
 on lines which don't start with a prompt.
 
-This is a fine thing to set in your `.emacs' file.")
+This is a fine thing to set in your `.emacs' file."
+  :type 'regexp
+  :group 'shell)
 
 (defcustom shell-completion-fignore nil
   "*List of suffixes to be disregarded during file/command completion.
@@ -163,7 +175,7 @@ This is a fine thing to set in your `.emacs' file.")
 (defvar shell-file-name-quote-list
   (if (memq system-type '(ms-dos windows-nt))
       nil
-    (append shell-delimiter-argument-list '(?\  ?\* ?\! ?\" ?\' ?\`)))
+    (append shell-delimiter-argument-list '(?\  ?\* ?\! ?\" ?\' ?\` ?\#)))
   "List of characters to quote when in a file name.
 This variable is used to initialize `comint-file-name-quote-list' in the
 shell buffer.  The value may depend on the operating system or shell.
@@ -239,6 +251,12 @@ This mirrors the optional behavior of tcsh."
                 (const nil))
   :group 'shell-directories)
 
+(defcustom shell-dirtrack-verbose t
+  "*If non-nil, show the directory stack following directory change.
+This is effective only if directory tracking is enabled."
+  :type 'boolean
+  :group 'shell-directories)
+
 (defcustom explicit-shell-file-name nil
   "*If non-nil, is file name to use for explicitly requested inferior shell."
   :type '(choice (const :tag "None" nil) file)
@@ -266,8 +284,11 @@ into the buffer's input ring.  See also `comint-magic-space' and
 
 This variable supplies a default for `comint-input-autoexpand',
 for Shell mode only."
-  :type '(choice (const nil) (const input) (const history))
-  :type 'shell)
+  :type '(choice (const :tag "off" nil)
+                (const input)
+                (const history)
+                (const :tag "on" t))
+  :group 'shell)
 
 (defvar shell-dirstack nil
   "List of directories saved by pushd in this buffer's shell.
@@ -307,8 +328,7 @@ Thus, this does not include the shell's current directory.")
   :group 'shell)
 
 (defvar shell-font-lock-keywords
-  '((eval . (cons shell-prompt-pattern 'font-lock-warning-face))
-    ("[ \t]\\([+-][^ \t\n]+\\)" 1 font-lock-comment-face)
+  '(("[ \t]\\([+-][^ \t\n]+\\)" 1 font-lock-comment-face)
     ("^[^ \t\n]+:.*" . font-lock-string-face)
     ("^\\[[1-9][0-9]*\\]" . font-lock-string-face))
   "Additional expressions to highlight in Shell mode.")
@@ -317,7 +337,7 @@ Thus, this does not include the shell's current directory.")
 
 (put 'shell-mode 'mode-class 'special)
 
-(defun shell-mode ()
+(define-derived-mode shell-mode comint-mode "Shell"
   "Major mode for interacting with an inferior shell.
 \\[comint-send-input] after the end of the process' output sends the text from
     the end of process to the end of the current line.
@@ -369,11 +389,6 @@ Variables `comint-output-filter-functions', a hook, and
 `comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
 control whether input and output cause the window to scroll to the end of the
 buffer."
-  (interactive)
-  (comint-mode)
-  (setq major-mode 'shell-mode)
-  (setq mode-name "Shell")
-  (use-local-map shell-mode-map)
   (setq comint-prompt-regexp shell-prompt-pattern)
   (setq comint-completion-fignore shell-completion-fignore)
   (setq comint-delimiter-argument-list shell-delimiter-argument-list)
@@ -408,18 +423,38 @@ buffer."
            (equal (file-truename comint-input-ring-file-name)
                   (file-truename "/dev/null")))
        (setq comint-input-ring-file-name nil))
+    ;; Arrange to write out the input ring on exit, if the shell doesn't
+    ;; do this itself.
+    (if (and comint-input-ring-file-name
+            (string-match shell-dumb-shell-regexp shell))
+       (set-process-sentinel (get-buffer-process (current-buffer))
+                             #'shell-write-history-on-exit))
     (setq shell-dirstack-query
          (cond ((string-equal shell "sh") "pwd")
                ((string-equal shell "ksh") "echo $PWD ~-")
                (t "dirs"))))
-  (run-hooks 'shell-mode-hook)
   (comint-read-input-ring t))
+
+(defun shell-write-history-on-exit (process event)
+  "Called when the shell process is stopped.
+
+Writes the input history to a history file
+`comint-comint-input-ring-file-name' using `comint-write-input-ring'
+and inserts a short message in the shell buffer.
+
+This function is a sentinel watching the shell interpreter process.
+Sentinels will always get the two parameters PROCESS and EVENT."
+  ;; Write history.
+  (comint-write-input-ring)
+  (if (buffer-live-p (process-buffer process))
+      (insert (format "\nProcess %s %s\n" process event))))
 \f
 ;;;###autoload
-(defun shell ()
-  "Run an inferior shell, with I/O through buffer *shell*.
-If buffer exists but shell process is not running, make new shell.
-If buffer exists and shell process is running, just switch to buffer `*shell*'.
+(defun shell (&optional buffer)
+  "Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
+Interactively, a prefix arg means to prompt for BUFFER.
+If BUFFER exists but shell process is not running, make new shell.
+If BUFFER exists and shell process is running, just switch to BUFFER.
 Program used comes from variable `explicit-shell-file-name',
  or (if that is nil) from the ESHELL environment variable,
  or else from SHELL if there is no ESHELL.
@@ -443,8 +478,13 @@ its value is used as a list of arguments when invoking the shell.
 Otherwise, one argument `-i' is passed to the shell.
 
 \(Type \\[describe-mode] in the shell buffer for a list of commands.)"
-  (interactive)
-  (if (not (comint-check-proc "*shell*"))
+  (interactive
+   (list
+    (and current-prefix-arg
+        (read-buffer "Shell buffer: " "*shell*"))))
+  (when (null buffer)
+    (setq buffer "*shell*"))
+  (if (not (comint-check-proc buffer))
       (let* ((prog (or explicit-shell-file-name
                       (getenv "ESHELL")
                       (getenv "SHELL")
@@ -454,7 +494,7 @@ Otherwise, one argument `-i' is passed to the shell.
             (xargs-name (intern-soft (concat "explicit-" name "-args")))
             shell-buffer)
        (save-excursion
-         (set-buffer (apply 'make-comint "shell" prog
+         (set-buffer (apply 'make-comint-in-buffer "shell" buffer prog
                             (if (file-exists-p startfile) startfile)
                             (if (and xargs-name (boundp xargs-name))
                                 (symbol-value xargs-name)
@@ -462,7 +502,7 @@ Otherwise, one argument `-i' is passed to the shell.
          (setq shell-buffer (current-buffer))
          (shell-mode))
        (pop-to-buffer shell-buffer))
-    (pop-to-buffer "*shell*")))
+    (pop-to-buffer buffer)))
 
 ;;; Don't do this when shell.el is loaded, only while dumping.
 ;;;###autoload (add-hook 'same-window-buffer-names "*shell*")
@@ -531,6 +571,8 @@ Environment variables are expanded, see function `substitute-in-file-name'."
              (setq end (match-end 0)
                    cmd (comint-arguments (substring str start end) 0 0)
                    arg1 (comint-arguments (substring str start end) 1 1))
+             (if arg1
+                 (setq arg1 (shell-unquote-argument arg1)))
              (cond ((string-match (concat "\\`\\(" shell-popd-regexp
                                           "\\)\\($\\|[ \t]\\)")
                                   cmd)
@@ -552,6 +594,25 @@ Environment variables are expanded, see function `substitute-in-file-name'."
                                 (match-end 0)))))
        (error "Couldn't cd"))))
 
+(defun shell-unquote-argument (string)
+  "Remove all kinds of shell quoting from STRING."
+  (save-match-data
+    (let ((idx 0) next inside)
+      (while (and (< idx (length string))
+                 (setq next (string-match "[\\'`\"]" string next)))
+       (cond ((= (aref string next) ?\\)
+              (setq string (replace-match "" nil nil string))
+              (setq next (1+ next)))
+             ((and inside (= (aref string next) inside))
+              (setq string (replace-match "" nil nil string))
+              (setq inside nil))
+             (inside
+              (setq next (1+ next)))
+             (t
+              (setq inside (aref string next))
+              (setq string (replace-match "" nil nil string)))))
+      string)))
+
 ;;; popd [+n]
 (defun shell-process-popd (arg)
   (let ((num (or (shell-extract-num arg) 0)))
@@ -715,24 +776,26 @@ command again."
 ;;; All the commands that mung the buffer's dirstack finish by calling
 ;;; this guy.
 (defun shell-dirstack-message ()
-  (let* ((msg "")
-        (ds (cons default-directory shell-dirstack))
-        (home (expand-file-name (concat comint-file-name-prefix "~/")))
-        (homelen (length home)))
-    (while ds
-      (let ((dir (car ds)))
-       (and (>= (length dir) homelen) (string= home (substring dir 0 homelen))
-           (setq dir (concat "~/" (substring dir homelen))))
-       ;; Strip off comint-file-name-prefix if present.
-       (and comint-file-name-prefix
-            (>= (length dir) (length comint-file-name-prefix))
-            (string= comint-file-name-prefix
-                     (substring dir 0 (length comint-file-name-prefix)))
-            (setq dir (substring dir (length comint-file-name-prefix)))
-            (setcar ds dir))
-       (setq msg (concat msg (directory-file-name dir) " "))
-       (setq ds (cdr ds))))
-    (message "%s" msg)))
+  (when shell-dirtrack-verbose
+    (let* ((msg "")
+          (ds (cons default-directory shell-dirstack))
+          (home (expand-file-name (concat comint-file-name-prefix "~/")))
+          (homelen (length home)))
+      (while ds
+       (let ((dir (car ds)))
+         (and (>= (length dir) homelen)
+              (string= home (substring dir 0 homelen))
+              (setq dir (concat "~/" (substring dir homelen))))
+         ;; Strip off comint-file-name-prefix if present.
+         (and comint-file-name-prefix
+              (>= (length dir) (length comint-file-name-prefix))
+              (string= comint-file-name-prefix
+                       (substring dir 0 (length comint-file-name-prefix)))
+              (setq dir (substring dir (length comint-file-name-prefix)))
+              (setcar ds dir))
+         (setq msg (concat msg (directory-file-name dir) " "))
+         (setq ds (cdr ds))))
+      (message "%s" msg))))
 \f
 ;; This was mostly copied from shell-resync-dirs.
 (defun shell-snarf-envar (var)
@@ -780,8 +843,8 @@ See `shell-command-regexp'."
 See `shell-command-regexp'."
   (interactive "p")
   (let ((limit (save-excursion (comint-bol nil) (point))))
-    (if (> limit (point))
-       (save-excursion (beginning-of-line) (setq limit (point))))
+    (when (> limit (point))
+      (setq limit (line-beginning-position)))
     (skip-syntax-backward " " limit)
     (if (re-search-backward
         (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg)