crm.el 13.4 KB
Newer Older
Gerd Moellmann's avatar
Gerd Moellmann committed
1 2
;;; crm.el --- read multiple strings with completion

3
;; Copyright (C) 1985-1986, 1993-2014 Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
4 5 6 7 8 9

;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: completion, minibuffer, multiple elements

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Gerd Moellmann's avatar
Gerd Moellmann committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Gerd Moellmann's avatar
Gerd Moellmann committed
14 15 16 17 18 19 20

;; 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
21
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Gerd Moellmann's avatar
Gerd Moellmann committed
22 23 24 25 26 27 28 29 30 31 32

;;; Commentary:

;; This code defines a function, `completing-read-multiple', which
;; provides the ability to read multiple strings in the minibuffer,
;; with completion.

;; 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
33 34
;; with a prespecified separator regexp.  For example, if the
;; separator regexp is ",", the strings 'alice', 'bob', and
Gerd Moellmann's avatar
Gerd Moellmann committed
35 36
;; 'eve' would be specified as 'alice,bob,eve'.

37 38
;; The default value for the separator regexp is the value of
;; `crm-default-separator' (comma).  The separator regexp may be
Gerd Moellmann's avatar
Gerd Moellmann committed
39 40
;; changed by modifying the value of `crm-separator'.

41
;; Contiguous strings of non-separator-characters are referred to as
Gerd Moellmann's avatar
Gerd Moellmann committed
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
;; 'elements'.  In the aforementioned example, the elements are:
;; 'alice', 'bob', and 'eve'.

;; Completion is available on a per-element basis.  For example, if
;; the contents of the minibuffer are 'alice,bob,eve' and point is
;; between 'l' and 'i', pressing TAB operates on the element 'alice'.

;; For the moment, I have decided to not bind any special behavior to
;; the separator key.  In the future, the separator key might be used
;; to provide completion in certain circumstances.  One of the reasons
;; why this functionality is not yet provided is that it is unclear to
;; the author what the precise circumstances are, under which
;; separator-invoked completion should be provided.

;; Design note: `completing-read-multiple' is modeled after
;; `completing-read'.  They should be similar -- it was intentional.

;; Some of this code started out as translation from C code in
Stefan Monnier's avatar
Stefan Monnier committed
60 61 62 63 64 65
;; src/minibuf.c to Emacs Lisp code.  After this code was rewritten in Elisp
;; and made to operate on any field, this file was completely rewritten to
;; just reuse that code.

;; Thanks to Sen Nagata <sen@eccosys.com> for the original version of the
;; code, and sorry for throwing it all out.  --Stef
Gerd Moellmann's avatar
Gerd Moellmann committed
66 67 68 69 70 71 72 73 74 75 76 77 78 79

;; Thanks to Richard Stallman for all of his help (many of the good
;; ideas in here are from him), Gerd Moellmann for his attention,
;; Stefan Monnier for responding with a code sample and comments very
;; early on, and Kai Grossjohann & Soren Dayton for valuable feedback.

;;; Questions and Thoughts:

;; -should `completing-read-multiple' allow a trailing separator in
;; a return value when REQUIRE-MATCH is t?  if not, should beep when a user
;; tries to exit the minibuffer via RET?

;; -tip: use M-f and M-b for ease of navigation among elements.

Stefan Monnier's avatar
Stefan Monnier committed
80 81 82 83 84 85 86 87 88 89 90 91
;; - the difference between minibuffer-completion-table and
;;   crm-completion-table is just crm--collection-fn.  In most cases it
;;   shouldn't make any difference.  But if a non-CRM completion function
;;   happens to be used, it will use minibuffer-completion-table and
;;   crm--collection-fn will try to make it do "more or less the right
;;   thing" by making it complete on the last element, which is about as
;;   good as we can hope for right now.
;;   I'm not sure if it's important or not.  Maybe we could just throw away
;;   crm-completion-table and crm--collection-fn, but there doesn't seem to
;;   be a pressing need for it, and since Sen did bother to write it, we may
;;   as well keep it, in case it helps.

Gerd Moellmann's avatar
Gerd Moellmann committed
92
;;; History:
93
;;
Gerd Moellmann's avatar
Gerd Moellmann committed
94 95 96 97 98
;; 2000-04-10:
;;
;;   first revamped version

;;; Code:
99 100
(defconst crm-default-separator "[ \t]*,[ \t]*"
  "Default separator regexp for `completing-read-multiple'.")
Gerd Moellmann's avatar
Gerd Moellmann committed
101 102

(defvar crm-separator crm-default-separator
103 104 105 106
  "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'.")
Gerd Moellmann's avatar
Gerd Moellmann committed
107

Stefan Monnier's avatar
Stefan Monnier committed
108 109 110 111 112 113 114
(defvar crm-local-completion-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map minibuffer-local-completion-map)
    (define-key map [remap minibuffer-complete] #'crm-complete)
    (define-key map [remap minibuffer-complete-word] #'crm-complete-word)
    (define-key map [remap minibuffer-completion-help] #'crm-completion-help)
    map)
Gerd Moellmann's avatar
Gerd Moellmann committed
115 116 117
  "Local keymap for minibuffer multiple input with completion.
Analog of `minibuffer-local-completion-map'.")

Stefan Monnier's avatar
Stefan Monnier committed
118 119 120 121 122 123 124 125 126 127
(defvar crm-local-must-match-map
  (let ((map (make-sparse-keymap)))
    ;; We'd want to have multiple inheritance here.
    (set-keymap-parent map minibuffer-local-must-match-map)
    (define-key map [remap minibuffer-complete] #'crm-complete)
    (define-key map [remap minibuffer-complete-word] #'crm-complete-word)
    (define-key map [remap minibuffer-completion-help] #'crm-completion-help)
    (define-key map [remap minibuffer-complete-and-exit]
      #'crm-complete-and-exit)
    map)
Gerd Moellmann's avatar
Gerd Moellmann committed
128 129 130
  "Local keymap for minibuffer multiple input with exact match completion.
Analog of `minibuffer-local-must-match-map' for crm.")

131 132 133 134 135
(defvar crm-completion-table nil
  "An alist whose elements' cars are strings, or an obarray.
This is a table used for completion by `completing-read-multiple' and its
supporting functions.")

Gerd Moellmann's avatar
Gerd Moellmann committed
136
;; this function evolved from a posting by Stefan Monnier
Stefan Monnier's avatar
Stefan Monnier committed
137
(defun crm--collection-fn (string predicate flag)
Gerd Moellmann's avatar
Gerd Moellmann committed
138 139 140 141 142 143 144 145
  "Function used by `completing-read-multiple' to compute completion values.
The value of STRING is the string to be completed.

The value of PREDICATE is a function to filter possible matches, or
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
Paul Eggert's avatar
Paul Eggert committed
146
`all-completions'.  A value of lambda specifies a test for an exact match.
Gerd Moellmann's avatar
Gerd Moellmann committed
147 148 149 150

For more information on STRING, PREDICATE, and FLAG, see the Elisp
Reference sections on 'Programmed Completion' and 'Basic Completion
Functions'."
Stefan Monnier's avatar
Stefan Monnier committed
151 152 153 154 155 156 157 158 159
  (let ((beg 0))
    (while (string-match crm-separator string beg)
      (setq beg (match-end 0)))
    (completion-table-with-context (substring string 0 beg)
                                   crm-completion-table
                                   (substring string beg)
                                   predicate
                                   flag)))

160
(defun crm--current-element ()
Gerd Moellmann's avatar
Gerd Moellmann committed
161
  "Parse the minibuffer to find the current element.
162 163 164
Return the element's boundaries as (START . END)."
  (let ((bob (minibuffer-prompt-end)))
    (cons (save-excursion
Stefan Monnier's avatar
Stefan Monnier committed
165 166
                  (if (re-search-backward crm-separator bob t)
                      (match-end 0)
167 168
              bob))
          (save-excursion
Stefan Monnier's avatar
Stefan Monnier committed
169 170
                (if (re-search-forward crm-separator nil t)
                    (match-beginning 0)
171 172 173 174 175 176 177 178 179
              (point-max))))))

(defmacro crm--completion-command (beg end &rest body)
  "Run BODY with BEG and END bound to the current element's boundaries."
  (declare (indent 2) (debug (sexp sexp &rest body)))
  `(let* ((crm--boundaries (crm--current-element))
          (,beg (car crm--boundaries))
          (,end (cdr crm--boundaries)))
     ,@body))
180

Stefan Monnier's avatar
Stefan Monnier committed
181
(defun crm-completion-help ()
Gerd Moellmann's avatar
Gerd Moellmann committed
182 183
  "Display a list of possible completions of the current minibuffer element."
  (interactive)
184 185
  (crm--completion-command beg end
    (minibuffer-completion-help beg end))
Gerd Moellmann's avatar
Gerd Moellmann committed
186 187
  nil)

Stefan Monnier's avatar
Stefan Monnier committed
188
(defun crm-complete ()
Gerd Moellmann's avatar
Gerd Moellmann committed
189 190 191 192 193
  "Complete the current element.
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)
194 195 196 197
  (crm--completion-command beg end
    (completion-in-region beg end
                          minibuffer-completion-table
                          minibuffer-completion-predicate)))
Stefan Monnier's avatar
Stefan Monnier committed
198 199 200 201 202

(defun crm-complete-word ()
  "Complete the current element at most a single word.
Like `minibuffer-complete-word' but for `completing-read-multiple'."
  (interactive)
203 204 205
  (crm--completion-command beg end
    (completion-in-region--single-word
     beg end minibuffer-completion-table minibuffer-completion-predicate)))
Stefan Monnier's avatar
Stefan Monnier committed
206 207

(defun crm-complete-and-exit ()
Gerd Moellmann's avatar
Gerd Moellmann committed
208 209 210 211
  "If all of the minibuffer elements are valid completions then exit.
All elements in the minibuffer must match.  If there is a mismatch, move point
to the location of mismatch and do not exit.

Stefan Monnier's avatar
Stefan Monnier committed
212
This function is modeled after `minibuffer-complete-and-exit'."
Gerd Moellmann's avatar
Gerd Moellmann committed
213
  (interactive)
Stefan Monnier's avatar
Stefan Monnier committed
214 215 216 217
  (let ((doexit t))
    (goto-char (minibuffer-prompt-end))
    (while
        (and doexit
218 219 220 221 222 223 224 225
             (crm--completion-command beg end
               (let ((end (copy-marker end t)))
                 (goto-char end)
                 (setq doexit nil)
                 (completion-complete-and-exit beg end
                                               (lambda () (setq doexit t)))
                 (goto-char end)
                 (not (eobp))))
226
             (looking-at crm-separator))
Stefan Monnier's avatar
Stefan Monnier committed
227
      ;; Skip to the next element.
228
      (goto-char (match-end 0)))
Stefan Monnier's avatar
Stefan Monnier committed
229
    (if doexit (exit-minibuffer))))
Gerd Moellmann's avatar
Gerd Moellmann committed
230

231 232
(defun crm--choose-completion-string (choice buffer base-position
                                             &rest ignored)
233 234 235 236
  "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."
237 238 239 240
  (let ((completion-no-auto-exit t)
        (choose-completion-string-functions nil))
    (choose-completion-string choice buffer base-position)
    t))
241

Gerd Moellmann's avatar
Gerd Moellmann committed
242
;; superemulates behavior of completing_read in src/minibuf.c
243 244
;; Use \\<crm-local-completion-map> so that help-enable-auto-load can
;; do its thing.  Any keymap that is defined will do.
Gerd Moellmann's avatar
Gerd Moellmann committed
245 246 247 248 249 250 251
;;;###autoload
(defun completing-read-multiple
  (prompt table &optional predicate require-match initial-input
	  hist def inherit-input-method)
  "Read multiple strings in the minibuffer, with completion.
By using this functionality, a user may specify multiple strings at a
single prompt, optionally using completion.
252
\\<crm-local-completion-map>
Gerd Moellmann's avatar
Gerd Moellmann committed
253
Multiple strings are specified by separating each of the strings with
254 255
a prespecified separator regexp.  For example, if the separator
regexp is \",\", the strings 'alice', 'bob', and 'eve' would be
Gerd Moellmann's avatar
Gerd Moellmann committed
256 257
specified as 'alice,bob,eve'.

258
The default value for the separator regexp is the value of
259 260
`crm-default-separator'.  You can change the separator regexp by
modifying the value of `crm-separator'.
Gerd Moellmann's avatar
Gerd Moellmann committed
261

262
Contiguous strings of non-separator-characters are referred to as
Gerd Moellmann's avatar
Gerd Moellmann committed
263 264 265 266 267 268 269
'elements'.  In the aforementioned example, the elements are: 'alice',
'bob', and 'eve'.

Completion is available on a per-element basis.  For example, if the
contents of the minibuffer are 'alice,bob,eve' and point is between
'l' and 'i', pressing TAB operates on the element 'alice'.

270 271
The return value of this function is a list of the read strings
with empty strings removed.
Gerd Moellmann's avatar
Gerd Moellmann committed
272 273 274 275

See the documentation for `completing-read' for details on the arguments:
PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
INHERIT-INPUT-METHOD."
276 277 278 279 280 281 282 283 284 285 286 287 288
  (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))
289 290
	       ;; If the user enters empty input, `read-from-minibuffer'
	       ;; returns the empty string, not DEF.
291 292 293 294
	       (input (read-from-minibuffer
		       prompt initial-input map
		       nil hist def inherit-input-method)))
	  (and def (string-equal input "") (setq input def))
295
          ;; Remove empty strings in the list of read strings.
296
	  (split-string input crm-separator t)))
297 298
    (remove-hook 'choose-completion-string-functions
		 'crm--choose-completion-string)))
Gerd Moellmann's avatar
Gerd Moellmann committed
299

Stefan Monnier's avatar
Stefan Monnier committed
300 301 302 303 304 305
(define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1")
(define-obsolete-function-alias
  'crm-minibuffer-completion-help 'crm-completion-help "23.1")
(define-obsolete-function-alias
  'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1")

Gerd Moellmann's avatar
Gerd Moellmann committed
306
;; testing and debugging
307 308 309 310 311 312 313 314 315 316 317 318
;; (defun crm-init-test-environ ()
;;   "Set up some variables for testing."
;;   (interactive)
;;   (setq my-prompt "Prompt: ")
;;   (setq my-table
;; 	'(("hi") ("there") ("man") ("may") ("mouth") ("ma")
;; 	  ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb")
;; 	  ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb")
;; 	  ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb")
;; 	  ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb")
;; 	  ))
;;   (setq my-separator ","))
Gerd Moellmann's avatar
Gerd Moellmann committed
319 320 321 322 323 324 325 326 327 328

;(completing-read-multiple my-prompt my-table)
;(completing-read-multiple my-prompt my-table nil t)
;(completing-read-multiple my-prompt my-table nil "match")
;(completing-read my-prompt my-table nil t)
;(completing-read my-prompt my-table nil "match")

(provide 'crm)

;;; crm.el ends here