Merge from emacs-24; up to 2012-12-11T09:51:12Z!dmantipov@yandex.ru
[bpt/emacs.git] / lisp / emacs-lisp / crm.el
index b24c2d9..f88cb0e 100644 (file)
@@ -1,17 +1,16 @@
 ;;; crm.el --- read multiple strings with completion
 
 ;;; crm.el --- read multiple strings with completion
 
-;; Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-2013 Free Software Foundation, Inc.
 
 ;; Author: Sen Nagata <sen@eccosys.com>
 ;; Keywords: completion, minibuffer, multiple elements
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Sen Nagata <sen@eccosys.com>
 ;; Keywords: completion, minibuffer, multiple elements
 
 ;; 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
 ;; 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
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +18,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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:
 
 
 ;;; Commentary:
 
 ;; a single prompt, optionally using completion.
 
 ;; Multiple strings are specified by separating each of the strings
 ;; a single prompt, optionally using completion.
 
 ;; Multiple strings are specified by separating each of the strings
-;; with a prespecified separator character.  For example, if the
-;; separator character is a comma, the strings 'alice', 'bob', and
+;; with a prespecified separator regexp.  For example, if the
+;; separator regexp is ",", the strings 'alice', 'bob', and
 ;; 'eve' would be specified as 'alice,bob,eve'.
 
 ;; 'eve' would be specified as 'alice,bob,eve'.
 
-;; The default value for the separator character is the value of
-;; `crm-default-separator' (comma).  The separator character may be
+;; The default value for the separator regexp is the value of
+;; `crm-default-separator' (comma).  The separator regexp may be
 ;; changed by modifying the value of `crm-separator'.
 
 ;; Contiguous strings of non-separator-characters are referred to as
 ;; changed by modifying the value of `crm-separator'.
 
 ;; Contiguous strings of non-separator-characters are referred to as
 ;;   first revamped version
 
 ;;; Code:
 ;;   first revamped version
 
 ;;; Code:
-(defconst crm-default-separator ","
-  "Default separator for `completing-read-multiple'.")
+(defconst crm-default-separator "[ \t]*,[ \t]*"
+  "Default separator regexp for `completing-read-multiple'.")
 
 (defvar crm-separator crm-default-separator
 
 (defvar crm-separator crm-default-separator
-  "Separator used for separating strings in `completing-read-multiple'.
-It should be a single character string that doesn't appear in the list of
-completion candidates.  Modify this value to make `completing-read-multiple'
-use a separator other than `crm-default-separator'.")
+  "Separator regexp used for separating strings in `completing-read-multiple'.
+It should be a regexp that does not match the list of completion candidates.
+Modify this value to make `completing-read-multiple' use a separator other
+than `crm-default-separator'.")
 
 (defvar crm-local-completion-map
   (let ((map (make-sparse-keymap)))
 
 (defvar crm-local-completion-map
   (let ((map (make-sparse-keymap)))
@@ -146,7 +143,7 @@ nil if none.
 
 The value of FLAG is used to specify the type of completion operation.
 A value of nil specifies `try-completion'.  A value of t specifies
 
 The value of FLAG is used to specify the type of completion operation.
 A value of nil specifies `try-completion'.  A value of t specifies
-`all-completions'.  A value of lambda specifes a test for an exact match.
+`all-completions'.  A value of lambda specifies a test for an exact match.
 
 For more information on STRING, PREDICATE, and FLAG, see the Elisp
 Reference sections on 'Programmed Completion' and 'Basic Completion
 
 For more information on STRING, PREDICATE, and FLAG, see the Elisp
 Reference sections on 'Programmed Completion' and 'Basic Completion
@@ -176,13 +173,17 @@ Place an overlay on the element, with a `field' property, and return it."
     (overlay-put ol 'field (make-symbol "crm"))
     ol))
 
     (overlay-put ol 'field (make-symbol "crm"))
     ol))
 
+(defmacro crm--completion-command (command)
+  "Make COMMAND a completion command for `completing-read-multiple'."
+  `(let ((ol (crm--select-current-element)))
+     (unwind-protect
+         ,command
+       (delete-overlay ol))))
+
 (defun crm-completion-help ()
   "Display a list of possible completions of the current minibuffer element."
   (interactive)
 (defun crm-completion-help ()
   "Display a list of possible completions of the current minibuffer element."
   (interactive)
-  (let ((ol (crm--select-current-element)))
-    (unwind-protect
-        (minibuffer-completion-help)
-      (delete-overlay ol)))
+  (crm--completion-command (minibuffer-completion-help))
   nil)
 
 (defun crm-complete ()
   nil)
 
 (defun crm-complete ()
@@ -191,19 +192,13 @@ If no characters can be completed, display a list of possible completions.
 
 Return t if the current element is now a valid match; otherwise return nil."
   (interactive)
 
 Return t if the current element is now a valid match; otherwise return nil."
   (interactive)
-  (let ((ol (crm--select-current-element)))
-    (unwind-protect
-        (minibuffer-complete)
-      (delete-overlay ol))))
+  (crm--completion-command (minibuffer-complete)))
 
 (defun crm-complete-word ()
   "Complete the current element at most a single word.
 Like `minibuffer-complete-word' but for `completing-read-multiple'."
   (interactive)
 
 (defun crm-complete-word ()
   "Complete the current element at most a single word.
 Like `minibuffer-complete-word' but for `completing-read-multiple'."
   (interactive)
-  (let ((ol (crm--select-current-element)))
-    (unwind-protect
-        (minibuffer-complete-word)
-      (delete-overlay ol))))
+  (crm--completion-command (minibuffer-complete-word)))
 
 (defun crm-complete-and-exit ()
   "If all of the minibuffer elements are valid completions then exit.
 
 (defun crm-complete-and-exit ()
   "If all of the minibuffer elements are valid completions then exit.
@@ -225,11 +220,23 @@ This function is modeled after `minibuffer-complete-and-exit'."
                      (setq doexit nil))
                  (goto-char (overlay-end ol))
                  (delete-overlay ol))
                      (setq doexit nil))
                  (goto-char (overlay-end ol))
                  (delete-overlay ol))
-               (not (eobp))))
+               (not (eobp)))
+             (looking-at crm-separator))
       ;; Skip to the next element.
       ;; Skip to the next element.
-      (forward-char 1))
+      (goto-char (match-end 0)))
     (if doexit (exit-minibuffer))))
 
     (if doexit (exit-minibuffer))))
 
+(defun crm--choose-completion-string (choice buffer base-position
+                                             &rest ignored)
+  "Completion string chooser for `completing-read-multiple'.
+This is called from `choose-completion-string-functions'.
+It replaces the string that is currently being completed, without
+exiting the minibuffer."
+  (let ((completion-no-auto-exit t)
+        (choose-completion-string-functions nil))
+    (choose-completion-string choice buffer base-position)
+    t))
+
 ;; superemulates behavior of completing_read in src/minibuf.c
 ;;;###autoload
 (defun completing-read-multiple
 ;; superemulates behavior of completing_read in src/minibuf.c
 ;;;###autoload
 (defun completing-read-multiple
@@ -240,12 +247,12 @@ By using this functionality, a user may specify multiple strings at a
 single prompt, optionally using completion.
 
 Multiple strings are specified by separating each of the strings with
 single prompt, optionally using completion.
 
 Multiple strings are specified by separating each of the strings with
-a prespecified separator character.  For example, if the separator
-character is a comma, the strings 'alice', 'bob', and 'eve' would be
+a prespecified separator regexp.  For example, if the separator
+regexp is \",\", the strings 'alice', 'bob', and 'eve' would be
 specified as 'alice,bob,eve'.
 
 specified as 'alice,bob,eve'.
 
-The default value for the separator character is the value of
-`crm-default-separator' (comma).  The separator character may be
+The default value for the separator regexp is the value of
+`crm-default-separator' (comma).  The separator regexp may be
 changed by modifying the value of `crm-separator'.
 
 Contiguous strings of non-separator-characters are referred to as
 changed by modifying the value of `crm-separator'.
 
 Contiguous strings of non-separator-characters are referred to as
@@ -261,22 +268,28 @@ The return value of this function is a list of the read strings.
 See the documentation for `completing-read' for details on the arguments:
 PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
 INHERIT-INPUT-METHOD."
 See the documentation for `completing-read' for details on the arguments:
 PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
 INHERIT-INPUT-METHOD."
-  (let* ((minibuffer-completion-table #'crm--collection-fn)
-        (minibuffer-completion-predicate predicate)
-        ;; see completing_read in src/minibuf.c
-        (minibuffer-completion-confirm
-         (unless (eq require-match t) require-match))
-        (crm-completion-table table)
-        (map (if require-match
-                 crm-local-must-match-map
-               crm-local-completion-map))
-        ;; If the user enters empty input, read-from-minibuffer returns
-        ;; the empty string, not DEF.
-        (input (read-from-minibuffer
-                prompt initial-input map
-                nil hist def inherit-input-method)))
-    (and def (string-equal input "") (setq input def))
-    (split-string input crm-separator)))
+  (unwind-protect
+      (progn
+       (add-hook 'choose-completion-string-functions
+                 'crm--choose-completion-string)
+       (let* ((minibuffer-completion-table #'crm--collection-fn)
+              (minibuffer-completion-predicate predicate)
+              ;; see completing_read in src/minibuf.c
+              (minibuffer-completion-confirm
+               (unless (eq require-match t) require-match))
+              (crm-completion-table table)
+              (map (if require-match
+                       crm-local-must-match-map
+                     crm-local-completion-map))
+              ;; If the user enters empty input, `read-from-minibuffer'
+              ;; returns the empty string, not DEF.
+              (input (read-from-minibuffer
+                      prompt initial-input map
+                      nil hist def inherit-input-method)))
+         (and def (string-equal input "") (setq input def))
+         (split-string input crm-separator)))
+    (remove-hook 'choose-completion-string-functions
+                'crm--choose-completion-string)))
 
 (define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1")
 (define-obsolete-function-alias
 
 (define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1")
 (define-obsolete-function-alias
@@ -306,5 +319,4 @@ INHERIT-INPUT-METHOD."
 
 (provide 'crm)
 
 
 (provide 'crm)
 
-;; arch-tag: db1911d9-86c6-4a42-b32a-4910701b15a6
 ;;; crm.el ends here
 ;;; crm.el ends here