lisp/emacs-lisp/crm.el

   1 ;;; crm.el --- read multiple strings with completion
   2
   3 ;; Copyright (C) 1985-1986, 1993-2014 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--current-element ()
 161   "Parse the minibuffer to find the current element.
 162 Return the element's boundaries as (START . END)."
 163   (let ((bob (minibuffer-prompt-end)))
 164     (cons (save-excursion
 165                   (if (re-search-backward crm-separator bob t)
 166                       (match-end 0)
 167               bob))
 168           (save-excursion
 169                 (if (re-search-forward crm-separator nil t)
 170                     (match-beginning 0)
 171               (point-max))))))
 172
 173 (defmacro crm--completion-command (beg end &rest body)
 174   "Run BODY with BEG and END bound to the current element's boundaries."
 175   (declare (indent 2) (debug (sexp sexp &rest body)))
 176   `(let* ((crm--boundaries (crm--current-element))
 177           (,beg (car crm--boundaries))
 178           (,end (cdr crm--boundaries)))
 179      ,@body))
 180
 181 (defun crm-completion-help ()
 182   "Display a list of possible completions of the current minibuffer element."
 183   (interactive)
 184   (crm--completion-command beg end
 185     (minibuffer-completion-help beg end))
 186   nil)
 187
 188 (defun crm-complete ()
 189   "Complete the current element.
 190 If no characters can be completed, display a list of possible completions.
 191
 192 Return t if the current element is now a valid match; otherwise return nil."
 193   (interactive)
 194   (crm--completion-command beg end
 195     (completion-in-region beg end
 196                           minibuffer-completion-table
 197                           minibuffer-completion-predicate)))
 198
 199 (defun crm-complete-word ()
 200   "Complete the current element at most a single word.
 201 Like `minibuffer-complete-word' but for `completing-read-multiple'."
 202   (interactive)
 203   (crm--completion-command beg end
 204     (completion-in-region--single-word
 205      beg end minibuffer-completion-table minibuffer-completion-predicate)))
 206
 207 (defun crm-complete-and-exit ()
 208   "If all of the minibuffer elements are valid completions then exit.
 209 All elements in the minibuffer must match.  If there is a mismatch, move point
 210 to the location of mismatch and do not exit.
 211
 212 This function is modeled after `minibuffer-complete-and-exit'."
 213   (interactive)
 214   (let ((doexit t))
 215     (goto-char (minibuffer-prompt-end))
 216     (while
 217         (and doexit
 218              (crm--completion-command beg end
 219                (let ((end (copy-marker end t)))
 220                  (goto-char end)
 221                  (setq doexit nil)
 222                  (completion-complete-and-exit beg end
 223                                                (lambda () (setq doexit t)))
 224                  (goto-char end)
 225                  (not (eobp))))
 226              (looking-at crm-separator))
 227       ;; Skip to the next element.
 228       (goto-char (match-end 0)))
 229     (if doexit (exit-minibuffer))))
 230
 231 (defun crm--choose-completion-string (choice buffer base-position
 232                                              &rest ignored)
 233   "Completion string chooser for `completing-read-multiple'.
 234 This is called from `choose-completion-string-functions'.
 235 It replaces the string that is currently being completed, without
 236 exiting the minibuffer."
 237   (let ((completion-no-auto-exit t)
 238         (choose-completion-string-functions nil))
 239     (choose-completion-string choice buffer base-position)
 240     t))
 241
 242 ;; superemulates behavior of completing_read in src/minibuf.c
 243 ;;;###autoload
 244 (defun completing-read-multiple
 245   (prompt table &optional predicate require-match initial-input
 246           hist def inherit-input-method)
 247   "Read multiple strings in the minibuffer, with completion.
 248 By using this functionality, a user may specify multiple strings at a
 249 single prompt, optionally using completion.
 250
 251 Multiple strings are specified by separating each of the strings with
 252 a prespecified separator regexp.  For example, if the separator
 253 regexp is \",\", the strings 'alice', 'bob', and 'eve' would be
 254 specified as 'alice,bob,eve'.
 255
 256 The default value for the separator regexp is the value of
 257 `crm-default-separator' (comma).  The separator regexp may be
 258 changed by modifying the value of `crm-separator'.
 259
 260 Contiguous strings of non-separator-characters are referred to as
 261 'elements'.  In the aforementioned example, the elements are: 'alice',
 262 'bob', and 'eve'.
 263
 264 Completion is available on a per-element basis.  For example, if the
 265 contents of the minibuffer are 'alice,bob,eve' and point is between
 266 'l' and 'i', pressing TAB operates on the element 'alice'.
 267
 268 The return value of this function is a list of the read strings
 269 with empty strings removed.
 270
 271 See the documentation for `completing-read' for details on the arguments:
 272 PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
 273 INHERIT-INPUT-METHOD."
 274   (unwind-protect
 275       (progn
 276         (add-hook 'choose-completion-string-functions
 277                   'crm--choose-completion-string)
 278         (let* ((minibuffer-completion-table #'crm--collection-fn)
 279                (minibuffer-completion-predicate predicate)
 280                ;; see completing_read in src/minibuf.c
 281                (minibuffer-completion-confirm
 282                 (unless (eq require-match t) require-match))
 283                (crm-completion-table table)
 284                (map (if require-match
 285                         crm-local-must-match-map
 286                       crm-local-completion-map))
 287                ;; If the user enters empty input, `read-from-minibuffer'
 288                ;; returns the empty string, not DEF.
 289                (input (read-from-minibuffer
 290                        prompt initial-input map
 291                        nil hist def inherit-input-method)))
 292           (and def (string-equal input "") (setq input def))
 293           ;; Remove empty strings in the list of read strings.
 294           (split-string input crm-separator t)))
 295     (remove-hook 'choose-completion-string-functions
 296                  'crm--choose-completion-string)))
 297
 298 (define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1")
 299 (define-obsolete-function-alias
 300   'crm-minibuffer-completion-help 'crm-completion-help "23.1")
 301 (define-obsolete-function-alias
 302   'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1")
 303
 304 ;; testing and debugging
 305 ;; (defun crm-init-test-environ ()
 306 ;;   "Set up some variables for testing."
 307 ;;   (interactive)
 308 ;;   (setq my-prompt "Prompt: ")
 309 ;;   (setq my-table
 310 ;;      '(("hi") ("there") ("man") ("may") ("mouth") ("ma")
 311 ;;        ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb")
 312 ;;        ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb")
 313 ;;        ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb")
 314 ;;        ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb")
 315 ;;        ))
 316 ;;   (setq my-separator ","))
 317
 318 ;(completing-read-multiple my-prompt my-table)
 319 ;(completing-read-multiple my-prompt my-table nil t)
 320 ;(completing-read-multiple my-prompt my-table nil "match")
 321 ;(completing-read my-prompt my-table nil t)
 322 ;(completing-read my-prompt my-table nil "match")
 323
 324 (provide 'crm)
 325
 326 ;;; crm.el ends here