Docstring improvement.
[bpt/emacs.git] / lisp / simple.el
index 90955e8..118bb71 100644 (file)
@@ -9,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -1957,6 +1955,25 @@ This buffer is used when `shell-command' or `shell-command-on-region'
 is run interactively.  A value of nil means that output to stderr and
 stdout will be intermixed in the output stream.")
 
+(declare-function mailcap-file-default-commands "mailcap" (files))
+
+(defun minibuffer-default-add-shell-commands ()
+  "Return a list of all commands associted with the current file.
+This function is used to add all related commands retieved by `mailcap'
+to the end of the list of defaults just after the default value."
+  (interactive)
+  (let* ((filename (if (listp minibuffer-default)
+                      (car minibuffer-default)
+                    minibuffer-default))
+        (commands (and filename (require 'mailcap nil t)
+                       (mailcap-file-default-commands (list filename)))))
+    (setq commands (mapcar (lambda (command)
+                            (concat command " " filename))
+                          commands))
+    (if (listp minibuffer-default)
+       (append minibuffer-default commands)
+      (cons minibuffer-default commands))))
+
 (defun minibuffer-complete-shell-command ()
   "Dynamically complete shell command at point."
   (interactive)
@@ -2031,9 +2048,17 @@ If it is nil, error output is mingled with regular output.
 In an interactive call, the variable `shell-command-default-error-buffer'
 specifies the value of ERROR-BUFFER."
 
-  (interactive (list (read-shell-command "Shell command: ")
-                    current-prefix-arg
-                    shell-command-default-error-buffer))
+  (interactive
+   (list
+    (minibuffer-with-setup-hook
+       (lambda ()
+         (set (make-local-variable 'minibuffer-default-add-function)
+              'minibuffer-default-add-shell-commands))
+      (read-shell-command "Shell command: " nil nil
+                         (and buffer-file-name
+                              (file-relative-name buffer-file-name))))
+    current-prefix-arg
+    shell-command-default-error-buffer))
   ;; Look for a handler in case default-directory is a remote file name.
   (let ((handler
         (find-file-name-handler (directory-file-name default-directory)
@@ -2411,9 +2436,14 @@ value passed."
 
 (defun start-file-process (name buffer program &rest program-args)
   "Start a program in a subprocess.  Return the process object for it.
+
 Similar to `start-process', but may invoke a file handler based on
-`default-directory'.  The current working directory of the
-subprocess is `default-directory'.
+`default-directory'.  See Info node `(elisp)Magic File Names'.
+
+This handler ought to run PROGRAM, perhaps on the local host,
+perhaps on a remote host that corresponds to `default-directory'.
+In the latter case, the local part of `default-directory' becomes
+the working directory of the process.
 
 PROGRAM and PROGRAM-ARGS might be file names.  They are not
 objects of file handler invocation."
@@ -2788,7 +2818,7 @@ move the yanking point; just return the Nth kill forward."
   "Kill (\"cut\") text between point and mark.
 This deletes the text from the buffer and saves it in the kill ring.
 The command \\[yank] can retrieve it from there.
-\(If you want to kill and then yank immediately, use \\[kill-ring-save].)
+\(If you want to save the region without killing it, use \\[kill-ring-save].)
 
 If you want to append the killed region to the last killed text,
 use \\[append-next-kill] before \\[kill-region].
@@ -5234,18 +5264,17 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
 \f
 ;; Define the major mode for lists of completions.
 
-(defvar completion-list-mode-map nil
+(defvar completion-list-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-2] 'mouse-choose-completion)
+    (define-key map [follow-link] 'mouse-face)
+    (define-key map [down-mouse-2] nil)
+    (define-key map "\C-m" 'choose-completion)
+    (define-key map "\e\e\e" 'delete-completion-window)
+    (define-key map [left] 'previous-completion)
+    (define-key map [right] 'next-completion)
+    map)
   "Local map for completion list buffers.")
-(or completion-list-mode-map
-    (let ((map (make-sparse-keymap)))
-      (define-key map [mouse-2] 'mouse-choose-completion)
-      (define-key map [follow-link] 'mouse-face)
-      (define-key map [down-mouse-2] nil)
-      (define-key map "\C-m" 'choose-completion)
-      (define-key map "\e\e\e" 'delete-completion-window)
-      (define-key map [left] 'previous-completion)
-      (define-key map [right] 'next-completion)
-      (setq completion-list-mode-map map)))
 
 ;; Completion mode is suitable only for specially formatted data.
 (put 'completion-list-mode 'mode-class 'special)
@@ -5399,11 +5428,15 @@ to decide what to delete."
               'choose-completion-string-functions
               choice buffer mini-p base-size)
        ;; Insert the completion into the buffer where it was requested.
+        ;; FIXME:
+        ;; - There may not be a field at point, or there may be a field but
+        ;;   it's not a "completion field", in which case we have to
+        ;;   call choose-completion-delete-max-match even if base-size is set.
+        ;; - we may need to delete further than (point) to (field-end),
+        ;;   depending on the completion-style, and for that we need to
+        ;;   extra data `completion-extra-size'.
        (if base-size
-           (delete-region (+ base-size (if mini-p
-                                           (minibuffer-prompt-end)
-                                         (point-min)))
-                          (point))
+           (delete-region (+ base-size (field-beginning)) (point))
          (choose-completion-delete-max-match choice))
        (insert choice)
        (remove-text-properties (- (point) (length choice)) (point)
@@ -5413,11 +5446,11 @@ to decide what to delete."
          (set-window-point window (point)))
        ;; If completing for the minibuffer, exit it with this choice.
        (and (not completion-no-auto-exit)
-            (equal buffer (window-buffer (minibuffer-window)))
+             (minibufferp buffer)
             minibuffer-completion-table
             ;; If this is reading a file name, and the file name chosen
             ;; is a directory, don't exit the minibuffer.
-            (if (and (eq minibuffer-completion-table 'read-file-name-internal)
+            (if (and minibuffer-completing-file-name
                      (file-directory-p (field-string (point-max))))
                 (let ((mini (active-minibuffer-window)))
                   (select-window mini)
@@ -5425,7 +5458,7 @@ to decide what to delete."
                     (raise-frame (window-frame mini))))
               (exit-minibuffer)))))))
 
-(defun completion-list-mode ()
+(define-derived-mode completion-list-mode nil "Completion List"
   "Major mode for buffers showing lists of possible completions.
 Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
  to select the completion near point.
@@ -5433,15 +5466,7 @@ Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
  with the mouse.
 
 \\{completion-list-mode-map}"
-
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map completion-list-mode-map)
-  (setq mode-name "Completion List")
-  (setq major-mode 'completion-list-mode)
-  (make-local-variable 'completion-base-size)
-  (setq completion-base-size nil)
-  (run-mode-hooks 'completion-list-mode-hook))
+  (set (make-local-variable 'completion-base-size) nil))
 
 (defun completion-list-mode-finish ()
   "Finish setup of the completions buffer.
@@ -5460,34 +5485,12 @@ Called from `temp-buffer-show-hook'."
   :version "22.1"
   :group 'completion)
 
-(defface completions-first-difference
-  '((t (:inherit bold)))
-  "Face put on the first uncommon character in completions in *Completions* buffer."
-  :group 'completion)
-
-(defface completions-common-part
-  '((t (:inherit default)))
-  "Face put on the common prefix substring in completions in *Completions* buffer.
-The idea of `completions-common-part' is that you can use it to
-make the common parts less visible than normal, so that the rest
-of the differing parts is, by contrast, slightly highlighted."
-  :group 'completion)
-
 ;; This is for packages that need to bind it to a non-default regexp
 ;; in order to make the first-differing character highlight work
 ;; to their liking
 (defvar completion-root-regexp "^/"
   "Regexp to use in `completion-setup-function' to find the root directory.")
 
-(defvar completion-common-substring nil
-  "Common prefix substring to use in `completion-setup-function' to put faces.
-The value is set by `display-completion-list' during running `completion-setup-hook'.
-
-To put faces `completions-first-difference' and `completions-common-part'
-in the `*Completions*' buffer, the common prefix substring in completions
-is needed as a hint.  (The minibuffer is a special case.  The content
-of the minibuffer before point is always the common substring.)")
-
 ;; This function goes in completion-setup-hook, so that it is called
 ;; after the text of the completion list buffer is written.
 (defun completion-setup-function ()
@@ -5502,52 +5505,25 @@ of the minibuffer before point is always the common substring.)")
          (setq default-directory
                 (file-name-directory (expand-file-name mbuf-contents)))))
     (with-current-buffer standard-output
-      (completion-list-mode)
+      (let ((base-size completion-base-size)) ;Read before killing localvars.
+        (completion-list-mode)
+        (set (make-local-variable 'completion-base-size) base-size))
       (set (make-local-variable 'completion-reference-buffer) mainbuf)
-      (setq completion-base-size
-           (cond
-            ((and (symbolp minibuffer-completion-table)
-                  (get minibuffer-completion-table 'completion-base-size-function))
-             ;; To compute base size, a function can use the global value of
-             ;; completion-common-substring or minibuffer-completion-contents.
-             (with-current-buffer mainbuf
-               (funcall (get minibuffer-completion-table
-                             'completion-base-size-function))))
-            (minibuffer-completing-file-name
-             ;; For file name completion, use the number of chars before
-             ;; the start of the file name component at point.
-             (with-current-buffer mainbuf
-               (save-excursion
-                 (skip-chars-backward completion-root-regexp)
-                 (- (point) (minibuffer-prompt-end)))))
-            (minibuffer-completing-symbol nil)
-            ;; Otherwise, in minibuffer, the base size is 0.
-            ((minibufferp mainbuf) 0)))
-      (setq common-string-length
-           (cond
-            (completion-common-substring
-             (length completion-common-substring))
-            (completion-base-size
-             (- (length mbuf-contents) completion-base-size))))
-      ;; Put faces on first uncommon characters and common parts.
-      (when (and (integerp common-string-length) (>= common-string-length 0))
-       (let ((element-start (point-min))
-              (maxp (point-max))
-              element-common-end)
-         (while (and (setq element-start
-                            (next-single-property-change
-                             element-start 'mouse-face))
-                      (< (setq element-common-end
-                               (+ element-start common-string-length))
-                         maxp))
-           (when (get-char-property element-start 'mouse-face)
-             (if (and (> common-string-length 0)
-                      (get-char-property (1- element-common-end) 'mouse-face))
-                 (put-text-property element-start element-common-end
-                                    'font-lock-face 'completions-common-part))
-             (if (get-char-property element-common-end 'mouse-face)
-                 (put-text-property element-common-end (1+ element-common-end)
-                                    'font-lock-face 'completions-first-difference))))))
+      (unless completion-base-size
+        ;; This may be needed for old completion packages which don't use
+        ;; completion-all-completions-with-base-size yet.
+        (setq completion-base-size
+              (cond
+               (minibuffer-completing-file-name
+                ;; For file name completion, use the number of chars before
+                ;; the start of the file name component at point.
+                (with-current-buffer mainbuf
+                  (save-excursion
+                    (skip-chars-backward completion-root-regexp)
+                    (- (point) (minibuffer-prompt-end)))))
+               (minibuffer-completing-symbol nil)
+               ;; Otherwise, in minibuffer, the base size is 0.
+               ((minibufferp mainbuf) 0))))
       ;; Maybe insert help string.
       (when completion-show-help
        (goto-char (point-min))