lisp/emacs-lisp/crm.el

   1 ;;; crm.el --- read multiple strings with completion
   2
   3 ;; Copyright (C) 1985-1986, 1993-2011 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 character.  For example, if the
  34 ;; separator character is a comma, the strings 'alice', 'bob', and
  35 ;; 'eve' would be specified as 'alice,bob,eve'.
  36
  37 ;; The default value for the separator character is the value of
  38 ;; `crm-default-separator' (comma).  The separator character 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 ","
 100   "Default separator for `completing-read-multiple'.")
 101
 102 (defvar crm-separator crm-default-separator
 103   "Separator used for separating strings in `completing-read-multiple'.
 104 It should be a single character string that doesn't appear in the list of
 105 completion candidates.  Modify this value to make `completing-read-multiple'
 106 use a separator other 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 specifes 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 (defun crm-completion-help ()
 177   "Display a list of possible completions of the current minibuffer element."
 178   (interactive)
 179   (let ((ol (crm--select-current-element)))
 180     (unwind-protect
 181         (minibuffer-completion-help)
 182       (delete-overlay ol)))
 183   nil)
 184
 185 (defun crm-complete ()
 186   "Complete the current element.
 187 If no characters can be completed, display a list of possible completions.
 188
 189 Return t if the current element is now a valid match; otherwise return nil."
 190   (interactive)
 191   (let ((ol (crm--select-current-element)))
 192     (unwind-protect
 193         (minibuffer-complete)
 194       (delete-overlay ol))))
 195
 196 (defun crm-complete-word ()
 197   "Complete the current element at most a single word.
 198 Like `minibuffer-complete-word' but for `completing-read-multiple'."
 199   (interactive)
 200   (let ((ol (crm--select-current-element)))
 201     (unwind-protect
 202         (minibuffer-complete-word)
 203       (delete-overlay ol))))
 204
 205 (defun crm-complete-and-exit ()
 206   "If all of the minibuffer elements are valid completions then exit.
 207 All elements in the minibuffer must match.  If there is a mismatch, move point
 208 to the location of mismatch and do not exit.
 209
 210 This function is modeled after `minibuffer-complete-and-exit'."
 211   (interactive)
 212   (let ((doexit t))
 213     (goto-char (minibuffer-prompt-end))
 214     (while
 215         (and doexit
 216              (let ((ol (crm--select-current-element)))
 217                (goto-char (overlay-end ol))
 218                (unwind-protect
 219                    (catch 'exit
 220                      (minibuffer-complete-and-exit)
 221                      ;; This did not throw `exit', so there was a problem.
 222                      (setq doexit nil))
 223                  (goto-char (overlay-end ol))
 224                  (delete-overlay ol))
 225                (not (eobp))))
 226       ;; Skip to the next element.
 227       (forward-char 1))
 228     (if doexit (exit-minibuffer))))
 229
 230 (defun crm--choose-completion-string (choice buffer base-position
 231                                              &rest ignored)
 232   "Completion string chooser for `completing-read-multiple'.
 233 This is called from `choose-completion-string-functions'.
 234 It replaces the string that is currently being completed, without
 235 exiting the minibuffer."
 236   (let ((completion-no-auto-exit t)
 237         (choose-completion-string-functions nil))
 238     (choose-completion-string choice buffer base-position)
 239     t))
 240
 241 ;; superemulates behavior of completing_read in src/minibuf.c
 242 ;;;###autoload
 243 (defun completing-read-multiple
 244   (prompt table &optional predicate require-match initial-input
 245           hist def inherit-input-method)
 246   "Read multiple strings in the minibuffer, with completion.
 247 By using this functionality, a user may specify multiple strings at a
 248 single prompt, optionally using completion.
 249
 250 Multiple strings are specified by separating each of the strings with
 251 a prespecified separator character.  For example, if the separator
 252 character is a comma, the strings 'alice', 'bob', and 'eve' would be
 253 specified as 'alice,bob,eve'.
 254
 255 The default value for the separator character is the value of
 256 `crm-default-separator' (comma).  The separator character may be
 257 changed by modifying the value of `crm-separator'.
 258
 259 Contiguous strings of non-separator-characters are referred to as
 260 'elements'.  In the aforementioned example, the elements are: 'alice',
 261 'bob', and 'eve'.
 262
 263 Completion is available on a per-element basis.  For example, if the
 264 contents of the minibuffer are 'alice,bob,eve' and point is between
 265 'l' and 'i', pressing TAB operates on the element 'alice'.
 266
 267 The return value of this function is a list of the read strings.
 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 returns
 286                ;; 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           (split-string input crm-separator)))
 292     (remove-hook 'choose-completion-string-functions
 293                  'crm--choose-completion-string)))
 294
 295 (define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1")
 296 (define-obsolete-function-alias
 297   'crm-minibuffer-completion-help 'crm-completion-help "23.1")
 298 (define-obsolete-function-alias
 299   'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1")
 300
 301 ;; testing and debugging
 302 ;; (defun crm-init-test-environ ()
 303 ;;   "Set up some variables for testing."
 304 ;;   (interactive)
 305 ;;   (setq my-prompt "Prompt: ")
 306 ;;   (setq my-table
 307 ;;      '(("hi") ("there") ("man") ("may") ("mouth") ("ma")
 308 ;;        ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb")
 309 ;;        ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb")
 310 ;;        ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb")
 311 ;;        ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb")
 312 ;;        ))
 313 ;;   (setq my-separator ","))
 314
 315 ;(completing-read-multiple my-prompt my-table)
 316 ;(completing-read-multiple my-prompt my-table nil t)
 317 ;(completing-read-multiple my-prompt my-table nil "match")
 318 ;(completing-read my-prompt my-table nil t)
 319 ;(completing-read my-prompt my-table nil "match")
 320
 321 (provide 'crm)
 322
 323 ;;; crm.el ends here