emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/consult fb8043d 3/3: consult-completing-read-multiple:


From: ELPA Syncer
Subject: [elpa] externals/consult fb8043d 3/3: consult-completing-read-multiple: Add consult-crm-prefix
Date: Wed, 7 Jul 2021 17:57:07 -0400 (EDT)

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

    consult-completing-read-multiple: Add consult-crm-prefix
---
 README.org | 19 ++++++++--------
 consult.el | 77 +++++++++++++++++++++++++++++++++++---------------------------
 2 files changed, 54 insertions(+), 42 deletions(-)

diff --git a/README.org b/README.org
index 8d80492..454dae9 100644
--- a/README.org
+++ b/README.org
@@ -910,31 +910,32 @@ contributed.
  | consult-async-refresh-delay      | 0.25             | Refresh delay for 
asynchronous commands               |
  | consult-async-split-style        | 'perl            | Splitting style used 
for async commands               |
  | consult-async-split-styles-alist | ...              | Availabla splitting 
styles used for async commands    |
- | consult-bookmark-narrow          | ...              | Narrowing 
configuration for =consult-bookmark=        |
- | consult-buffer-filter            | ...              | Filter for 
=consult-buffer=                           |
+ | consult-bookmark-narrow          | ...              | Narrowing 
configuration for =consult-bookmark=          |
+ | consult-buffer-filter            | ...              | Filter for 
=consult-buffer=                             |
  | consult-buffer-sources           | ...              | List of virtual 
buffer sources                        |
+ | consult-crm-prefix               | ("  " . "✓ ")    | Prefix string for CRM 
candidates                      |
  | consult-find-command             | "find ..."       | Command line 
arguments for find                       |
  | consult-fontify-max-size         | 1048576          | Buffers larger than 
this limit are not fontified      |
  | consult-fontify-preserve         | t                | Preserve 
fontification for line-based commands.       |
  | consult-git-grep-command         | '(...)           | Command line 
arguments for git-grep                   |
- | consult-goto-line-numbers        | t                | Show line numbers for 
=consult-goto-line=             |
+ | consult-goto-line-numbers        | t                | Show line numbers for 
=consult-goto-line=               |
  | consult-grep-max-colums          | 250              | Maximal number of 
columns of the matching lines       |
  | consult-grep-command             | "grep ..."       | Command line 
arguments for grep                       |
- | consult-imenu-config             | ...              | Mode-specific 
configuration for =consult-imenu=       |
+ | consult-imenu-config             | ...              | Mode-specific 
configuration for =consult-imenu=         |
  | consult-line-numbers-widen       | t                | Show absolute line 
numbers when narrowing is active.  |
- | consult-line-point-placement     | 'match-beginning | Placement of the 
point used by =consult-line=         |
- | consult-line-start-from-top      | nil              | Start the 
=consult-line= search from the top          |
+ | consult-line-point-placement     | 'match-beginning | Placement of the 
point used by =consult-line=           |
+ | consult-line-start-from-top      | nil              | Start the 
=consult-line= search from the top            |
  | consult-locate-command           | "locate ..."     | Command line 
arguments for locate                     |
- | consult-mode-command-filter      | ...              | Filter for 
=consult-mode-command=                     |
+ | consult-mode-command-filter      | ...              | Filter for 
=consult-mode-command=                       |
  | consult-mode-histories           | ...              | Mode-specific history 
variables                       |
  | consult-narrow-key               | nil              | Narrowing prefix key 
during completion                |
  | consult-preview-key              | 'any             | Keys which triggers 
preview                           |
- | consult-preview-excluded-hooks   | ...              | List of =find-file= 
hooks to avoid during preview     |
+ | consult-preview-excluded-hooks   | ...              | List of =find-file= 
hooks to avoid during preview       |
  | consult-preview-max-count        | 10               | Maximum number of 
files to keep open during preview   |
  | consult-preview-max-size         | 10485760         | Files larger than 
this size are not previewed         |
  | consult-preview-raw-size         | 102400           | Files larger than 
this size are previewed in raw form |
  | consult-project-root-function    | nil              | Function which 
returns current project root           |
- | consult-register-narrow          | ...              | Narrowing 
configuration for =consult-register=        |
+ | consult-register-narrow          | ...              | Narrowing 
configuration for =consult-register=          |
  | consult-ripgrep-command          | "rg ..."         | Command line 
arguments for ripgrep                    |
  | consult-themes                   | nil              | List of themes to be 
presented for selection          |
  | consult-widen-key                | nil              | Widening key during 
completion                        |
diff --git a/consult.el b/consult.el
index e0d66f3..a4deae9 100644
--- a/consult.el
+++ b/consult.el
@@ -316,6 +316,11 @@ don't want to see epa password prompts."
 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 string))
+
 ;;;; Faces
 
 (defgroup consult-faces nil
@@ -2154,13 +2159,19 @@ These configuration options are supported:
                                                 hist def inherit-input-method)
   "Enhanced replacement for `completing-read-multiple'.
 See `completing-read-multiple' for the documentation of the arguments."
-  (let* ((orig-candidates (all-completions "" table pred))
+  (let* ((orig-items
+          (funcall
+           (if-let (prefix (car consult-crm-prefix))
+               (apply-partially #'mapcar (lambda (item) (propertize item 
'line-prefix prefix)))
+             #'identity)
+           (all-completions "" table pred)))
          (format-item
           (lambda (item)
             ;; Restore original candidate in order to preserve formatting
-            (setq item (substring (or (car (member item orig-candidates)) 
item)))
+            (setq item (propertize (or (car (member item orig-items)) item)
+                                   'consult--crm-selected t
+                                   'line-prefix (cdr consult-crm-prefix)))
             (add-face-text-property 0 (length item) 'consult-crm-selected 
'append item)
-            (put-text-property 0 (length item) 'consult--crm-selected t item)
             item))
          (separator (or (bound-and-true-p crm-separator) "[ \t]*,[ \t]*"))
          (hist-sym (pcase hist
@@ -2172,18 +2183,18 @@ See `completing-read-multiple' for the documentation of 
the arguments."
          (selected
           (and initial-input
                (or
-                ;; initial-input is multiple candidates
+                ;; initial-input is multiple items
                 (string-match-p separator initial-input)
                 ;; initial-input is a single candidate
-                (member initial-input orig-candidates))
+                (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))
-         (candidates (append selected
-                             (seq-remove (lambda (x) (member x selected))
-                                         orig-candidates)))
+         (items (append selected
+                        (seq-remove (lambda (x) (member x selected))
+                                    orig-items)))
          (select-item
           (lambda (item)
             (unless (equal item "")
@@ -2193,9 +2204,9 @@ See `completing-read-multiple' for the documentation of 
the arguments."
                                  (delete item selected)
                                (nconc selected (list (funcall format-item 
item))))
                     consult--crm-history (append (mapcar 
#'substring-no-properties selected) hist-val)
-                    candidates (append selected
-                                       (seq-remove (lambda (x) (member x 
selected))
-                                                   orig-candidates))))))
+                    items (append selected
+                                  (seq-remove (lambda (x) (member x selected))
+                                              orig-items))))))
          (orig-md (and (functionp table) (cdr (funcall table "" nil 
'metadata))))
          (group-fun (alist-get 'group-function orig-md))
          (sort-fun
@@ -2215,7 +2226,7 @@ See `completing-read-multiple' for the documentation of 
the arguments."
                   (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"))))
+                    (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
@@ -2255,27 +2266,27 @@ See `completing-read-multiple' for the documentation of 
the arguments."
                    (setq command this-command
                          this-command wrapper))))
     (unwind-protect
-      (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))))
-             (funcall update-overlay))
-           (run-hooks 'consult--crm-setup-hook)))
-        (add-hook 'pre-command-hook hook 90)
-        (funcall select-item
-                 (completing-read
-                  prompt
-                  (lambda (str pred action)
-                    (if (eq action 'metadata)
-                        md
-                      (complete-with-action action candidates str pred)))
-                  nil ;; predicate
-                  require-match
-                  initial-input
-                  'consult--crm-history
-                  "" ;; default
-                  inherit-input-method)))
+        (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))))
+                 (funcall update-overlay))
+               (run-hooks 'consult--crm-setup-hook)))
+          (add-hook 'pre-command-hook hook 90)
+          (funcall select-item
+                   (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)))
       (remove-hook 'pre-command-hook hook))
     (set hist-sym consult--crm-history)
     (when (consp def)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]