[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)