unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 67464bc6db24d7045fa226403576711344fa608b 12375 bytes (raw)
name: lisp/emacs-lisp/crm.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
 
;;; crm.el --- read multiple strings with completion  -*- lexical-binding: t; -*-

;; Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc.

;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: completion, minibuffer, multiple elements

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This code defines a function, `completing-read-multiple', which
;; provides the ability to read multiple strings in the minibuffer,
;; with completion.  See that function's documentation for details.

;; For the moment, I have decided to not bind any special behavior to
;; the separator key.  In the future, the separator key might be used
;; to provide completion in certain circumstances.  One of the reasons
;; why this functionality is not yet provided is that it is unclear to
;; the author what the precise circumstances are, under which
;; separator-invoked completion should be provided.

;; Design note: `completing-read-multiple' is modeled after
;; `completing-read'.  They should be similar -- it was intentional.

;; Some of this code started out as translation from C code in
;; src/minibuf.c to Emacs Lisp code.  After this code was rewritten in Elisp
;; and made to operate on any field, this file was completely rewritten to
;; just reuse that code.

;; Thanks to Sen Nagata <sen@eccosys.com> for the original version of the
;; code, and sorry for throwing it all out.  --Stef

;; Thanks to Richard Stallman for all of his help (many of the good
;; ideas in here are from him), Gerd Moellmann for his attention,
;; Stefan Monnier for responding with a code sample and comments very
;; early on, and Kai Grossjohann & Soren Dayton for valuable feedback.

;;; Questions and Thoughts:

;; -should `completing-read-multiple' allow a trailing separator in
;; a return value when REQUIRE-MATCH is t?  if not, should beep when a user
;; tries to exit the minibuffer via RET?

;; -tip: use M-f and M-b for ease of navigation among elements.

;; - the difference between minibuffer-completion-table and
;;   crm-completion-table is just crm--collection-fn.  In most cases it
;;   shouldn't make any difference.  But if a non-CRM completion function
;;   happens to be used, it will use minibuffer-completion-table and
;;   crm--collection-fn will try to make it do "more or less the right
;;   thing" by making it complete on the last element, which is about as
;;   good as we can hope for right now.
;;   I'm not sure if it's important or not.  Maybe we could just throw away
;;   crm-completion-table and crm--collection-fn, but there doesn't seem to
;;   be a pressing need for it, and since Sen did bother to write it, we may
;;   as well keep it, in case it helps.

;;; History:
;;
;; 2000-04-10:
;;
;;   first revamped version

;;; Code:

;; FIXME I don't see that this needs to exist as a separate variable.
;; crm-separator should suffice.
(defconst crm-default-separator "[ \t]*,[ \t]*"
  "Default value of `crm-separator'.")

(defvar crm-separator crm-default-separator
  "Separator regexp used for separating strings in `completing-read-multiple'.
It should be a regexp that does not match the list of completion candidates.
The default value is `crm-default-separator'.")

(defvar crm-local-completion-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map minibuffer-local-completion-map)
    (define-key map [remap minibuffer-complete] #'crm-complete)
    (define-key map [remap minibuffer-complete-word] #'crm-complete-word)
    (define-key map [remap minibuffer-completion-help] #'crm-completion-help)
    map)
  "Local keymap for minibuffer multiple input with completion.
Analog of `minibuffer-local-completion-map'.")

(defvar crm-local-must-match-map
  (let ((map (make-sparse-keymap)))
    ;; We'd want to have multiple inheritance here.
    (set-keymap-parent map minibuffer-local-must-match-map)
    (define-key map [remap minibuffer-complete] #'crm-complete)
    (define-key map [remap minibuffer-complete-word] #'crm-complete-word)
    (define-key map [remap minibuffer-completion-help] #'crm-completion-help)
    (define-key map [remap minibuffer-complete-and-exit]
      #'crm-complete-and-exit)
    map)
  "Local keymap for minibuffer multiple input with exact match completion.
Analog of `minibuffer-local-must-match-map' for crm.")

(defvar crm-completion-table nil
  "An alist whose elements' cars are strings, or an obarray.
This is a table used for completion by `completing-read-multiple' and its
supporting functions.")

;; this function evolved from a posting by Stefan Monnier
(defun crm--collection-fn (string predicate flag)
  "Function used by `completing-read-multiple' to compute completion values.
The value of STRING is the string to be completed.

The value of PREDICATE is a function to filter possible matches, or
nil if none.

The value of FLAG is used to specify the type of completion operation.
A value of nil specifies `try-completion'.  A value of t specifies
`all-completions'.  A value of lambda specifies a test for an exact match.

For more information on STRING, PREDICATE, and FLAG, see the Elisp
Reference sections on “Programmed Completion” and “Basic Completion
Functions”."
  (let ((beg 0))
    (while (string-match crm-separator string beg)
      (setq beg (match-end 0)))
    (completion-table-with-context (substring string 0 beg)
                                   crm-completion-table
                                   (substring string beg)
                                   predicate
                                   flag)))

(defun crm--current-element ()
  "Parse the minibuffer to find the current element.
Return the element's boundaries as (START . END)."
  (let ((bob (minibuffer-prompt-end)))
    (cons (save-excursion
                  (if (re-search-backward crm-separator bob t)
                      (match-end 0)
              bob))
          (save-excursion
                (if (re-search-forward crm-separator nil t)
                    (match-beginning 0)
              (point-max))))))

(defmacro crm--completion-command (beg end &rest body)
  "Run BODY with BEG and END bound to the current element's boundaries."
  (declare (indent 2) (debug (sexp sexp body)))
  `(let* ((crm--boundaries (crm--current-element))
          (,beg (car crm--boundaries))
          (,end (cdr crm--boundaries)))
     ,@body))

(defun crm-completion-help ()
  "Display a list of possible completions of the current minibuffer element."
  (interactive)
  (crm--completion-command beg end
    (minibuffer-completion-help beg end))
  nil)

(defun crm-complete ()
  "Complete the current element.
If no characters can be completed, display a list of possible completions.

Return t if the current element is now a valid match; otherwise return nil."
  (interactive)
  (crm--completion-command beg end
    (completion-in-region beg end
                          minibuffer-completion-table
                          minibuffer-completion-predicate)))

(defun crm-complete-word ()
  "Complete the current element at most a single word.
Like `minibuffer-complete-word' but for `completing-read-multiple'."
  (interactive)
  (crm--completion-command beg end
    (completion-in-region--single-word
     beg end minibuffer-completion-table minibuffer-completion-predicate)))

(defun crm-complete-and-exit ()
  "If all of the minibuffer elements are valid completions then exit.
All elements in the minibuffer must match.  If there is a mismatch, move point
to the location of mismatch and do not exit.

This function is modeled after `minibuffer-complete-and-exit'."
  (interactive)
  (let ((doexit t))
    (goto-char (minibuffer-prompt-end))
    (while
        (and doexit
             (crm--completion-command beg end
               (let ((end (copy-marker end t)))
                 (goto-char end)
                 (setq doexit nil)
                 (completion-complete-and-exit beg end
                                               (lambda () (setq doexit t)))
                 (goto-char end)
                 (not (eobp))))
             (looking-at crm-separator))
      ;; Skip to the next element.
      (goto-char (match-end 0)))
    (if doexit (exit-minibuffer))))

(defun crm--choose-completion-string (choice buffer base-position
                                             &rest ignored)
  "Completion string chooser for `completing-read-multiple'.
This is called from `choose-completion-string-functions'.
It replaces the string that is currently being completed, without
exiting the minibuffer."
  (let ((completion-no-auto-exit t)
        (choose-completion-string-functions nil))
    (choose-completion-string choice buffer base-position)
    t))

;; superemulates behavior of completing_read in src/minibuf.c
;; Use \\<crm-local-completion-map> so that help-enable-autoload can
;; do its thing.  Any keymap that is defined will do.
;;;###autoload
(defun completing-read-multiple
  (prompt table &optional predicate require-match initial-input
	  hist def inherit-input-method)
  "Read multiple strings in the minibuffer, with completion.
The arguments are the same as those of `completing-read'.
\\<crm-local-completion-map>
Input multiple strings by separating each one with a string that
matches the regexp `crm-separator'.  For example, if the separator
regexp is \",\", entering \"alice,bob,eve\" specifies the strings
\"alice\", \"bob\", and \"eve\".

We refer to contiguous strings of non-separator-characters as
\"elements\".  In this example there are three elements.

Completion is available on a per-element basis.  For example, if the
contents of the minibuffer are \"alice,bob,eve\" and point is between
\"l\" and \"i\", pressing \\[minibuffer-complete] operates on the element \"alice\".

This function returns a list of the strings that were read,
with empty strings removed."
  (let* ((map (if require-match
                  crm-local-must-match-map
                crm-local-completion-map))
         input)
    (minibuffer-with-setup-hook
        (lambda ()
          (add-hook 'choose-completion-string-functions
                    'crm--choose-completion-string nil 'local)
          (setq-local minibuffer-completion-table #'crm--collection-fn)
          (setq-local minibuffer-completion-predicate predicate)
          ;; see completing_read in src/minibuf.c
          (setq-local minibuffer-completion-confirm
                      (unless (eq require-match t) require-match))
          (setq-local crm-completion-table table))
      (setq input (read-from-minibuffer
                   prompt initial-input map
                   nil hist def inherit-input-method)))
    ;; If the user enters empty input, `read-from-minibuffer'
    ;; returns the empty string, not DEF.
    (when (and def (string-equal input ""))
      (setq input (if (consp def) (car def) def)))
    ;; Remove empty strings in the list of read strings.
    (split-string input crm-separator t)))

;; testing and debugging
;; (defun crm-init-test-environ ()
;;   "Set up some variables for testing."
;;   (interactive)
;;   (setq my-prompt "Prompt: ")
;;   (setq my-table
;; 	'(("hi") ("there") ("man") ("may") ("mouth") ("ma")
;; 	  ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb")
;; 	  ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb")
;; 	  ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb")
;; 	  ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb")
;; 	  ))
;;   (setq my-separator ","))

;(completing-read-multiple my-prompt my-table)
;(completing-read-multiple my-prompt my-table nil t)
;(completing-read-multiple my-prompt my-table nil "match")
;(completing-read my-prompt my-table nil t)
;(completing-read my-prompt my-table nil "match")

(provide 'crm)

;;; crm.el ends here

debug log:

solving 67464bc6db ...
found 67464bc6db in https://yhetil.org/emacs-bugs/87fsxstdiy.fsf@miha-pc/
found e106815817 in https://git.savannah.gnu.org/cgit/emacs.git
preparing index
index prepared:
100644 e106815817e63f705595a7139c65d0e83a204c3d	lisp/emacs-lisp/crm.el

applying [1/1] https://yhetil.org/emacs-bugs/87fsxstdiy.fsf@miha-pc/
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index e106815817..67464bc6db 100644

Checking patch lisp/emacs-lisp/crm.el...
Applied patch lisp/emacs-lisp/crm.el cleanly.

index at:
100644 67464bc6db24d7045fa226403576711344fa608b	lisp/emacs-lisp/crm.el

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).