Improve 'completing-read-multiple'

This simplifies the implementation of crm.el, making it a thin wrapper
around 'completing-read'.  This obviates the need for bespoke commands
such as 'crm-complete' and 'crm-completion-help', and allows us to
remove incorrect code in minibuffer.el that tried to accommodate for
both 'completing-read' and 'completing-read-multiple'.
'crm-complete-and-exit' is still required to get the right behavior.
While we're at it, also add a command for changing 'crm-separator'
interactively, and an indication of 'completing-read-multiple' in
the *Completions* buffer mode line.

* lisp/emacs-lisp/crm.el (crm-local-completion-map)
(crm-local-must-match-map): No longer used, replace with obsolete
aliases of 'completing-read-multiple-mode-map' in favor of third party
code that uses these variables.
(crm-completion-table, crm--current-element)
(crm--completion-command, crm-completion-help)
(crm-complete, crm-complete-word)
(crm--choose-completion-string): No longer used, remove.
(crm-complete-and-exit): Update.
(read-string-matching-regexp): New local variable.
(read-string-matching-try-exit)
(crm-change-separator): New commands.
(read-string-matching-mode-map)
(completing-read-multiple-mode-map): New keymap variables.
(read-string-matching-mode)
(completing-read-multiple-mode)
(completions-multi-mode): New minor modes.
(read-string-matching, crm-completion-setup): New functions.
(completing-read-multiple): Update.

* lisp/minibuffer.el (minibuffer-sort-completions)
(minibuffer-narrow-buffer-completions)
(minibuffer--add-completions-predicate)
(minibuffer-narrow-completions-to-current)
(minibuffer-widen-completions)
(completions-auto-update): Delegate completion boundaries calculation.

* doc/lispref/minibuf.texi (Minibuffer Completion): Document c-r-m.
* etc/NEWS: Announce 'crm-change-separator'.

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 27ebadc8ee3e70919f33e8829705e53373954078..b565d4f095bdc6a8f2f021c1573b0d79429dce92 100644 (file)
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1254,6 +1254,36 @@ different function to completely override the normal behavior of
 @code{completing-read}.
 @end defvar
 
+@defun completing-read-multiple
+This function is like @code{completing-read}, except that it reads
+multiple inputs at once, and returns them as a list of strings.  The
+user types (or completes) the inputs in the minibuffer, separating
+them with strings that match @code{crm-separator}.  When displaying
+the completions list for @code{completing-read-multiple}, the mode
+line of the @file{*Completions*} buffer includes the an indicator that
+says @samp{Multi}.  Hovering over that indicator with the mouse shows
+help about the current input separator.
+@end defun
+
+@defvar crm-separator
+The value of this variable is a regular expression that matches
+@code{completing-read-multiple} input separators.  By default, this is
+set to @samp{[ \t]*,[ \t]*}, which means that a comma, possibly
+surrounded by spaces or tabs, separates
+@code{completing-read-multiple} inputs.
+@end defvar
+
+@deffn Command crm-change-separator
+This command, bound to @kbd{C-x ,} in the minibuffer during
+@code{completing-read-multiple}, changes the current input separator.
+It prompts for a new separator regular expression, and sets the local
+value of @code{crm-separator} to that regular expression.  With a
+prefix argument, this command also prompts for a replacement string
+(that should match the new separator) and replaces all of the existing
+separators in the minibuffer with that replacement string.
+@end deffn
+
+
 @node Completion Commands
 @subsection Minibuffer Commands that Do Completion
 

diff --git a/etc/NEWS b/etc/NEWS
index 7e42ed68ae6fdeaa7ca83f38ce6dad0a939bbf70..40bf5347ed933ec2d7e5487dc45d0a415c0dfe9d 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -786,6 +786,13 @@ it reverses the current order.
 This global minor mode automatically updates the *Completions* buffer
 as you type in the minibuffer.
 
++++
+*** New command 'crm-change-separator'.
+This command lets you change the separator that
+'completing-read-multiple' uses to split your input to multiple
+strings.  'completing-read-multiple' binds 'C-x ,' to
+'crm-change-separator' in the minibuffer.
+
 ** Pcomplete
 
 ---

diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 253dfc6237aa859330e2cc70550b9d2eab1821e7..164abb9997a594aa8a7d0f51a4045d89f7a10677 100644 (file)
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -74,6 +74,10 @@
 ;; 2000-04-10:
 ;;
 ;;   first revamped version
+;;
+;; 2024-01-03:
+;;
+;;   second revamped version
 
 ;;; Code:
 
@@ -83,99 +87,6 @@
   "Separator regexp used for separating strings in `completing-read-multiple'.
 It should be a regexp that does not match the list of completion candidates.")
 
-(defvar-keymap crm-local-completion-map
-  :doc "Local keymap for minibuffer multiple input with completion.
-Analog of `minibuffer-local-completion-map'."
-  :parent minibuffer-local-completion-map
-  "<remap> <minibuffer-complete>"        #'crm-complete
-  "<remap> <minibuffer-complete-word>"   #'crm-complete-word
-  "<remap> <minibuffer-completion-help>" #'crm-completion-help)
-
-(defvar-keymap crm-local-must-match-map
-  :doc "Local keymap for minibuffer multiple input with exact match completion.
-Analog of `minibuffer-local-must-match-map' for crm."
-  ;; We'd want to have multiple inheritance here.
-  :parent minibuffer-local-must-match-map
-  "<remap> <minibuffer-complete>"          #'crm-complete
-  "<remap> <minibuffer-complete-word>"     #'crm-complete-word
-  "<remap> <minibuffer-completion-help>"   #'crm-completion-help
-  "<remap> <minibuffer-complete-and-exit>" #'crm-complete-and-exit)
-
-(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)))
-
 (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
@@ -183,44 +94,126 @@ 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))
+  (let ((bob (minibuffer--completion-prompt-end))
+        (doexit t))
+    (goto-char bob)
     (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))))
+             (let* ((beg (save-excursion
+                           (if (re-search-backward crm-separator bob t)
+                               (match-end 0)
+                             bob)))
+                    (end (copy-marker
+                          (save-excursion
+                            (if (re-search-forward crm-separator nil t)
+                                (match-beginning 0)
+                              (point-max)))
+                          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)))
+      (when doexit
+       (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.
+(defvar-local read-string-matching-regexp nil
+  "Regular expression that minibuffer input must match.")
+
+(defun read-string-matching-try-exit ()
+  "Exit minibuffer only if the input matches `read-string-matching-regexp'."
+  (interactive nil minibuffer-mode)
+  (if (string-match-p read-string-matching-regexp (minibuffer-contents))
+      (exit-minibuffer)
+    (user-error "Input does not match \"%s\"" read-string-matching-regexp)))
+
+(defvar-keymap read-string-matching-mode-map
+  :doc "Keymap for `read-string-matching-mode'."
+  "<remap> <exit-minibuffer>" #'read-string-matching-try-exit)
+
+(define-minor-mode read-string-matching-mode
+  "Minor mode for reading a string matching some regular expression.
+
+`read-string-matching' enables this minor mode in the minibuffer."
+  :lighter nil)
+
+(defun read-string-matching (regexp prompt &optional
+                                    initial-input history
+                                    default-value inherit-input-method)
+  "Read a string matching REGEXP in the minibufffer.
+
+This function calls `read-string' with arguments PROMPT,
+INITIAL-INPUT, HISTORY, DEFAULT-VALUE and INHERIT-INPUT-METHOD."
+  (minibuffer-with-setup-hook
+      (lambda ()
+        (read-string-matching-mode)
+        (setq read-string-matching-regexp regexp))
+    (read-string prompt initial-input history default-value
+                 inherit-input-method)))
+
+(defun crm-change-separator (sep &optional rep)
+  "Set the current `crm-separator' to SEP.
+
+Non-nil optional argument REP says to replace occurrences of the
+old `crm-separator' in the current minibuffer contents with REP.
+
+Interactively, prompt for SEP.  With a prefix argument, prompt
+for REP as well."
+  (interactive
+   (let ((sep (read-regexp (format-prompt "New separator" crm-separator)
+                           crm-separator)))
+     (list sep
+           (when current-prefix-arg
+             (read-string-matching sep "Replace existing separators with: "))))
+   minibuffer-mode)
+  (when rep
+    (goto-char (minibuffer-prompt-end))
+    (while (re-search-forward crm-separator nil t)
+      (replace-match rep t t)))
+  (setq-local crm-separator sep))
+
+(define-minor-mode completions-multi-mode
+  "Minor mode for reading multiple strings in the minibuffer."
+  :lighter (:eval
+            (propertize " Multi" 'help-echo
+                        (concat
+                         "Insert multiple inputs by separating them with \""
+                         (buffer-local-value 'crm-separator
+                                             completion-reference-buffer)
+                         "\""))))
+
+(defun crm-completion-setup ()
+  "Enable `completions-multi-mode' in *Completions* buffer."
+  (with-current-buffer standard-output (completions-multi-mode)))
+
+(define-obsolete-variable-alias 'crm-local-completion-map
+  'completing-read-multiple-mode-map "30.1")
+
+(define-obsolete-variable-alias 'crm-local-must-match-map
+  'completing-read-multiple-mode-map "30.1")
+
+(defvar-keymap completing-read-multiple-mode-map
+  :doc "Keymap for `completing-read-multiple-mode'."
+  "<remap> <minibuffer-complete-and-exit>" #'crm-complete-and-exit
+  "C-x ," #'crm-change-separator)
+
+(define-minor-mode completing-read-multiple-mode
+  "Minor mode for reading multiple strings in the minibuffer."
+  :lighter nil
+  (if completing-read-multiple-mode
+      (add-hook 'completion-setup-hook #'crm-completion-setup 10 t)
+    (remove-hook 'completion-setup-hook #'crm-completion-setup t)))
+
 ;;;###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>
+\\<minibuffer-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
@@ -235,66 +228,29 @@ contents of the minibuffer are \"alice,bob,eve\" and point is between
 
 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)
-          (setq-local completion-list-insert-choice-function
-                      (lambda (start end choice)
-                        (if (and (stringp start) (stringp end))
-                            (let* ((beg (save-excursion
-                                          (goto-char (minibuffer-prompt-end))
-                                          (or (search-forward start nil t)
-                                              (search-forward-regexp crm-separator nil t)
-                                              (minibuffer-prompt-end))))
-                                   (end (save-excursion
-                                          (goto-char (point-max))
-                                          (or (search-backward end nil t)
-                                              (progn
-                                                (goto-char beg)
-                                                (search-forward-regexp crm-separator nil t))
-                                              (point-max)))))
-                              (completion--replace beg end choice))
-                          (completion--replace start end choice))))
-          ;; 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")
+  (split-string
+   (minibuffer-with-setup-hook
+       #'completing-read-multiple-mode
+     (completing-read
+      prompt
+      (lambda (s p a)
+        (let ((beg 0))
+          (while (string-match crm-separator s beg)
+            (setq beg (match-end 0)))
+          (pcase a
+            (`(boundaries . ,suffix)
+             (let ((bounds (completion-boundaries
+                            (substring s beg) table p
+                            (substring suffix 0 (string-match crm-separator suffix)))))
+               `(boundaries ,(+ (car bounds) beg) . ,(cdr bounds))))
+            ('metadata (completion-metadata (substring s beg) table p))
+            ('nil (let ((comp (complete-with-action a table (substring s beg) p)))
+                    (if (stringp comp)
+                        (concat (substring s 0 beg) comp)
+                      comp)))
+            (_ (complete-with-action a table (substring s beg) p)))))
+      predicate require-match initial-input hist def inherit-input-method))
+   crm-separator t))
 
 (provide 'crm)
 

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0189695463ca5f844c7483c0bb54b57772ca236e..b2529d9595c9310b7d9332d60538ff66bbcd61ce 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2658,7 +2658,7 @@ current order instead."
           (setq-local minibuffer-completions-sort-function
                       (or (completion-metadata-get
                            (completion--field-metadata
-                            (car (minibuffer--completion-boundaries)))
+                            (minibuffer-prompt-end))
                            'display-sort-function)
                           (pcase completions-sort
                             ('nil #'identity)
@@ -2675,9 +2675,7 @@ current order instead."
               (read-multiple-choice
                "Sort order" minibuffer-completions-sort-orders
                nil nil minibuffer-read-sort-order-with-completion)))))
-  (when completion-auto-help
-    (let ((beg-end (minibuffer--completion-boundaries)))
-      (minibuffer-completion-help (car beg-end) (cdr beg-end)))))
+  (when completion-auto-help (minibuffer-completion-help)))
 
 (defun minibuffer-completion-help (&optional start end)
   "Display a list of possible completions of the current minibuffer contents."
@@ -5150,9 +5148,7 @@ DESC is a string describing predicate PRED."
     (setq-local minibuffer-completion-predicate #'always))
   (add-function :after-while (local 'minibuffer-completion-predicate)
                 pred `((description . ,desc)))
-  (when completion-auto-help
-    (let ((beg-end (minibuffer--completion-boundaries)))
-      (minibuffer-completion-help (car beg-end) (cdr beg-end))))
+  (when completion-auto-help (minibuffer-completion-help))
   (when-let ((completions-buffer (get-buffer "*Completions*")))
     (with-current-buffer completions-buffer
       (completions-narrow-mode))))
@@ -5176,13 +5172,14 @@ exclude matches to current input from completions list."
   (let* ((table (make-hash-table :test #'equal))
          (beg-end (minibuffer--completion-boundaries))
          (beg (car beg-end)) (end (cdr beg-end))
-         (input (buffer-substring beg end))
+         (start (minibuffer-prompt-end))
+         (input (buffer-substring start (point-max)))
          (all (completion-all-completions
                input
                minibuffer-completion-table
                minibuffer-completion-predicate
-               (- (point) beg)
-               (completion--field-metadata beg)))
+               (- (point) start)
+               (completion--field-metadata start)))
          (last (last all)))
     (unless all
       (user-error "No matching completion candidates"))
@@ -5244,9 +5241,7 @@ remove all current restrictions without prompting."
                 (format-prompt "Remove completions restriction,s"
                                (caar desc-pred-alist))
                 desc-pred-alist nil t nil nil (caar desc-pred-alist))))))
-  (when completion-auto-help
-    (let ((beg-end (minibuffer--completion-boundaries)))
-      (minibuffer-completion-help (car beg-end) (cdr beg-end))))
+  (when completion-auto-help (minibuffer-completion-help))
   (when-let ((completions-buffer (and (not (minibuffer-narrow-completions-p))
                                       (get-buffer "*Completions*"))))
     (with-current-buffer completions-buffer
@@ -5534,8 +5529,7 @@ This applies to `completions-auto-update-mode', which see."
   (when (get-buffer-window "*Completions*" 0)
     (if completion-in-region-mode
         (completion-help-at-point)
-      (let ((beg-end (minibuffer--completion-boundaries)))
-        (minibuffer-completion-help (car beg-end) (cdr beg-end)))))
+      (minibuffer-completion-help)))
   (setq completions-auto-update-timer nil))
 
 (defun completions-auto-update-start-timer ()