lisp/emacs-lisp/crm.el

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