[elpa] externals/consult 8e9d5e7358 1/2: Deprecate consult-completing-read-multiple (See #567)

[ELPA Syncer]

branch: externals/consult
commit 8e9d5e73582a38c1c48d5d392c42870aac1e9abf
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Deprecate consult-completing-read-multiple (See #567)
    
    Redirect back to the default implementation.
---
 CHANGELOG.org        |   1 +
 consult-selectrum.el |   9 ---
 consult.el           | 169 ++-------------------------------------------------
 3 files changed, 6 insertions(+), 173 deletions(-)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index 0c18b8bbc3..8155aa623c 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -6,6 +6,7 @@
 
 - Bugfixes
 - Removed obsolete =consult-recent-file-filter= and 
=consult-preview-excluded-hooks=
+- Deprecate =consult-completing-read-multiple=. See #567 for details.
 
 * Version 0.17 (2022-04-22)
 
diff --git a/consult-selectrum.el b/consult-selectrum.el
index d4c2ed0443..15ca6c5f7d 100644
--- a/consult-selectrum.el
+++ b/consult-selectrum.el
@@ -86,17 +86,8 @@ SPLIT is the splitter function."
      selectrum-highlight-candidates-function
      (consult-selectrum--split-wrap selectrum-highlight-candidates-function 
split))))
 
-(defun consult-selectrum--crm-adv (&rest args)
-  "Setup crm for Selectrum given ARGS."
-  (consult--minibuffer-with-setup-hook
-      (lambda ()
-        (when selectrum-is-active
-          (setq-local selectrum-default-value-format nil)))
-    (apply args)))
-
 (add-hook 'consult--completion-candidate-hook #'consult-selectrum--candidate)
 (add-hook 'consult--completion-refresh-hook #'consult-selectrum--refresh)
-(advice-add #'consult-completing-read-multiple :around 
#'consult-selectrum--crm-adv)
 (advice-add #'consult--completion-filter :around 
#'consult-selectrum--filter-adv)
 (advice-add #'consult--split-setup :around 
#'consult-selectrum--split-setup-adv)
 (define-key consult-async-map [remap selectrum-insert-current-candidate] 
'selectrum-next-page)
diff --git a/consult.el b/consult.el
index 535792a35b..c98d09183f 100644
--- a/consult.el
+++ b/consult.el
@@ -324,11 +324,6 @@ The dynamically computed arguments are appended."
 Each element of the list must have the form '(char name handler)."
   :type '(repeat (list character string function)))
 
-(defcustom consult-crm-prefix
-  (cons "  " (propertize "✓ " 'face 'success))
-  "Prefix for `consult-completing-read-multiple' candidates."
-  :type '(cons (string :tag "Not selected") (string :tag "Selected")))
-
 ;;;; Faces
 
 (defgroup consult-faces nil
@@ -405,10 +400,6 @@ Used by `consult-completion-in-region', `consult-yank' and 
`consult-history'.")
   '((t))
   "Face used to highlight buffers in `consult-buffer'.")
 
-(defface consult-crm-selected
-  '((t :inherit secondary-selection))
-  "Face used to highlight selected items in 
`consult-completing-read-multiple'.")
-
 (defface consult-line-number-prefix
   '((t :inherit line-number))
   "Face used to highlight line number prefixes.")
@@ -2031,9 +2022,6 @@ argument list :command and a highlighting function 
:highlight."
     map)
   "Keymap added for commands with asynchronous candidates.")
 
-(defvar consult-crm-map (make-sparse-keymap)
-  "Keymap added by `consult-completing-read-multiple'.")
-
 (defvar consult-narrow-map
   (let ((map (make-sparse-keymap)))
     (define-key map " " consult--narrow-space)
@@ -2656,159 +2644,12 @@ These configuration options are supported:
 
 ;;;;; Function: consult-completing-read-multiple
 
-(defun consult--crm-selected ()
-  "Return selected candidates from `consult-completing-read-multiple'."
-  (when (eq minibuffer-history-variable 'consult--crm-history)
-    (mapcar
-     (apply-partially #'get-text-property 0 'consult--crm-selected)
-     (all-completions
-      "" minibuffer-completion-table
-      (lambda (cand)
-        (and (stringp cand)
-             (get-text-property 0 'consult--crm-selected cand)
-             (or (not minibuffer-completion-predicate)
-                 (funcall minibuffer-completion-predicate cand))))))))
-
 ;;;###autoload
-(defun consult-completing-read-multiple (prompt table &optional
-                                                pred require-match 
initial-input
-                                                hist def inherit-input-method)
-  "Enhanced replacement for `completing-read-multiple'.
-See `completing-read-multiple' for the documentation of the arguments."
-  (let* ((orig-items (all-completions "" table pred))
-         (prefixed-orig-items
-          (funcall
-           (if-let (prefix (car consult-crm-prefix))
-               (apply-partially #'mapcar (lambda (item) (propertize item 
'line-prefix prefix)))
-             #'identity)
-           orig-items))
-         (format-item
-          (lambda (item)
-            ;; Restore original candidate in order to preserve formatting
-            (setq item (or (car (member item orig-items)) item)
-                  item (propertize item 'consult--crm-selected item
-                                   'line-prefix (cdr consult-crm-prefix)))
-            (add-face-text-property 0 (length item) 'consult-crm-selected 
'append item)
-            item))
-         (separator (or (bound-and-true-p crm-separator) "[ \t]*,[ \t]*"))
-         (hist-sym (pcase hist
-                     ('nil 'minibuffer-history)
-                     ('t 'consult--crm-history)
-                     (`(,sym . ,_) sym) ;; ignore history position
-                     (_ hist)))
-         (hist-val (symbol-value hist-sym))
-         (selected
-          (and initial-input
-               (or
-                ;; initial-input is multiple items
-                (string-match-p separator initial-input)
-                ;; initial-input is a single candidate
-                (member initial-input orig-items))
-               (prog1
-                   (mapcar format-item
-                           (split-string initial-input separator 'omit-nulls))
-                 (setq initial-input nil))))
-         (consult--crm-history (append (mapcar #'substring-no-properties 
selected) hist-val))
-         (items (append selected
-                        (seq-remove (lambda (x) (member x selected))
-                                    prefixed-orig-items)))
-         (orig-md (and (functionp table) (cdr (funcall table "" nil 
'metadata))))
-         (group-fun (alist-get 'group-function orig-md))
-         (sort-fun
-          (lambda (sort)
-            (pcase (alist-get sort orig-md)
-              ('identity `((,sort . identity)))
-              ((and sort (guard sort))
-               `((,sort . ,(lambda (cands)
-                             (setq cands (funcall sort cands))
-                             (nconc
-                              (seq-filter (lambda (x) (member x selected)) 
cands)
-                              (seq-remove (lambda (x) (member x selected)) 
cands)))))))))
-         (md
-          `(metadata
-            (group-function
-             . ,(lambda (cand transform)
-                  (if (get-text-property 0 'consult--crm-selected cand)
-                      (if transform cand "Selected")
-                    (or (and group-fun (funcall group-fun cand transform))
-                        (if transform cand "Select multiple")))))
-            ,@(funcall sort-fun 'cycle-sort-function)
-            ,@(funcall sort-fun 'display-sort-function)
-            ,@(seq-filter (lambda (x) (memq (car x) '(annotation-function
-                                                      affixation-function
-                                                      category)))
-                          orig-md)))
-         (overlay)
-         (command)
-         (depth (1+ (recursion-depth)))
-         (hook (make-symbol "consult--crm-pre-command-hook"))
-         (wrapper (make-symbol "consult--crm-command-wrapper")))
-    (fset wrapper
-          (lambda ()
-            (interactive)
-            (pcase (catch 'exit
-                     (call-interactively (setq this-command command))
-                     'consult--continue)
-              ('nil
-               (with-selected-window (active-minibuffer-window)
-                 (let ((item (minibuffer-contents-no-properties)))
-                   (when (equal item "")
-                     (throw 'exit nil))
-                   (setq selected (if (member item selected)
-                                      ;; Multi selections are not possible.
-                                      ;; This is probably no problem, since 
this is rarely desired.
-                                      (delete item selected)
-                                    (nconc selected (list (funcall format-item 
item))))
-                         consult--crm-history (append (mapcar 
#'substring-no-properties selected) hist-val)
-                         items (append selected
-                                       (seq-remove (lambda (x) (member x 
selected))
-                                                   prefixed-orig-items)))
-                   (when overlay
-                     (overlay-put overlay 'display
-                                  (when selected
-                                    (format " (%s selected): " (length 
selected)))))
-                   (delete-minibuffer-contents)
-                   (run-hook-with-args 'consult--completion-refresh-hook 
'reset))))
-              ('consult--continue nil)
-              (other (throw 'exit other)))))
-    (fset hook (lambda ()
-                 (when (and this-command (= depth (recursion-depth)))
-                   (setq command this-command this-command wrapper))))
-    (consult--minibuffer-with-setup-hook
-        (:append
-         (lambda ()
-           (when-let (pos (string-match-p "\\(?: (default[^)]+)\\)?: \\'" 
prompt))
-             (setq overlay (make-overlay (+ (point-min) pos) (+ (point-min) 
(length prompt))))
-             (when selected
-               (overlay-put overlay 'display (format " (%s selected): " 
(length selected)))))
-           (use-local-map (make-composed-keymap (list consult-crm-map) 
(current-local-map)))))
-      (unwind-protect
-          (progn
-            (add-hook 'pre-command-hook hook 90)
-            (let ((result
-                   (completing-read
-                    prompt
-                    (lambda (str pred action)
-                      (if (eq action 'metadata)
-                          md
-                        (complete-with-action action items str pred)))
-                    nil ;; predicate
-                    require-match
-                    initial-input
-                    'consult--crm-history
-                    "" ;; default
-                    inherit-input-method)))
-              (unless (or (equal result "") selected)
-                (setq selected (split-string result separator 'omit-nulls)
-                      consult--crm-history (append (mapcar 
#'substring-no-properties selected) hist-val)))))
-        (remove-hook 'pre-command-hook hook)))
-    (when (consp def)
-      (setq def (car def)))
-    (if (and def (not (equal "" def)) (not selected))
-        (split-string def separator 'omit-nulls)
-      (setq selected (mapcar #'substring-no-properties selected))
-      (set hist-sym (append selected (symbol-value hist-sym)))
-      selected)))
+(defun consult-completing-read-multiple (&rest args)
+  "Deprecated function; call `completing-read-multiple' with ARGS."
+  (advice-remove #'completing-read-multiple #'consult-completing-read-multiple)
+  (run-at-time 0 nil #'message "`consult-completing-read-multiple' has been 
deprecated")
+  (apply #'completing-read-multiple args))
 
 ;;;; Commands