From 265ec6007a606a36ca7e35214b3c9cc238244aed Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Mon, 22 Jan 2024 15:02:19 +0100
Subject: [PATCH] Adjust completion un/requoting in 'completing-read-multiple'

Teach 'completing-read-multiple' about 'completion--unquote', so it
can be used with completion tables that perform quoting.  Namely, this
allows reading multiple file names with:

  (completing-read-multiple "Files: " #'completion--file-name-table)

* lisp/emacs-lisp/crm.el (crm--table): New helper function.
(completing-read-multiple): Use it.
---
 lisp/emacs-lisp/crm.el | 65 ++++++++++++++++++++++++++++--------------
 1 file changed, 44 insertions(+), 21 deletions(-)

diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 32221047c20..b71475e0b37 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -341,6 +341,49 @@ that fails this command prompts you for the separator to use."
           (seq-filter (lambda (ov) (overlay-get ov 'crm-separator))
                       (overlays-in (minibuffer-prompt-end) (point-max))))))
 
+(defun crm--table (table s p a)
+  (let ((beg 0))
+    (while (string-match crm-current-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-current-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)))
+      ('completion--unquote
+       (let ((qbeg 0) (qend nil))
+         (while (and (string-match crm-current-separator s qbeg)
+                     ;; P is Point here, not Predicate.
+                     (<= (match-end 0) p))
+           (setq qbeg (match-end 0)))
+         (setq qend (or (string-match crm-current-separator s qbeg)
+                        (length s)))
+         (seq-let (ustring utable upoint requote)
+             (complete-with-action a table (substring s qbeg qend) (- p qbeg))
+           (list ustring utable upoint
+                 (lambda (uresult op)
+                   (let ((result (funcall requote uresult op)))
+                     (pcase op
+                       (1 ;;try
+                        (if (stringp (car-safe result))
+                            (cons (concat (substring s 0 qbeg)
+                                          (car result)
+                                          (substring s qend))
+                                  (+ qbeg (cdr result)))
+                          result))
+                       (2 ;;all
+                        (when-let ((last (last result))
+                                   (base (or (cdr last) 0)))
+                          (setcdr last (+ base qbeg))
+                          result)))))))))
+      (_ (complete-with-action a table (substring s beg) p)))))
+
 ;;;###autoload
 (defun completing-read-multiple
   (prompt table &optional predicate require-match initial-input
@@ -370,27 +413,7 @@ with empty strings removed."
     (split-string
      (minibuffer-with-setup-hook
          #'completing-read-multiple-mode
-       (completing-read
-        prompt
-        (lambda (s p a)
-          (let ((beg 0))
-            (while (string-match crm-current-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-current-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)))))
+       (completing-read prompt (apply-partially #'crm--table table)
         predicate require-match initial-input hist def inherit-input-method))
      crm-current-separator t)))
 
-- 
2.39.5