lisp/emacs-lisp/crm.el

   1 ;;; crm.el --- read multiple strings with completion
   2
   3 ;; Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
   4 ;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
   5
   6 ;; Author: Sen Nagata <sen@eccosys.com>
   7 ;; Keywords: completion, minibuffer, multiple elements
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This code defines a function, `completing-read-multiple', which
  27 ;; provides the ability to read multiple strings in the minibuffer,
  28 ;; with completion.
  29
  30 ;; By using this functionality, a user may specify multiple strings at
  31 ;; a single prompt, optionally using completion.
  32
  33 ;; Multiple strings are specified by separating each of the strings
  34 ;; with a prespecified separator character.  For example, if the
  35 ;; separator character is a comma, the strings 'alice', 'bob', and
  36 ;; 'eve' would be specified as 'alice,bob,eve'.
  37
  38 ;; The default value for the separator character is the value of
  39 ;; `crm-default-separator' (comma).  The separator character may be
  40 ;; changed by modifying the value of `crm-separator'.
  41
  42 ;; Contiguous strings of non-separator-characters are referred to as
  43 ;; 'elements'.  In the aforementioned example, the elements are:
  44 ;; 'alice', 'bob', and 'eve'.
  45
  46 ;; Completion is available on a per-element basis.  For example, if
  47 ;; the contents of the minibuffer are 'alice,bob,eve' and point is
  48 ;; between 'l' and 'i', pressing TAB operates on the element 'alice'.
  49
  50 ;; For the moment, I have decided to not bind any special behavior to
  51 ;; the separator key.  In the future, the separator key might be used
  52 ;; to provide completion in certain circumstances.  One of the reasons
  53 ;; why this functionality is not yet provided is that it is unclear to
  54 ;; the author what the precise circumstances are, under which
  55 ;; separator-invoked completion should be provided.
  56
  57 ;; Design note: `completing-read-multiple' is modeled after
  58 ;; `completing-read'.  They should be similar -- it was intentional.
  59
  60 ;; Some of this code started out as translation from C code in
  61 ;; src/minibuf.c to Emacs Lisp code.  After this code was rewritten in Elisp
  62 ;; and made to operate on any field, this file was completely rewritten to
  63 ;; just reuse that code.
  64
  65 ;; Thanks to Sen Nagata <sen@eccosys.com> for the original version of the
  66 ;; code, and sorry for throwing it all out.  --Stef
  67
  68 ;; Thanks to Richard Stallman for all of his help (many of the good
  69 ;; ideas in here are from him), Gerd Moellmann for his attention,
  70 ;; Stefan Monnier for responding with a code sample and comments very
  71 ;; early on, and Kai Grossjohann & Soren Dayton for valuable feedback.
  72
  73 ;;; Questions and Thoughts:
  74
  75 ;; -should `completing-read-multiple' allow a trailing separator in
  76 ;; a return value when REQUIRE-MATCH is t?  if not, should beep when a user
  77 ;; tries to exit the minibuffer via RET?
  78
  79 ;; -tip: use M-f and M-b for ease of navigation among elements.
  80
  81 ;; - the difference between minibuffer-completion-table and
  82 ;;   crm-completion-table is just crm--collection-fn.  In most cases it
  83 ;;   shouldn't make any difference.  But if a non-CRM completion function
  84 ;;   happens to be used, it will use minibuffer-completion-table and
  85 ;;   crm--collection-fn will try to make it do "more or less the right
  86 ;;   thing" by making it complete on the last element, which is about as
  87 ;;   good as we can hope for right now.
  88 ;;   I'm not sure if it's important or not.  Maybe we could just throw away
  89 ;;   crm-completion-table and crm--collection-fn, but there doesn't seem to
  90 ;;   be a pressing need for it, and since Sen did bother to write it, we may
  91 ;;   as well keep it, in case it helps.
  92
  93 ;;; History:
  94 ;;
  95 ;; 2000-04-10:
  96 ;;
  97 ;;   first revamped version
  98
  99 ;;; Code:
 100 (defconst crm-default-separator ","
 101   "Default separator for `completing-read-multiple'.")
 102
 103 (defvar crm-separator crm-default-separator
 104   "Separator used for separating strings in `completing-read-multiple'.
 105 It should be a single character string that doesn't appear in the list of
 106 completion candidates.  Modify this value to make `completing-read-multiple'
 107 use a separator other than `crm-default-separator'.")
 108
 109 (defvar crm-local-completion-map
 110   (let ((map (make-sparse-keymap)))
 111     (set-keymap-parent map minibuffer-local-completion-map)
 112     (define-key map [remap minibuffer-complete] #'crm-complete)
 113     (define-key map [remap minibuffer-complete-word] #'crm-complete-word)
 114     (define-key map [remap minibuffer-completion-help] #'crm-completion-help)
 115     map)
 116   "Local keymap for minibuffer multiple input with completion.
 117 Analog of `minibuffer-local-completion-map'.")
 118
 119 (defvar crm-local-must-match-map
 120   (let ((map (make-sparse-keymap)))
 121     ;; We'd want to have multiple inheritance here.
 122     (set-keymap-parent map minibuffer-local-must-match-map)
 123     (define-key map [remap minibuffer-complete] #'crm-complete)
 124     (define-key map [remap minibuffer-complete-word] #'crm-complete-word)
 125     (define-key map [remap minibuffer-completion-help] #'crm-completion-help)
 126     (define-key map [remap minibuffer-complete-and-exit]
 127       #'crm-complete-and-exit)
 128     map)
 129   "Local keymap for minibuffer multiple input with exact match completion.
 130 Analog of `minibuffer-local-must-match-map' for crm.")
 131
 132 (defvar crm-completion-table nil
 133   "An alist whose elements' cars are strings, or an obarray.
 134 This is a table used for completion by `completing-read-multiple' and its
 135 supporting functions.")
 136
 137 ;; this function evolved from a posting by Stefan Monnier
 138 (defun crm--collection-fn (string predicate flag)
 139   "Function used by `completing-read-multiple' to compute completion values.
 140 The value of STRING is the string to be completed.
 141
 142 The value of PREDICATE is a function to filter possible matches, or
 143 nil if none.
 144
 145 The value of FLAG is used to specify the type of completion operation.
 146 A value of nil specifies `try-completion'.  A value of t specifies
 147 `all-completions'.  A value of lambda specifes a test for an exact match.
 148
 149 For more information on STRING, PREDICATE, and FLAG, see the Elisp
 150 Reference sections on 'Programmed Completion' and 'Basic Completion
 151 Functions'."
 152   (let ((beg 0))
 153     (while (string-match crm-separator string beg)
 154       (setq beg (match-end 0)))
 155     (completion-table-with-context (substring string 0 beg)
 156                                    crm-completion-table
 157                                    (substring string beg)
 158                                    predicate
 159                                    flag)))
 160
 161 (defun crm--select-current-element ()
 162   "Parse the minibuffer to find the current element.
 163 Place an overlay on the element, with a `field' property, and return it."
 164   (let* ((bob (minibuffer-prompt-end))
 165          (start (save-excursion
 166                   (if (re-search-backward crm-separator bob t)
 167                       (match-end 0)
 168                     bob)))
 169          (end (save-excursion
 170                 (if (re-search-forward crm-separator nil t)
 171                     (match-beginning 0)
 172                   (point-max))))
 173          (ol (make-overlay start end nil nil t)))
 174     (overlay-put ol 'field (make-symbol "crm"))
 175     ol))
 176
 177 (defun crm-completion-help ()
 178   "Display a list of possible completions of the current minibuffer element."
 179   (interactive)
 180   (let ((ol (crm--select-current-element)))
 181     (unwind-protect
 182         (minibuffer-completion-help)
 183       (delete-overlay ol)))
 184   nil)
 185
 186 (defun crm-complete ()
 187   "Complete the current element.
 188 If no characters can be completed, display a list of possible completions.
 189
 190 Return t if the current element is now a valid match; otherwise return nil."
 191   (interactive)
 192   (let ((ol (crm--select-current-element)))
 193     (unwind-protect
 194         (minibuffer-complete)
 195       (delete-overlay ol))))
 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   (let ((ol (crm--select-current-element)))
 202     (unwind-protect
 203         (minibuffer-complete-word)
 204       (delete-overlay ol))))
 205
 206 (defun crm-complete-and-exit ()
 207   "If all of the minibuffer elements are valid completions then exit.
 208 All elements in the minibuffer must match.  If there is a mismatch, move point
 209 to the location of mismatch and do not exit.
 210
 211 This function is modeled after `minibuffer-complete-and-exit'."
 212   (interactive)
 213   (let ((doexit t))
 214     (goto-char (minibuffer-prompt-end))
 215     (while
 216         (and doexit
 217              (let ((ol (crm--select-current-element)))
 218                (goto-char (overlay-end ol))
 219                (unwind-protect
 220                    (catch 'exit
 221                      (minibuffer-complete-and-exit)
 222                      ;; This did not throw `exit', so there was a problem.
 223                      (setq doexit nil))
 224                  (goto-char (overlay-end ol))
 225                  (delete-overlay ol))
 226                (not (eobp))))
 227       ;; Skip to the next element.
 228       (forward-char 1))
 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 character.  For example, if the separator
 253 character is a comma, the strings 'alice', 'bob', and 'eve' would be
 254 specified as 'alice,bob,eve'.
 255
 256 The default value for the separator character is the value of
 257 `crm-default-separator' (comma).  The separator character 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
 270 See the documentation for `completing-read' for details on the arguments:
 271 PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
 272 INHERIT-INPUT-METHOD."
 273   (unwind-protect
 274       (progn
 275         (add-hook 'choose-completion-string-functions
 276                   'crm--choose-completion-string)
 277         (let* ((minibuffer-completion-table #'crm--collection-fn)
 278                (minibuffer-completion-predicate predicate)
 279                ;; see completing_read in src/minibuf.c
 280                (minibuffer-completion-confirm
 281                 (unless (eq require-match t) require-match))
 282                (crm-completion-table table)
 283                (map (if require-match
 284                         crm-local-must-match-map
 285                       crm-local-completion-map))
 286                ;; If the user enters empty input, read-from-minibuffer returns
 287                ;; the empty string, not DEF.
 288                (input (read-from-minibuffer
 289                        prompt initial-input map
 290                        nil hist def inherit-input-method)))
 291           (and def (string-equal input "") (setq input def))
 292           (split-string input crm-separator)))
 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 ;; arch-tag: db1911d9-86c6-4a42-b32a-4910701b15a6
 325 ;;; crm.el ends here