[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/consult a2b7791 1/3: Move function
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/consult a2b7791 1/3: Move function |
|
Date: |
Wed, 7 Jul 2021 14:57:07 -0400 (EDT) |
branch: externals/consult
commit a2b77916b6096c3d012198aac8b0c74e6472fe03
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>
Move function
---
consult.el | 238 +++++++++++++++++++++++++++++++------------------------------
1 file changed, 120 insertions(+), 118 deletions(-)
diff --git a/consult.el b/consult.el
index 06f7be3..0035ad5 100644
--- a/consult.el
+++ b/consult.el
@@ -2018,6 +2018,126 @@ KEYMAP is a command-specific keymap."
:preview-key consult-preview-key
:transform #'identity))))
+;;;; Functions
+
+;;;;; Function: consult-completion-in-region
+
+(defun consult--insertion-preview (start end)
+ "State function for previewing a candidate in a specific region.
+The candidates are previewed in the region from START to END. This function is
+used as the `:state' argument for `consult--read' in the `consult-yank' family
+of functions and in `consult-completion-in-region'."
+ (unless (minibufferp)
+ (let (ov)
+ (lambda (cand restore)
+ (if restore
+ (when ov (delete-overlay ov))
+ (unless ov (setq ov (consult--overlay start end
+ 'invisible t
+ 'window (selected-window))))
+ ;; Use `add-face-text-property' on a copy of "cand in order to merge
face properties
+ (setq cand (copy-sequence cand))
+ (add-face-text-property 0 (length cand) 'consult-preview-insertion t
cand)
+ ;; Use the `before-string' property since the overlay might be empty.
+ (overlay-put ov 'before-string cand))))))
+
+;; Use minibuffer completion as the UI for completion-at-point
+;;;###autoload
+(defun consult-completion-in-region (start end collection &optional predicate)
+ "Prompt for completion of region in the minibuffer if non-unique.
+
+The function is called with 4 arguments: START END COLLECTION PREDICATE.
+The arguments and expected return value are as specified for
+`completion-in-region'. Use as a value for `completion-in-region-function'.
+
+The function can be configured via `consult-customize'.
+
+ (consult-customize consult-completion-in-region
+ :completion-styles (basic)
+ :cycle-threshold 3)
+
+These configuration options are supported:
+
+ * :cycle-threshold - Cycling threshold (def: `completion-cycle-threshold')
+ * :completion-styles - Use completion styles (def: `completion-styles')
+ * :require-match - Require matches when completing (def: nil)
+ * :prompt - The prompt string shown in the minibuffer"
+ (cl-letf* ((config (alist-get #'consult-completion-in-region
consult--read-config))
+ ;; Overwrite both the local and global value of
`completion-styles', such that the
+ ;; `completing-read' minibuffer sees the overwritten value in any
case. This is
+ ;; necessary if `completion-styles' is buffer-local.
+ ;; NOTE: The completion-styles will be overwritten for recursive
editing sessions!
+ (cs (or (plist-get config :completion-styles) completion-styles))
+ (completion-styles cs)
+ ((default-value 'completion-styles) cs)
+ (prompt (or (plist-get config :prompt) "Completion: "))
+ (require-match (plist-get config :require-match))
+ (preview-key (if (plist-member config :preview-key)
+ (plist-get config :preview-key)
+ consult-preview-key))
+ (initial (buffer-substring-no-properties start end))
+ (metadata (completion-metadata initial collection predicate))
+ (threshold (or (plist-get config :cycle-threshold)
(completion--cycle-threshold metadata)))
+ (all (completion-all-completions initial collection predicate
(length initial))))
+ ;; error if `threshold' is t or the improper list `all' is too short
+ (if (and threshold
+ (or (not (consp (ignore-errors (nthcdr threshold all))))
+ (and completion-cycling completion-all-sorted-completions)))
+ (completion--in-region start end collection predicate)
+ (let* ((limit (car (completion-boundaries initial collection predicate
"")))
+ (category (completion-metadata-get metadata 'category))
+ (exit-status 'finished)
+ (buffer (current-buffer))
+ (completion
+ (cond
+ ((atom all) nil)
+ ((and (consp all) (atom (cdr all)))
+ (setq exit-status 'sole)
+ (concat (substring initial 0 limit) (car all)))
+ (t (car
+ (consult--with-preview
+ preview-key
+ ;; preview state
+ (consult--insertion-preview start end)
+ ;; transformation function
+ (if (eq category 'file)
+ (if (file-name-absolute-p initial)
+ (lambda (_inp cand) (substitute-in-file-name
cand))
+ (lambda (_inp cand) (file-relative-name
(substitute-in-file-name cand))))
+ (lambda (_inp cand) cand))
+ ;; candidate function
+ (apply-partially #'run-hook-with-args-until-success
+ 'consult--completion-candidate-hook)
+ (let ((enable-recursive-minibuffers t))
+ (if (eq category 'file)
+ ;; When completing files with
consult-completion-in-region, the point in the
+ ;; minibuffer gets placed initially at the
beginning of the last path component.
+ ;; By using the filename as DIR argument (second
argument of read-file-name), it
+ ;; starts at the end of minibuffer contents, as for
other types of completion.
+ ;; However this is undefined behavior since initial
does not only contain the
+ ;; directory, but also the filename.
+ (read-file-name prompt initial initial
require-match nil predicate)
+ (completing-read prompt
+ ;; Evaluate completion table in the
original buffer.
+ ;; This is a reasonable thing to do
and required
+ ;; by some completion tables in
particular by lsp-mode.
+ ;; See
https://github.com/minad/vertico/issues/61.
+ (if (functionp collection)
+ (lambda (&rest args)
+ (with-current-buffer buffer
+ (apply collection args)))
+ collection)
+ predicate require-match
initial)))))))))
+ (if completion
+ (progn
+ (delete-region start end)
+ (insert (substring-no-properties completion))
+ (when-let (exit (plist-get completion-extra-properties
:exit-function))
+ (funcall exit completion exit-status))
+ t)
+ (message "No completion")
+ nil)))))
+
;;;; Commands
;;;;; Command: consult-multi-occur
@@ -2592,124 +2712,6 @@ narrowing and the settings `consult-goto-line-numbers'
and
nil 0 nil
(expand-file-name file))))
-;;;;; Command: consult-completion-in-region
-
-(defun consult--insertion-preview (start end)
- "State function for previewing a candidate in a specific region.
-The candidates are previewed in the region from START to END. This function is
-used as the `:state' argument for `consult--read' in the `consult-yank' family
-of functions and in `consult-completion-in-region'."
- (unless (minibufferp)
- (let (ov)
- (lambda (cand restore)
- (if restore
- (when ov (delete-overlay ov))
- (unless ov (setq ov (consult--overlay start end
- 'invisible t
- 'window (selected-window))))
- ;; Use `add-face-text-property' on a copy of "cand in order to merge
face properties
- (setq cand (copy-sequence cand))
- (add-face-text-property 0 (length cand) 'consult-preview-insertion t
cand)
- ;; Use the `before-string' property since the overlay might be empty.
- (overlay-put ov 'before-string cand))))))
-
-;; Use minibuffer completion as the UI for completion-at-point
-;;;###autoload
-(defun consult-completion-in-region (start end collection &optional predicate)
- "Prompt for completion of region in the minibuffer if non-unique.
-
-The function is called with 4 arguments: START END COLLECTION PREDICATE.
-The arguments and expected return value are as specified for
-`completion-in-region'. Use as a value for `completion-in-region-function'.
-
-The function can be configured via `consult-customize'.
-
- (consult-customize consult-completion-in-region
- :completion-styles (basic)
- :cycle-threshold 3)
-
-These configuration options are supported:
-
- * :cycle-threshold - Cycling threshold (def: `completion-cycle-threshold')
- * :completion-styles - Use completion styles (def: `completion-styles')
- * :require-match - Require matches when completing (def: nil)
- * :prompt - The prompt string shown in the minibuffer"
- (cl-letf* ((config (alist-get #'consult-completion-in-region
consult--read-config))
- ;; Overwrite both the local and global value of
`completion-styles', such that the
- ;; `completing-read' minibuffer sees the overwritten value in any
case. This is
- ;; necessary if `completion-styles' is buffer-local.
- ;; NOTE: The completion-styles will be overwritten for recursive
editing sessions!
- (cs (or (plist-get config :completion-styles) completion-styles))
- (completion-styles cs)
- ((default-value 'completion-styles) cs)
- (prompt (or (plist-get config :prompt) "Completion: "))
- (require-match (plist-get config :require-match))
- (preview-key (if (plist-member config :preview-key)
- (plist-get config :preview-key)
- consult-preview-key))
- (initial (buffer-substring-no-properties start end))
- (metadata (completion-metadata initial collection predicate))
- (threshold (or (plist-get config :cycle-threshold)
(completion--cycle-threshold metadata)))
- (all (completion-all-completions initial collection predicate
(length initial))))
- ;; error if `threshold' is t or the improper list `all' is too short
- (if (and threshold
- (or (not (consp (ignore-errors (nthcdr threshold all))))
- (and completion-cycling completion-all-sorted-completions)))
- (completion--in-region start end collection predicate)
- (let* ((limit (car (completion-boundaries initial collection predicate
"")))
- (category (completion-metadata-get metadata 'category))
- (exit-status 'finished)
- (buffer (current-buffer))
- (completion
- (cond
- ((atom all) nil)
- ((and (consp all) (atom (cdr all)))
- (setq exit-status 'sole)
- (concat (substring initial 0 limit) (car all)))
- (t (car
- (consult--with-preview
- preview-key
- ;; preview state
- (consult--insertion-preview start end)
- ;; transformation function
- (if (eq category 'file)
- (if (file-name-absolute-p initial)
- (lambda (_inp cand) (substitute-in-file-name
cand))
- (lambda (_inp cand) (file-relative-name
(substitute-in-file-name cand))))
- (lambda (_inp cand) cand))
- ;; candidate function
- (apply-partially #'run-hook-with-args-until-success
- 'consult--completion-candidate-hook)
- (let ((enable-recursive-minibuffers t))
- (if (eq category 'file)
- ;; When completing files with
consult-completion-in-region, the point in the
- ;; minibuffer gets placed initially at the
beginning of the last path component.
- ;; By using the filename as DIR argument (second
argument of read-file-name), it
- ;; starts at the end of minibuffer contents, as for
other types of completion.
- ;; However this is undefined behavior since initial
does not only contain the
- ;; directory, but also the filename.
- (read-file-name prompt initial initial
require-match nil predicate)
- (completing-read prompt
- ;; Evaluate completion table in the
original buffer.
- ;; This is a reasonable thing to do
and required
- ;; by some completion tables in
particular by lsp-mode.
- ;; See
https://github.com/minad/vertico/issues/61.
- (if (functionp collection)
- (lambda (&rest args)
- (with-current-buffer buffer
- (apply collection args)))
- collection)
- predicate require-match
initial)))))))))
- (if completion
- (progn
- (delete-region start end)
- (insert (substring-no-properties completion))
- (when-let (exit (plist-get completion-extra-properties
:exit-function))
- (funcall exit completion exit-status))
- t)
- (message "No completion")
- nil)))))
-
;;;;; Command: consult-mode-command
(defun consult--mode-name (mode)