| 1 | ;;; crm.el --- read multiple strings with completion |
| 2 | |
| 3 | ;; Copyright (C) 1985-1986, 1993-2013 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Sen Nagata <sen@eccosys.com> |
| 6 | ;; Keywords: completion, minibuffer, multiple elements |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation, either version 3 of the License, or |
| 13 | ;; (at your option) any later version. |
| 14 | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; 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/>. |
| 22 | |
| 23 | ;;; Commentary: |
| 24 | |
| 25 | ;; This code defines a function, `completing-read-multiple', which |
| 26 | ;; provides the ability to read multiple strings in the minibuffer, |
| 27 | ;; with completion. |
| 28 | |
| 29 | ;; By using this functionality, a user may specify multiple strings at |
| 30 | ;; a single prompt, optionally using completion. |
| 31 | |
| 32 | ;; Multiple strings are specified by separating each of the strings |
| 33 | ;; with a prespecified separator regexp. For example, if the |
| 34 | ;; separator regexp is ",", the strings 'alice', 'bob', and |
| 35 | ;; 'eve' would be specified as 'alice,bob,eve'. |
| 36 | |
| 37 | ;; The default value for the separator regexp is the value of |
| 38 | ;; `crm-default-separator' (comma). The separator regexp may be |
| 39 | ;; changed by modifying the value of `crm-separator'. |
| 40 | |
| 41 | ;; Contiguous strings of non-separator-characters are referred to as |
| 42 | ;; 'elements'. In the aforementioned example, the elements are: |
| 43 | ;; 'alice', 'bob', and 'eve'. |
| 44 | |
| 45 | ;; Completion is available on a per-element basis. For example, if |
| 46 | ;; the contents of the minibuffer are 'alice,bob,eve' and point is |
| 47 | ;; between 'l' and 'i', pressing TAB operates on the element 'alice'. |
| 48 | |
| 49 | ;; For the moment, I have decided to not bind any special behavior to |
| 50 | ;; the separator key. In the future, the separator key might be used |
| 51 | ;; to provide completion in certain circumstances. One of the reasons |
| 52 | ;; why this functionality is not yet provided is that it is unclear to |
| 53 | ;; the author what the precise circumstances are, under which |
| 54 | ;; separator-invoked completion should be provided. |
| 55 | |
| 56 | ;; Design note: `completing-read-multiple' is modeled after |
| 57 | ;; `completing-read'. They should be similar -- it was intentional. |
| 58 | |
| 59 | ;; Some of this code started out as translation from C code in |
| 60 | ;; src/minibuf.c to Emacs Lisp code. After this code was rewritten in Elisp |
| 61 | ;; and made to operate on any field, this file was completely rewritten to |
| 62 | ;; just reuse that code. |
| 63 | |
| 64 | ;; Thanks to Sen Nagata <sen@eccosys.com> for the original version of the |
| 65 | ;; code, and sorry for throwing it all out. --Stef |
| 66 | |
| 67 | ;; Thanks to Richard Stallman for all of his help (many of the good |
| 68 | ;; ideas in here are from him), Gerd Moellmann for his attention, |
| 69 | ;; Stefan Monnier for responding with a code sample and comments very |
| 70 | ;; early on, and Kai Grossjohann & Soren Dayton for valuable feedback. |
| 71 | |
| 72 | ;;; Questions and Thoughts: |
| 73 | |
| 74 | ;; -should `completing-read-multiple' allow a trailing separator in |
| 75 | ;; a return value when REQUIRE-MATCH is t? if not, should beep when a user |
| 76 | ;; tries to exit the minibuffer via RET? |
| 77 | |
| 78 | ;; -tip: use M-f and M-b for ease of navigation among elements. |
| 79 | |
| 80 | ;; - the difference between minibuffer-completion-table and |
| 81 | ;; crm-completion-table is just crm--collection-fn. In most cases it |
| 82 | ;; shouldn't make any difference. But if a non-CRM completion function |
| 83 | ;; happens to be used, it will use minibuffer-completion-table and |
| 84 | ;; crm--collection-fn will try to make it do "more or less the right |
| 85 | ;; thing" by making it complete on the last element, which is about as |
| 86 | ;; good as we can hope for right now. |
| 87 | ;; I'm not sure if it's important or not. Maybe we could just throw away |
| 88 | ;; crm-completion-table and crm--collection-fn, but there doesn't seem to |
| 89 | ;; be a pressing need for it, and since Sen did bother to write it, we may |
| 90 | ;; as well keep it, in case it helps. |
| 91 | |
| 92 | ;;; History: |
| 93 | ;; |
| 94 | ;; 2000-04-10: |
| 95 | ;; |
| 96 | ;; first revamped version |
| 97 | |
| 98 | ;;; Code: |
| 99 | (defconst crm-default-separator "[ \t]*,[ \t]*" |
| 100 | "Default separator regexp for `completing-read-multiple'.") |
| 101 | |
| 102 | (defvar crm-separator crm-default-separator |
| 103 | "Separator regexp used for separating strings in `completing-read-multiple'. |
| 104 | It should be a regexp that does not match the list of completion candidates. |
| 105 | Modify this value to make `completing-read-multiple' use a separator other |
| 106 | than `crm-default-separator'.") |
| 107 | |
| 108 | (defvar crm-local-completion-map |
| 109 | (let ((map (make-sparse-keymap))) |
| 110 | (set-keymap-parent map minibuffer-local-completion-map) |
| 111 | (define-key map [remap minibuffer-complete] #'crm-complete) |
| 112 | (define-key map [remap minibuffer-complete-word] #'crm-complete-word) |
| 113 | (define-key map [remap minibuffer-completion-help] #'crm-completion-help) |
| 114 | map) |
| 115 | "Local keymap for minibuffer multiple input with completion. |
| 116 | Analog of `minibuffer-local-completion-map'.") |
| 117 | |
| 118 | (defvar crm-local-must-match-map |
| 119 | (let ((map (make-sparse-keymap))) |
| 120 | ;; We'd want to have multiple inheritance here. |
| 121 | (set-keymap-parent map minibuffer-local-must-match-map) |
| 122 | (define-key map [remap minibuffer-complete] #'crm-complete) |
| 123 | (define-key map [remap minibuffer-complete-word] #'crm-complete-word) |
| 124 | (define-key map [remap minibuffer-completion-help] #'crm-completion-help) |
| 125 | (define-key map [remap minibuffer-complete-and-exit] |
| 126 | #'crm-complete-and-exit) |
| 127 | map) |
| 128 | "Local keymap for minibuffer multiple input with exact match completion. |
| 129 | Analog of `minibuffer-local-must-match-map' for crm.") |
| 130 | |
| 131 | (defvar crm-completion-table nil |
| 132 | "An alist whose elements' cars are strings, or an obarray. |
| 133 | This is a table used for completion by `completing-read-multiple' and its |
| 134 | supporting functions.") |
| 135 | |
| 136 | ;; this function evolved from a posting by Stefan Monnier |
| 137 | (defun crm--collection-fn (string predicate flag) |
| 138 | "Function used by `completing-read-multiple' to compute completion values. |
| 139 | The value of STRING is the string to be completed. |
| 140 | |
| 141 | The value of PREDICATE is a function to filter possible matches, or |
| 142 | nil if none. |
| 143 | |
| 144 | The value of FLAG is used to specify the type of completion operation. |
| 145 | A value of nil specifies `try-completion'. A value of t specifies |
| 146 | `all-completions'. A value of lambda specifies a test for an exact match. |
| 147 | |
| 148 | For more information on STRING, PREDICATE, and FLAG, see the Elisp |
| 149 | Reference sections on 'Programmed Completion' and 'Basic Completion |
| 150 | Functions'." |
| 151 | (let ((beg 0)) |
| 152 | (while (string-match crm-separator string beg) |
| 153 | (setq beg (match-end 0))) |
| 154 | (completion-table-with-context (substring string 0 beg) |
| 155 | crm-completion-table |
| 156 | (substring string beg) |
| 157 | predicate |
| 158 | flag))) |
| 159 | |
| 160 | (defun crm--select-current-element () |
| 161 | "Parse the minibuffer to find the current element. |
| 162 | Place an overlay on the element, with a `field' property, and return it." |
| 163 | (let* ((bob (minibuffer-prompt-end)) |
| 164 | (start (save-excursion |
| 165 | (if (re-search-backward crm-separator bob t) |
| 166 | (match-end 0) |
| 167 | bob))) |
| 168 | (end (save-excursion |
| 169 | (if (re-search-forward crm-separator nil t) |
| 170 | (match-beginning 0) |
| 171 | (point-max)))) |
| 172 | (ol (make-overlay start end nil nil t))) |
| 173 | (overlay-put ol 'field (make-symbol "crm")) |
| 174 | ol)) |
| 175 | |
| 176 | (defmacro crm--completion-command (command) |
| 177 | "Make COMMAND a completion command for `completing-read-multiple'." |
| 178 | `(let ((ol (crm--select-current-element))) |
| 179 | (unwind-protect |
| 180 | ,command |
| 181 | (delete-overlay ol)))) |
| 182 | |
| 183 | (defun crm-completion-help () |
| 184 | "Display a list of possible completions of the current minibuffer element." |
| 185 | (interactive) |
| 186 | (crm--completion-command (minibuffer-completion-help)) |
| 187 | nil) |
| 188 | |
| 189 | (defun crm-complete () |
| 190 | "Complete the current element. |
| 191 | If no characters can be completed, display a list of possible completions. |
| 192 | |
| 193 | Return t if the current element is now a valid match; otherwise return nil." |
| 194 | (interactive) |
| 195 | (crm--completion-command (minibuffer-complete))) |
| 196 | |
| 197 | (defun crm-complete-word () |
| 198 | "Complete the current element at most a single word. |
| 199 | Like `minibuffer-complete-word' but for `completing-read-multiple'." |
| 200 | (interactive) |
| 201 | (crm--completion-command (minibuffer-complete-word))) |
| 202 | |
| 203 | (defun crm-complete-and-exit () |
| 204 | "If all of the minibuffer elements are valid completions then exit. |
| 205 | All elements in the minibuffer must match. If there is a mismatch, move point |
| 206 | to the location of mismatch and do not exit. |
| 207 | |
| 208 | This function is modeled after `minibuffer-complete-and-exit'." |
| 209 | (interactive) |
| 210 | (let ((doexit t)) |
| 211 | (goto-char (minibuffer-prompt-end)) |
| 212 | (while |
| 213 | (and doexit |
| 214 | (let ((ol (crm--select-current-element))) |
| 215 | (goto-char (overlay-end ol)) |
| 216 | (unwind-protect |
| 217 | (catch 'exit |
| 218 | (minibuffer-complete-and-exit) |
| 219 | ;; This did not throw `exit', so there was a problem. |
| 220 | (setq doexit nil)) |
| 221 | (goto-char (overlay-end ol)) |
| 222 | (delete-overlay ol)) |
| 223 | (not (eobp))) |
| 224 | (looking-at crm-separator)) |
| 225 | ;; Skip to the next element. |
| 226 | (goto-char (match-end 0))) |
| 227 | (if doexit (exit-minibuffer)))) |
| 228 | |
| 229 | (defun crm--choose-completion-string (choice buffer base-position |
| 230 | &rest ignored) |
| 231 | "Completion string chooser for `completing-read-multiple'. |
| 232 | This is called from `choose-completion-string-functions'. |
| 233 | It replaces the string that is currently being completed, without |
| 234 | exiting the minibuffer." |
| 235 | (let ((completion-no-auto-exit t) |
| 236 | (choose-completion-string-functions nil)) |
| 237 | (choose-completion-string choice buffer base-position) |
| 238 | t)) |
| 239 | |
| 240 | ;; superemulates behavior of completing_read in src/minibuf.c |
| 241 | ;;;###autoload |
| 242 | (defun completing-read-multiple |
| 243 | (prompt table &optional predicate require-match initial-input |
| 244 | hist def inherit-input-method) |
| 245 | "Read multiple strings in the minibuffer, with completion. |
| 246 | By using this functionality, a user may specify multiple strings at a |
| 247 | single prompt, optionally using completion. |
| 248 | |
| 249 | Multiple strings are specified by separating each of the strings with |
| 250 | a prespecified separator regexp. For example, if the separator |
| 251 | regexp is \",\", the strings 'alice', 'bob', and 'eve' would be |
| 252 | specified as 'alice,bob,eve'. |
| 253 | |
| 254 | The default value for the separator regexp is the value of |
| 255 | `crm-default-separator' (comma). The separator regexp may be |
| 256 | changed by modifying the value of `crm-separator'. |
| 257 | |
| 258 | Contiguous strings of non-separator-characters are referred to as |
| 259 | 'elements'. In the aforementioned example, the elements are: 'alice', |
| 260 | 'bob', and 'eve'. |
| 261 | |
| 262 | Completion is available on a per-element basis. For example, if the |
| 263 | contents of the minibuffer are 'alice,bob,eve' and point is between |
| 264 | 'l' and 'i', pressing TAB operates on the element 'alice'. |
| 265 | |
| 266 | The return value of this function is a list of the read strings |
| 267 | with empty strings removed. |
| 268 | |
| 269 | See the documentation for `completing-read' for details on the arguments: |
| 270 | PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and |
| 271 | INHERIT-INPUT-METHOD." |
| 272 | (unwind-protect |
| 273 | (progn |
| 274 | (add-hook 'choose-completion-string-functions |
| 275 | 'crm--choose-completion-string) |
| 276 | (let* ((minibuffer-completion-table #'crm--collection-fn) |
| 277 | (minibuffer-completion-predicate predicate) |
| 278 | ;; see completing_read in src/minibuf.c |
| 279 | (minibuffer-completion-confirm |
| 280 | (unless (eq require-match t) require-match)) |
| 281 | (crm-completion-table table) |
| 282 | (map (if require-match |
| 283 | crm-local-must-match-map |
| 284 | crm-local-completion-map)) |
| 285 | ;; If the user enters empty input, `read-from-minibuffer' |
| 286 | ;; returns the empty string, not DEF. |
| 287 | (input (read-from-minibuffer |
| 288 | prompt initial-input map |
| 289 | nil hist def inherit-input-method))) |
| 290 | (and def (string-equal input "") (setq input def)) |
| 291 | ;; Remove empty strings in the list of read strings. |
| 292 | (split-string input crm-separator t))) |
| 293 | (remove-hook 'choose-completion-string-functions |
| 294 | 'crm--choose-completion-string))) |
| 295 | |
| 296 | (define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1") |
| 297 | (define-obsolete-function-alias |
| 298 | 'crm-minibuffer-completion-help 'crm-completion-help "23.1") |
| 299 | (define-obsolete-function-alias |
| 300 | 'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1") |
| 301 | |
| 302 | ;; testing and debugging |
| 303 | ;; (defun crm-init-test-environ () |
| 304 | ;; "Set up some variables for testing." |
| 305 | ;; (interactive) |
| 306 | ;; (setq my-prompt "Prompt: ") |
| 307 | ;; (setq my-table |
| 308 | ;; '(("hi") ("there") ("man") ("may") ("mouth") ("ma") |
| 309 | ;; ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb") |
| 310 | ;; ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb") |
| 311 | ;; ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb") |
| 312 | ;; ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb") |
| 313 | ;; )) |
| 314 | ;; (setq my-separator ",")) |
| 315 | |
| 316 | ;(completing-read-multiple my-prompt my-table) |
| 317 | ;(completing-read-multiple my-prompt my-table nil t) |
| 318 | ;(completing-read-multiple my-prompt my-table nil "match") |
| 319 | ;(completing-read my-prompt my-table nil t) |
| 320 | ;(completing-read my-prompt my-table nil "match") |
| 321 | |
| 322 | (provide 'crm) |
| 323 | |
| 324 | ;;; crm.el ends here |