From 39c271d957fd44c3452ed1027050a2f17887621e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Omar=20Antol=C3=ADn?= Date: Sat, 13 Feb 2021 18:10:25 -0600 Subject: [PATCH 1/5] Add previews to consult-completion-in-region --- consult.el | 60 ++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 45 insertions(+), 15 deletions(-) diff --git a/consult.el b/consult.el index e88e9661..ace6e5df 100644 --- a/consult.el +++ b/consult.el @@ -349,6 +349,10 @@ should not be considered as stable as the public API." '((t :inherit consult-preview-line)) "Face used to for yank previews in `consult-yank'.") +(defface consult-preview-completion-in-region + '((t :inherit consult-preview-yank)) + "Face used to for completion previews in `consult-completion-in-region'.") + (defface consult-narrow-indicator '((t :inherit warning)) "Face used for the narrowing indicator.") @@ -2293,6 +2297,23 @@ The command respects narrowing and the settings ;;;;; Command: consult-completion-in-region +(defun consult--region-state (start end face) + "State function for previewing a candidate in a specific region. +The candidates are previewed in the region from START to END +using the given FACE. This function is used as the `:state' +argument for `consult--read' in the `consult-yank' family of +functions and in `consult-completion-in-region'." + (let (ov) + (lambda (cand restore) + (if restore + (when ov (delete-overlay ov)) + (unless ov (setq ov (consult--overlay start end 'invisible t))) + ;; 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) face 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) @@ -2322,10 +2343,26 @@ The arguments and expected return value are as specified for ;; 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 - "Completion: " initial initial t nil predicate) - (completing-read - "Completion: " collection predicate t initial))))))) + (when-let ((file (read-file-name + "Completion: " initial initial t nil predicate))) + (if (file-name-absolute-p initial) file (file-relative-name file))) + (consult--read + ;; `consult--read' interprets functions as async + ;; sources so if `collection' is a function we use + ;; the list of strings `all' instead; however if it + ;; is not a function we pass `collection' directly + ;; since it might be an obarray, a list of symbols or + ;; an alist containing symbols + (if (functionp collection) (nconc all nil) collection) + :prompt "Completion: " + :predicate predicate + :initial initial + :history t ;; disable history + :sort nil + :category category + :require-match t + :state + (consult--region-state start end 'consult-preview-completion-in-region)))))))) (if (null completion) (progn (message "No completion") nil) (delete-region start end) @@ -2438,17 +2475,10 @@ If no MODES are specified, use currently active major and minor modes." :category 'consult-yank :require-match t :state - ;; If previous command is yank, hide previously yanked text - (let* ((ov) (pt (point)) (mk (or (and (eq last-command 'yank) (mark t)) pt))) - (lambda (cand restore) - (if restore - (when ov (delete-overlay ov)) - (unless ov (setq ov (consult--overlay (min pt mk) (max pt mk) 'invisible t))) - ;; 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-yank t cand) - ;; Use the `before-string' property since the overlay might be empty. - (overlay-put ov 'before-string cand)))))) + (consult--region-state (point) + ;; If previous command is yank, hide previously yanked text + (or (and (eq last-command 'yank) (mark t)) (point)) + 'consult-preview-yank))) ;; Insert selected text. ;; Adapted from the Emacs yank function. From 0266e6bb4859aa394cbf7a2806488e456a8b1647 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Omar=20Antol=C3=ADn?= Date: Sun, 14 Feb 2021 12:42:52 -0600 Subject: [PATCH 2/5] Always return full candidate --- consult.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/consult.el b/consult.el index ace6e5df..960254a3 100644 --- a/consult.el +++ b/consult.el @@ -3675,8 +3675,11 @@ See `consult-grep' for more details regarding the asynchronous search." minibuffer-completion-table minibuffer-completion-predicate) content - ;; Return the first candidate of the sorted completion list. - (car (completion-all-sorted-completions)))))) + ;; Return the full first candidate of the sorted completion list. + (when-let ((completions (completion-all-sorted-completions))) + (concat + (substring content 0 (or (cdr (last completions)) 0)) + (car completions))))))) (defun consult--default-completion-filter (category _highlight) "Return default filter function given the completion CATEGORY. From e6a0944882749d4a24556771d183fb04e59ffec4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Omar=20Antol=C3=ADn?= Date: Sun, 14 Feb 2021 12:43:23 -0600 Subject: [PATCH 3/5] Use consult--with-preview directly This way we get previews for both file and non-file completion. --- consult.el | 53 +++++++++++++++++++++++++---------------------------- 1 file changed, 25 insertions(+), 28 deletions(-) diff --git a/consult.el b/consult.el index 960254a3..986288ee 100644 --- a/consult.el +++ b/consult.el @@ -2335,34 +2335,31 @@ The arguments and expected return value are as specified for ((and (consp all) (atom (cdr all))) (setq exit-status 'sole) (concat (substring initial 0 limit) (car all))) - (t (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. - (when-let ((file (read-file-name - "Completion: " initial initial t nil predicate))) - (if (file-name-absolute-p initial) file (file-relative-name file))) - (consult--read - ;; `consult--read' interprets functions as async - ;; sources so if `collection' is a function we use - ;; the list of strings `all' instead; however if it - ;; is not a function we pass `collection' directly - ;; since it might be an obarray, a list of symbols or - ;; an alist containing symbols - (if (functionp collection) (nconc all nil) collection) - :prompt "Completion: " - :predicate predicate - :initial initial - :history t ;; disable history - :sort nil - :category category - :require-match t - :state - (consult--region-state start end 'consult-preview-completion-in-region)))))))) + (t (let ((enable-recursive-minibuffers t) + (absolute (file-name-absolute-p initial))) + (car + (consult--with-preview + consult-preview-key + (consult--region-state + start end 'consult-preview-completion-in-region) + (lambda (_input cand) + (if (eq category 'file) + (let ((file (substitute-in-file-name cand))) + (if absolute file (file-relative-name file))) + cand)) + (apply-partially #'run-hook-with-args-until-success + 'consult--completion-candidate-hook) + (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 + "Completion: " initial initial t nil predicate) + (completing-read + "Completion: " collection predicate t initial))))))))) (if (null completion) (progn (message "No completion") nil) (delete-region start end) From e098c805d2a747077664962998ebe10f1ea2bd1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Omar=20Antol=C3=ADn?= Date: Sun, 14 Feb 2021 13:03:37 -0600 Subject: [PATCH 4/5] Allow preview-key to be configured in consult-config --- consult.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/consult.el b/consult.el index 986288ee..ca8c0b00 100644 --- a/consult.el +++ b/consult.el @@ -2339,7 +2339,10 @@ The arguments and expected return value are as specified for (absolute (file-name-absolute-p initial))) (car (consult--with-preview - consult-preview-key + (or (alist-get :preview-key + (alist-get 'consult-completion-in-region + consult-config)) + consult-preview-key) (consult--region-state start end 'consult-preview-completion-in-region) (lambda (_input cand) From eec5a9c1e7a7cbe13aeaac06919b46b3bd6faca3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Omar=20Antol=C3=ADn?= Date: Sun, 14 Feb 2021 13:35:29 -0600 Subject: [PATCH 5/5] Add support for cycling configured via completion-cycle-threshold --- consult.el | 104 ++++++++++++++++++++++++++++------------------------- 1 file changed, 56 insertions(+), 48 deletions(-) diff --git a/consult.el b/consult.el index ca8c0b00..4ddef6e0 100644 --- a/consult.el +++ b/consult.el @@ -2322,54 +2322,62 @@ functions and in `consult-completion-in-region'." 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'." - (let* ((initial (buffer-substring-no-properties start end)) - (limit (car (completion-boundaries initial collection predicate ""))) - (metadata (completion-metadata initial collection predicate)) - (category (completion-metadata-get metadata 'category)) - (all (completion-all-completions initial collection predicate - (length initial))) - (exit-status 'finished) - (completion - (cond - ((atom all) nil) - ((and (consp all) (atom (cdr all))) - (setq exit-status 'sole) - (concat (substring initial 0 limit) (car all))) - (t (let ((enable-recursive-minibuffers t) - (absolute (file-name-absolute-p initial))) - (car - (consult--with-preview - (or (alist-get :preview-key - (alist-get 'consult-completion-in-region - consult-config)) - consult-preview-key) - (consult--region-state - start end 'consult-preview-completion-in-region) - (lambda (_input cand) - (if (eq category 'file) - (let ((file (substitute-in-file-name cand))) - (if absolute file (file-relative-name file))) - cand)) - (apply-partially #'run-hook-with-args-until-success - 'consult--completion-candidate-hook) - (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 - "Completion: " initial initial t nil predicate) - (completing-read - "Completion: " collection predicate t initial))))))))) - (if (null completion) - (progn (message "No completion") nil) - (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))) + (catch 'instead + (let* ((initial (buffer-substring-no-properties start end)) + (limit (car (completion-boundaries initial collection predicate ""))) + (metadata (completion-metadata initial collection predicate)) + (category (completion-metadata-get metadata 'category)) + (all (completion-all-completions initial collection predicate + (length initial))) + (exit-status 'finished) + (completion + (cond + ((and completion-cycle-threshold + (not (ignore-errors + ;; error if completion-cycle-threshold is t + ;; or the improper list all is too short + (consp (nthcdr completion-cycle-threshold all))))) + (throw 'instead + (completion--in-region start end collection predicate))) + ((atom all) nil) + ((and (consp all) (atom (cdr all))) + (setq exit-status 'sole) + (concat (substring initial 0 limit) (car all))) + (t (let ((enable-recursive-minibuffers t) + (absolute (file-name-absolute-p initial))) + (car + (consult--with-preview + (or (alist-get :preview-key + (alist-get 'consult-completion-in-region + consult-config)) + consult-preview-key) + (consult--region-state + start end 'consult-preview-completion-in-region) + (lambda (_input cand) + (if (eq category 'file) + (let ((file (substitute-in-file-name cand))) + (if absolute file (file-relative-name file))) + cand)) + (apply-partially #'run-hook-with-args-until-success + 'consult--completion-candidate-hook) + (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 + "Completion: " initial initial t nil predicate) + (completing-read + "Completion: " collection predicate t initial))))))))) + (if (null completion) + (progn (message "No completion") nil) + (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)))) ;;;;; Command: consult-mode-command