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