New Upstream Release - consult-el
Ready changes
Summary
Merged new upstream version: 0.34 (was: 0.32).
Resulting package
Built on 2023-05-14T16:03 (took 5m55s)
The resulting binary packages can be installed (if you have the apt repository enabled) by running one of:
apt install -t fresh-releases elpa-consult
Lintian Result
Diff
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 9202293..1ab21d5 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -2,13 +2,53 @@
#+author: Daniel Mendler
#+language: en
+* Version 0.34 (2023-04-21)
+
+- Bugfixes.
+- =consult-org-heading=: Support tag inheritance.
+- Use pure =consult--fast-abbreviate-file-name= function to abbreviate file names
+ in =consult-buffer= and =consult-recent-file=. This ensures that abbreviation does
+ not access the file system (or worse remote hosts via Tramp) and is always
+ fast. The downside is that some paths may not get abbreviated.
+- Introduce buffer sources =consult--source-project-buffer-hidden= and
+ =consult--source-project-recent-file-hidden=. Set the buffer sources of
+ =consult-project= to =consult--source-project-buffer= and
+ =consult--source-project-recent-file= to ease customization.
+- =consult-buffer=: Explicitly save =window-next-buffers= and =window-prev-buffers=.
+- When previewing files literally (=consult-preview-raw-size=), set the multi byte
+ flag of the previewed buffer, such that UTF-8 buffers are not garbled.
+- Do not create preview cursor overlay. Instead display the actual point by
+ ensuring that =cursor-in-non-selected-windows= is set.
+
+* Version 0.33 (2023-03-11)
+
+- BREAKING: The key convention has been updated. The old key convention is not
+ supported anymore. Keys must now be strings valid according to =key-valid-p=.
+ This changes affects the keys =consult-narrow-key=, =consult-widen-key=,
+ =consult-preview-key= and the =:preview-key= of sources and passed as keyword
+ argument to =consult--read=. See the example configurations in the manual.
+- BREAKING: Remove the "." argument from =consult-grep-args= and
+ =consult-ripgrep-args=, since directories or files to search are appended by the
+ command line builder. Take this change into account, when you use a customized
+ version of those variables.
+- =consult-grep=: Add support for grep and find over multiple files or directory.
+ If the prefix argument DIR is a single C-u, prompt for comma separated
+ directories or files to search recursively via =completing-read-multiple=.
+- =consult-buffer= and =consult-isearch-history=: Align annotations dynamically
+ depending on candidate width, instead of computing the alignment beforehand.
+- Add the full path as =help-echo= property to abbreviated directory paths and
+ project names. Enable =tooltip-mode= and hover with the mouse over the
+ abbreviated directory path to see the full path.
+- =consult-grep/find/etc=: Print first line of stderr output if command failed.
+
* Version 0.32 (2023-02-06)
- Bugfixes
-- Update the key convention. Keys must now be strings valid according to
+- Deprecate the old key convention. Keys must now be strings valid according to
=key-valid-p=. This changes affects the keys =consult-narrow-key=,
=consult-widen-key=, =consult-preview-key= and the =:preview-key= of sources and
- passed as keyword argument to =consult--read=.
+ passed as keyword argument to =consult--read=. See the example configurations in
+ the manual.
- Add =consult-info= command (#634, #727).
- =consult-buffer=: Always select the first candidate when narrowing (#714).
- =consult-locate-args=: Remove =--existing=, which is not supported by =plocate= on
diff --git a/README.org b/README.org
index 7caf5a5..d671199 100644
--- a/README.org
+++ b/README.org
@@ -245,24 +245,25 @@ their descriptions.
term. After at least =consult-async-min-input= characters, the search gets
started. Consult splits the input string into two parts, if the first
character is a punctuation character, like =#=. For example
- =#regexps#filter-string=, is split at the second =#=. The string =regexps= is
- passed to Grep. Note that Consult transforms Emacs regular expressions to
- expressions understand by the search program. Always use Emacs regular
- expressions at the prompt. If you enter multiple regular expressions
- separated by space only lines matching all regular expressions are shown. In
- order to match space literally, escape the space with a backslash. The
- =filter-string= is passed to the /fast/ Emacs filtering to further narrow down
- the list of matches. This is particularly useful if you are using an advanced
- completion style like orderless. =consult-grep= supports preview. If the
- =consult-project-function= returns non-nil, =consult-grep= searches the
- current project directory. Otherwise the =default-directory= is searched. If
- =consult-grep= is invoked with prefix argument =C-u M-s g=, you can specify the
- directory manually.
+ =#regexps#filter-string=, is split at the second =#=. The string =regexps= is passed
+ to Grep. Note that Consult transforms Emacs regular expressions to expressions
+ understand by the search program. Always use Emacs regular expressions at the
+ prompt. If you enter multiple regular expressions separated by space only
+ lines matching all regular expressions are shown. In order to match space
+ literally, escape the space with a backslash. The =filter-string= is passed to
+ the /fast/ Emacs filtering to further narrow down the list of matches. This is
+ particularly useful if you are using an advanced completion style like
+ orderless. =consult-grep= supports preview. If the =consult-project-function=
+ returns non-nil, =consult-grep= searches the current project directory.
+ Otherwise the =default-directory= is searched. If =consult-grep= is invoked
+ with prefix argument =C-u M-s g=, you can specify one or more comma-separated files
+ and directories manually.
- =consult-find=, =consult-locate=: Find file by matching the path against a regexp.
Like for =consult-grep=, either the project root or the current directory is the
root directory for the search. The input string is treated similarly to
=consult-grep=, where the first part is passed to find, and the second part is
- used for Emacs filtering.
+ used for Emacs filtering. Prefix arguments to =consult-find= work just like those
+ for the consult grep commands.
** Compilation
:properties:
@@ -275,7 +276,7 @@ their descriptions.
#+findex: consult-xref
- =consult-compile-error=: Jump to a compilation error. Supports live preview
narrowing and recursive editing.
-- =consult-flymake=: Jump to flymake diagnostic. Supports live preview and
+- =consult-flymake=: Jump to Flymake diagnostic. Supports live preview and
recursive editing. The command supports narrowing. Press =e SPC=, =w SPC=, =n SPC=
to only show errors, warnings and notes respectively.
- =consult-xref=: Integration with xref. This function can be set as
@@ -382,7 +383,7 @@ their descriptions.
- =consult-completion-in-region=: In case you don't use [[https://github.com/minad/corfu][Corfu]] as your in-buffer
completion UI, this function can be set as =completion-in-region-function=. Then
your minibuffer completion UI (e.g., Vertico or Icomplete) will be used for
- =completion-at-point=. If you use Mct, you can give =mct-region-mode= a try.
+ =completion-at-point=.
#+begin_src emacs-lisp
;; Use `consult-completion-in-region' if Vertico is enabled.
;; Otherwise use the default `completion--in-region' function.
@@ -776,14 +777,14 @@ configuration examples.
;; Example configuration for Consult
(use-package consult
;; Replace bindings. Lazily loaded due by `use-package'.
- :bind (;; C-c bindings (mode-specific-map)
+ :bind (;; C-c bindings in `mode-specific-map'
("C-c M-x" . consult-mode-command)
("C-c h" . consult-history)
("C-c k" . consult-kmacro)
("C-c m" . consult-man)
("C-c i" . consult-info)
([remap Info-search] . consult-info)
- ;; C-x bindings (ctl-x-map)
+ ;; C-x bindings in `ctl-x-map'
("C-x M-:" . consult-complex-command) ;; orig. repeat-complex-command
("C-x b" . consult-buffer) ;; orig. switch-to-buffer
("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window
@@ -796,7 +797,7 @@ configuration examples.
("C-M-#" . consult-register)
;; Other custom bindings
("M-y" . consult-yank-pop) ;; orig. yank-pop
- ;; M-g bindings (goto-map)
+ ;; M-g bindings in `goto-map'
("M-g e" . consult-compile-error)
("M-g f" . consult-flymake) ;; Alternative: consult-flycheck
("M-g g" . consult-goto-line) ;; orig. goto-line
@@ -806,7 +807,7 @@ configuration examples.
("M-g k" . consult-global-mark)
("M-g i" . consult-imenu)
("M-g I" . consult-imenu-multi)
- ;; M-s bindings (search-map)
+ ;; M-s bindings in `search-map'
("M-s d" . consult-find)
("M-s D" . consult-locate)
("M-s g" . consult-grep)
@@ -1098,15 +1099,18 @@ out the following steps:
1. *Search through the issue tracker* if your issue has been reported before (and
has been resolved eventually) in the meantime.
-2. *Update all the relevant packages to the newest version*. This includes
- Consult, Compat, Vertico or other completion UIs, Marginalia, Embark and
- Orderless.
-3. Either use the default completion UI or ensure that exactly one of
+2. *Remove all packages involved in the suspected bug from your installation.*
+3. *Reinstall the newest version of all relevant packages*. Updating alone is not
+ sufficient, since package.el is known to cause miscompilation. The list of
+ packages includes Consult, Compat, Vertico or other completion UIs,
+ Marginalia, Embark and Orderless.
+4. Either use the default completion UI or ensure that exactly one of
=vertico-mode=, =mct-mode=, or =icomplete-mode= is enabled. The unsupported modes
- =selectrum-mode=, =ivy-mode=, =helm-mode= and =ido-ubiquitous-mode= must be disabled.
-4. Ensure that the =completion-styles= variable is properly configured. Try to set
+ =selectrum-mode=, =ivy-mode=, =helm-mode=, =ido-mode= and =ido-ubiquitous-mode= must be
+ disabled.
+5. Ensure that the =completion-styles= variable is properly configured. Try to set
=completion-styles= to a list including =substring= or =orderless=.
-5. Try to reproduce the issue by starting a bare bone Emacs instance with =emacs -Q=
+6. Try to reproduce the issue by starting a bare bone Emacs instance with =emacs -Q=
on the command line. Execute the following minimal code snippets in the
scratch buffer. This way we can exclude side effects due to configuration
settings. If other packages are relevant to reproduce the issue, include them
@@ -1193,6 +1197,7 @@ Code contributions:
- [[https://github.com/aagon][Aymeric Agon-Rambosson]]
- [[https://github.com/geolessel][Geoffrey Lessel]]
- [[https://github.com/piotrkwiecinski][Piotr Kwiecinski]]
+- [[https://github.com/rswgnu][Robert Weiner]]
Advice and useful discussions:
- [[https://github.com/clemera/][Clemens Radermacher]]
diff --git a/consult-icomplete.el b/consult-icomplete.el
deleted file mode 100644
index 4dcf2c1..0000000
--- a/consult-icomplete.el
+++ /dev/null
@@ -1,55 +0,0 @@
-;;; consult-icomplete.el --- Icomplete integration for Consult -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Integration code for the Icomplete completion system. This package
-;; is automatically loaded by Consult.
-
-;;; Code:
-
-(require 'consult)
-(require 'icomplete)
-
-(defun consult-icomplete--refresh ()
- "Refresh icomplete view."
- (when icomplete-mode
- (let ((top (car completion-all-sorted-completions)))
- (completion--flush-all-sorted-completions)
- ;; force flushing, otherwise narrowing is broken!
- (setq completion-all-sorted-completions nil)
- (when top
- (let* ((completions (completion-all-sorted-completions))
- (last (last completions))
- (before)) ;; completions before top
- ;; warning: completions is an improper list
- (while (consp completions)
- (if (equal (car completions) top)
- (progn
- (setcdr last (append (nreverse before) (cdr last)))
- (setq completion-all-sorted-completions completions
- completions nil))
- (push (car completions) before)
- (setq completions (cdr completions)))))))
- (icomplete-exhibit)))
-
-(add-hook 'consult--completion-refresh-hook #'consult-icomplete--refresh)
-
-(provide 'consult-icomplete)
-;;; consult-icomplete.el ends here
diff --git a/consult-org.el b/consult-org.el
index 6512c34..ed96e39 100644
--- a/consult-org.el
+++ b/consult-org.el
@@ -59,24 +59,30 @@
If PREFIX is non-nil, prefix the candidates with the buffer name.
MATCH, SCOPE and SKIP are as in `org-map-entries'."
- (let (buffer)
+ (let (buffer (idx 0))
(apply
#'org-map-entries
(lambda ()
- ;; Reset the cache when the buffer changes, since `org-get-outline-path' uses the cache
+ ;; Reset the cache when the buffer changes, since `org-get-outline-path' uses the cache
(unless (eq buffer (buffer-name))
(setq buffer (buffer-name)
org-outline-path-cache nil))
- (pcase-let ((`(_ ,level ,todo ,prio ,_hl ,tags) (org-heading-components))
- (cand (org-format-outline-path
- (org-get-outline-path 'with-self 'use-cache)
- most-positive-fixnum)))
+ (pcase-let* ((`(_ ,level ,todo ,prio ,_hl ,tags) (org-heading-components))
+ (tags (if org-use-tag-inheritance
+ (when-let ((tags (org-get-tags)))
+ (concat ":" (string-join tags ":") ":"))
+ tags))
+ (cand (org-format-outline-path
+ (org-get-outline-path 'with-self 'use-cache)
+ most-positive-fixnum)))
(when tags
- (setq tags (concat " " tags))
- (put-text-property 1 (length tags) 'face 'org-tag tags))
+ (put-text-property 0 (length tags) 'face 'org-tag tags))
(setq cand (if prefix
- (concat buffer " " cand tags (consult--tofu-encode (point)))
- (concat cand tags (consult--tofu-encode (point)))))
+ (concat buffer " " cand (and tags " ")
+ tags (consult--tofu-encode idx))
+ (concat cand (and tags " ")
+ tags (consult--tofu-encode idx))))
+ (cl-incf idx)
(add-text-properties 0 1
`(consult--candidate ,(point-marker)
consult-org--heading (,level ,todo . ,prio))
diff --git a/consult-register.el b/consult-register.el
index 72f1867..a0b2746 100644
--- a/consult-register.el
+++ b/consult-register.el
@@ -66,8 +66,8 @@ Each element of the list must have the form (char . name).")
(cl-defmethod consult-register--describe ((val marker))
"Describe marker register VAL."
(with-current-buffer (marker-buffer val)
- (save-restriction
- (save-excursion
+ (save-excursion
+ (save-restriction
(widen)
(goto-char val)
(let* ((line (line-number-at-pos))
@@ -77,9 +77,11 @@ Each element of the list must have the form (char . name).")
'multi-category `(consult-location . ,str)
'consult--type ?p))))))
-(cl-defmethod consult-register--describe ((val kmacro-register))
- "Describe kmacro register VAL."
- (list (consult-register--format-value val) 'consult--type ?k))
+(defmacro consult-register--describe-kmacro ()
+ "Generate method which describes kmacro register."
+ `(cl-defmethod consult-register--describe ((val ,(if (< emacs-major-version 30) 'kmacro-register 'kmacro)))
+ (list (consult-register--format-value val) 'consult--type ?k)))
+(consult-register--describe-kmacro)
(cl-defmethod consult-register--describe ((val (head file)))
"Describe file register VAL."
diff --git a/consult-vertico.el b/consult-vertico.el
deleted file mode 100644
index 79eb08f..0000000
--- a/consult-vertico.el
+++ /dev/null
@@ -1,63 +0,0 @@
-;;; consult-vertico.el --- Vertico integration for Consult -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Integration code for the Vertico completion system. This package
-;; is automatically loaded by Consult.
-
-;;; Code:
-
-(require 'consult)
-
-;; NOTE: It is not guaranteed that Vertico is available during compilation!
-(defvar vertico--input)
-(declare-function vertico--exhibit "ext:vertico")
-(declare-function vertico--candidate "ext:vertico")
-(declare-function vertico--all-completions "ext:vertico")
-
-(defun consult-vertico--candidate ()
- "Return current candidate for Consult preview."
- (and vertico--input (vertico--candidate 'highlight)))
-
-(defun consult-vertico--refresh ()
- "Refresh completion UI."
- (when vertico--input
- (setq vertico--input t)
- (vertico--exhibit)))
-
-(defun consult-vertico--filter-adv (orig pattern cands category highlight)
- "Advice for ORIG `consult--completion-filter' function.
-See `consult--completion-filter' for arguments PATTERN, CANDS, CATEGORY
-and HIGHLIGHT."
- (if (and (bound-and-true-p vertico-mode) (not highlight))
- ;; Optimize `consult--completion-filter' using the deferred highlighting
- ;; from Vertico. The advice is not necessary - it is a pure optimization.
- (nconc (car (vertico--all-completions pattern cands nil (length pattern)
- `(metadata (category . ,category))))
- nil)
- (funcall orig pattern cands category highlight)))
-
-(advice-add #'consult--completion-filter :around #'consult-vertico--filter-adv)
-(add-hook 'consult--completion-candidate-hook #'consult-vertico--candidate)
-(add-hook 'consult--completion-refresh-hook #'consult-vertico--refresh)
-(define-key consult-async-map [remap vertico-insert] 'vertico-next-group)
-
-(provide 'consult-vertico)
-;;; consult-vertico.el ends here
diff --git a/consult.el b/consult.el
index 80cbb93..f9ecfd8 100644
--- a/consult.el
+++ b/consult.el
@@ -5,9 +5,10 @@
;; Author: Daniel Mendler and Consult contributors
;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
;; Created: 2020
-;; Version: 0.32
-;; Package-Requires: ((emacs "27.1") (compat "29.1.3.2"))
+;; Version: 0.34
+;; Package-Requires: ((emacs "27.1") (compat "29.1.4.1"))
;; Homepage: https://github.com/minad/consult
+;; Keywords: matching, files, completion
;; This file is part of GNU Emacs.
@@ -52,7 +53,6 @@
(eval-when-compile
(require 'cl-lib)
(require 'subr-x))
-(require 'seq)
(require 'compat)
(require 'bookmark)
@@ -73,29 +73,30 @@
Good choices for this key are \"<\" and \"C-+\" for example. The
key must be a string accepted by `key-valid-p'."
- :type '(choice string (const nil)))
+ :type '(choice key (const nil)))
(defcustom consult-widen-key nil
"Key used for widening during completion.
If this key is unset, defaults to twice the `consult-narrow-key'.
The key must be a string accepted by `key-valid-p'."
- :type '(choice string (const nil)))
+ :type '(choice key (const nil)))
(defcustom consult-project-function
#'consult--default-project-function
"Function which returns project root directory.
-The function takes one boolargument MAY-PROMPT. If MAY-PROMPT is non-nil,
-the function may ask the prompt the user for a project directory.
-The root directory is used by `consult-buffer' and `consult-grep'."
+The function takes one boolean argument MAY-PROMPT. If
+MAY-PROMPT is non-nil, the function may ask the prompt the user
+for a project directory. The root directory is used by
+`consult-buffer' and `consult-grep'."
:type '(choice function (const nil)))
(defcustom consult-async-refresh-delay 0.2
- "Refreshing delay of the completion ui for asynchronous commands.
+ "Refreshing delay of the completion UI for asynchronous commands.
-The completion ui is only updated every `consult-async-refresh-delay'
-seconds. This applies to asynchronous commands like for example
-`consult-grep'."
+The completion UI is only updated every
+`consult-async-refresh-delay' seconds. This applies to
+asynchronous commands like for example `consult-grep'."
:type 'float)
(defcustom consult-async-input-throttle 0.4
@@ -118,7 +119,7 @@ asynchronous commands, e.g., `consult-grep'."
"Minimum number of letters needed, before asynchronous process is called.
This applies to asynchronous commands, e.g., `consult-grep'."
- :type 'integer)
+ :type 'natnum)
(defcustom consult-async-split-style 'perl
"Async splitting style, see `consult-async-split-styles-alist'."
@@ -196,7 +197,7 @@ See also `display-line-numbers-widen'."
This is necessary in order to prevent a large startup time
for navigation commands like `consult-line'."
- :type 'integer)
+ :type 'natnum)
(defcustom consult-buffer-filter
'("\\` "
@@ -217,14 +218,16 @@ character, the *Completions* buffer and a few log buffers."
consult--source-recent-file
consult--source-file-register
consult--source-bookmark
- consult--source-project-buffer
- consult--source-project-recent-file)
+ consult--source-project-buffer-hidden
+ consult--source-project-recent-file-hidden)
"Sources used by `consult-buffer'.
See also `consult-project-buffer-sources'.
See `consult--multi' for a description of the source data structure."
:type '(repeat symbol))
-(defcustom consult-project-buffer-sources nil
+(defcustom consult-project-buffer-sources
+ '(consult--source-project-buffer
+ consult--source-project-recent-file)
"Sources used by `consult-project-buffer'.
See also `consult-buffer-sources'.
See `consult--multi' for a description of the source data structure."
@@ -240,7 +243,7 @@ See `consult--multi' for a description of the source data structure."
(defcustom consult-grep-max-columns 300
"Maximal number of columns of grep output."
- :type 'integer)
+ :type 'natnum)
(defconst consult--grep-match-regexp
"\\`\\(?:\\./\\)?\\([^\n\0]+\\)\0\\([0-9]+\\)\\([-:\0]\\)"
@@ -248,7 +251,8 @@ See `consult--multi' for a description of the source data structure."
(defcustom consult-grep-args
'("grep" (consult--grep-exclude-args)
- "--null --line-buffered --color=never --ignore-case --line-number -I -r .")
+ "--null --line-buffered --color=never --ignore-case\
+ --with-filename --line-number -I -r")
"Command line arguments for grep, see `consult-grep'.
The dynamically computed arguments are appended.
Can be either a string, or a list of strings or expressions."
@@ -264,7 +268,7 @@ Can be either a string, or a list of strings or expressions."
(defcustom consult-ripgrep-args
"rg --null --line-buffered --color=never --max-columns=1000 --path-separator /\
- --smart-case --no-heading --line-number --search-zip ."
+ --smart-case --no-heading --with-filename --line-number --search-zip"
"Command line arguments for ripgrep, see `consult-ripgrep'.
The dynamically computed arguments are appended.
Can be either a string, or a list of strings or expressions."
@@ -301,20 +305,20 @@ individual keys must be strings accepted by `key-valid-p'."
(float :tag "Seconds" 0.1)
(const any))
(const :tag "No preview" nil)
- (string :tag "Key")
- (repeat :tag "List of keys" string)))
+ (key :tag "Key")
+ (repeat :tag "List of keys" key)))
(defcustom consult-preview-max-size 10485760
"Files larger than this byte limit are not previewed."
- :type 'integer)
+ :type 'natnum)
(defcustom consult-preview-raw-size 524288
"Files larger than this byte limit are previewed in raw form."
- :type 'integer)
+ :type 'natnum)
(defcustom consult-preview-max-count 10
"Number of files to keep open at once during preview."
- :type 'integer)
+ :type 'natnum)
(defcustom consult-preview-excluded-files nil
"List of regexps matched against names of files, which are not previewed."
@@ -452,9 +456,10 @@ Used by `consult-completion-in-region', `consult-yank' and `consult-history'.")
:foreground "#333"))
"Face used for thin line separators in `consult-register-window'.")
-;;;; History variables
+;;;; Input history variables
(defvar consult--keep-lines-history nil)
+(defvar consult--path-history nil)
(defvar consult--grep-history nil)
(defvar consult--find-history nil)
(defvar consult--man-history nil)
@@ -501,6 +506,12 @@ as the public API.")
This function can be called by custom completion systems from
outside the minibuffer.")
+(defvar consult--annotate-align-step 10
+ "Round candidate width.")
+
+(defvar consult--annotate-align-width 0
+ "Maximum candidate width used for annotation alignment.")
+
(defconst consult--tofu-char #x200000
"Special character used to encode line prefixes for disambiguation.
We use invalid characters outside the Unicode range.")
@@ -521,10 +532,10 @@ We use invalid characters outside the Unicode range.")
"Narrowing indicator overlay.")
(defvar consult--gc-threshold (* 64 1024 1024)
- "Large gc threshold for temporary increase.")
+ "Large GC threshold for temporary increase.")
(defvar consult--gc-percentage 0.5
- "Large gc percentage for temporary increase.")
+ "Large GC percentage for temporary increase.")
(defvar consult--process-chunk (* 1024 1024)
"Increase process output chunk size.")
@@ -541,6 +552,12 @@ We use invalid characters outside the Unicode range.")
;;;; Miscellaneous helper functions
+(defun consult--key-parse (key)
+ "Parse KEY or signal error if invalid."
+ (unless (key-valid-p key)
+ (error "%S is not a valid key definition; see `key-valid-p'" key))
+ (key-parse key))
+
(defun consult--in-buffer (fun &optional buffer)
"Ensure that FUN is executed inside BUFFER."
(unless buffer (setq buffer (current-buffer)))
@@ -570,11 +587,11 @@ We use invalid characters outside the Unicode range.")
Turn ARG into a list, and for each element either:
- split it if it a string.
- eval it if it is an expression."
- (mapcan (lambda (x)
- (if (stringp x)
- (split-string-and-unquote x)
- (ensure-list (eval x 'lexical))))
- (ensure-list arg)))
+ (seq-mapcat (lambda (x)
+ (if (stringp x)
+ (split-string-and-unquote x)
+ (ensure-list (eval x 'lexical))))
+ (ensure-list arg)))
(defun consult--command-split (str)
"Return command argument and options list given input STR."
@@ -588,9 +605,7 @@ Turn ARG into a list, and for each element either:
(defmacro consult--keep! (list form)
"Evaluate FORM for every element of LIST and keep the non-nil results."
(declare (indent 1))
- (let ((head (make-symbol "head"))
- (prev (make-symbol "prev"))
- (result (make-symbol "result")))
+ (cl-with-gensyms (head prev result)
`(let* ((,head (cons nil ,list))
(,prev ,head))
(while (cdr ,prev)
@@ -610,11 +625,11 @@ This macro is only needed to prevent memory leaking issues with
the upstream `minibuffer-with-setup-hook' macro.
FUN is the hook function and BODY opens the minibuffer."
(declare (indent 1) (debug t))
- (let ((hook (make-symbol "hook"))
+ (let ((hook (gensym "hook"))
(append))
(when (eq (car-safe fun) :append)
(setq append '(t) fun (cadr fun)))
- `(let ((,hook (make-symbol "consult--minibuffer-setup")))
+ `(let ((,hook (make-symbol "consult--minibuffer-setup-hook")))
(fset ,hook (lambda ()
(remove-hook 'minibuffer-setup-hook ,hook)
(funcall ,fun)))
@@ -659,7 +674,7 @@ HIGHLIGHT."
The line beginning/ending BEG/END is bound in BODY."
(declare (indent 2))
- (let ((max (make-symbol "max")))
+ (cl-with-gensyms (max)
`(save-excursion
(let ((,beg (point-min)) (,max (point-max)) end)
(while (< ,beg ,max)
@@ -685,7 +700,7 @@ The line beginning/ending BEG/END is bound in BODY."
width))
(defun consult--string-hash (strings)
- "Create hashtable from STRINGS."
+ "Create hash table from STRINGS."
(let ((ht (make-hash-table :test #'equal :size (length strings))))
(dolist (str strings)
(puthash str t ht))
@@ -694,8 +709,8 @@ The line beginning/ending BEG/END is bound in BODY."
(defmacro consult--local-let (binds &rest body)
"Buffer local let BINDS of dynamic variables in BODY."
(declare (indent 1))
- (let ((buffer (make-symbol "buffer"))
- (local (mapcar (lambda (x) (cons (make-symbol "local") (car x))) binds)))
+ (let ((buffer (gensym "buffer"))
+ (local (mapcar (lambda (x) (cons (gensym "local") (car x))) binds)))
`(let ((,buffer (current-buffer))
,@(mapcar (lambda (x) `(,(car x) (local-variable-p ',(cdr x)))) local))
(unwind-protect
@@ -710,44 +725,79 @@ The line beginning/ending BEG/END is bound in BODY."
(kill-local-variable ',(cdr x))))
local)))))))
-(defun consult--abbreviate-directory (dir)
- "Return abbreviated directory DIR for use in `completing-read' prompt."
+(defvar consult--fast-abbreviate-file-name nil)
+(defun consult--fast-abbreviate-file-name (name)
+ "Return abbreviate file NAME.
+This function is a pure variant of `abbreviate-file-name', which
+does not access the file system. This is important if we require
+that the operation is fast, even for remote paths or paths on
+network file systems."
+ (save-match-data
+ (let (case-fold-search) ;; Assume that file system is case sensitive.
+ (setq name (directory-abbrev-apply name))
+ (if (string-match (with-memoization consult--fast-abbreviate-file-name
+ (directory-abbrev-make-regexp (expand-file-name "~")))
+ name)
+ (concat "~" (substring name (match-beginning 1)))
+ name))))
+
+(defun consult--left-truncate-file (file)
+ "Return abbreviated file name of FILE for use in `completing-read' prompt."
(save-match-data
- (let ((adir (abbreviate-file-name dir)))
- (if (string-match "/\\([^/]+\\)/\\([^/]+\\)/\\'" adir)
- (format "…/%s/%s/" (match-string 1 adir) (match-string 2 adir))
- adir))))
+ (let ((afile (abbreviate-file-name file)))
+ (if (string-match "/\\([^/]+\\)/\\([^/]+/?\\)\\'" afile)
+ (propertize (format "…/%s/%s" (match-string 1 afile) (match-string 2 afile))
+ 'help-echo afile)
+ afile))))
(defun consult--directory-prompt (prompt dir)
- "Return prompt and directory.
-
-PROMPT is the prompt prefix. The directory
-is appended to the prompt prefix. For projects
-only the project name is shown. The `default-directory'
-is not shown. Other directories are abbreviated and
-only the last two path components are shown.
-
-If DIR is a string, it is returned.
-If DIR is a true value, the user is asked.
-Then the `consult-project-function' is tried.
-Otherwise the `default-directory' is returned."
- (let* ((dir
- (cond
- ((stringp dir) dir)
- (dir
- ;; Preserve this-command across `read-directory-name' call,
- ;; such that `consult-customize' continues to work.
- (let ((this-command this-command))
- (read-directory-name "Directory: " nil nil t)))
- (t (or (consult--project-root) default-directory))))
+ "Return prompt, paths and default directory.
+
+PROMPT is the prompt prefix. The directory is appended to the
+prompt prefix. For projects only the project name is shown. The
+`default-directory' is not shown. Other directories are
+abbreviated and only the last two path components are shown.
+
+If DIR is a string, it is returned as default directory. If DIR
+is a list of strings, the list is returned as search paths. If
+DIR is nil the `consult-project-function' is tried to retrieve
+the default directory. If no project is found the
+`default-directory' is returned as is. Otherwise the user is
+asked for the directories or files to search via
+`completing-read-multiple'."
+ (let* ((paths nil)
+ (dir
+ (pcase dir
+ ((pred stringp) dir)
+ ('nil (or (consult--project-root) default-directory))
+ (_
+ (pcase (if (stringp (car-safe dir))
+ dir
+ ;; Preserve this-command across `completing-read-multiple' call,
+ ;; such that `consult-customize' continues to work.
+ (let ((this-command this-command)
+ (def (abbreviate-file-name default-directory)))
+ (completing-read-multiple "Directories or files: "
+ #'completion-file-name-table
+ nil t def 'consult--path-history def)))
+ ((and `(,p) (guard (file-directory-p p))) p)
+ (ps (setq paths (mapcar (lambda (p)
+ (file-relative-name (expand-file-name p)))
+ ps))
+ default-directory)))))
(edir (file-name-as-directory (expand-file-name dir)))
- ;; Bind default-directory in order to find the project
- (pdir (let ((default-directory edir)) (consult--project-root))))
- (cons
+ (pdir (let ((default-directory edir))
+ ;; Bind default-directory in order to find the project
+ (consult--project-root))))
+ (list
(format "%s (%s): " prompt
- (if (equal edir pdir)
- (concat "Project " (consult--project-name pdir))
- (consult--abbreviate-directory dir)))
+ (pcase paths
+ (`(,p) (consult--left-truncate-file p))
+ (`(,p . ,_)
+ (format "%d paths, %s, …" (length paths) (consult--left-truncate-file p)))
+ ((guard (equal edir pdir)) (concat "Project " (consult--project-name pdir)))
+ (_ (consult--left-truncate-file edir))))
+ (or paths '("."))
edir)))
(defun consult--default-project-function (may-prompt)
@@ -771,31 +821,25 @@ When no project is found and MAY-PROMPT is non-nil ask the user."
(defun consult--project-name (dir)
"Return the project name for DIR."
(if (string-match "/\\([^/]+\\)/\\'" dir)
- (match-string 1 dir)
+ (propertize (match-string 1 dir) 'help-echo (abbreviate-file-name dir))
dir))
-(defun consult--format-file-line-match (file line &optional match)
+(defun consult--format-file-line-match (file line match)
"Format string FILE:LINE:MATCH with faces."
(setq line (number-to-string line)
- match (concat file ":" line (and match ":") match)
+ match (concat file ":" line ":" match)
file (length file))
(put-text-property 0 file 'face 'consult-file match)
(put-text-property (1+ file) (+ 1 file (length line)) 'face 'consult-line-number match)
match)
-(define-obsolete-function-alias
- 'consult--format-location 'consult--format-file-line-match "0.31")
-
-(defmacro consult--overlay (beg end &rest props)
+(defun consult--make-overlay (beg end &rest props)
"Make consult overlay between BEG and END with PROPS."
- (let ((ov (make-symbol "ov"))
- (puts))
+ (let ((ov (make-overlay beg end)))
(while props
- (push `(overlay-put ,ov ,(car props) ,(cadr props)) puts)
+ (overlay-put ov (car props) (cadr props))
(setq props (cddr props)))
- `(let ((,ov (make-overlay ,beg ,end)))
- ,@puts
- ,ov)))
+ ov))
(defun consult--remove-dups (list)
"Remove duplicate strings from LIST."
@@ -837,8 +881,8 @@ When no project is found and MAY-PROMPT is non-nil ask the user."
(jit-lock-fontify-now start end)))
(defmacro consult--with-increased-gc (&rest body)
- "Temporarily increase the gc limit in BODY to optimize for throughput."
- (let ((overwrite (make-symbol "overwrite")))
+ "Temporarily increase the GC limit in BODY to optimize for throughput."
+ (cl-with-gensyms (overwrite)
`(let* ((,overwrite (> consult--gc-threshold gc-cons-threshold))
(gc-cons-threshold (if ,overwrite consult--gc-threshold gc-cons-threshold))
(gc-cons-percentage (if ,overwrite consult--gc-percentage gc-cons-percentage)))
@@ -846,9 +890,12 @@ When no project is found and MAY-PROMPT is non-nil ask the user."
(defmacro consult--slow-operation (message &rest body)
"Show delayed MESSAGE if BODY takes too long.
-Also temporarily increase the gc limit via `consult--with-increased-gc'."
+Also temporarily increase the GC limit via `consult--with-increased-gc'."
(declare (indent 1))
- `(with-delayed-message (1 ,message)
+ ;; FIXME `with-delayed-message' is broken in combination with
+ ;; `inhibit-message'. Report this as a bug.
+ (ignore message)
+ `(progn ;; with-delayed-message (1 ,message)
(consult--with-increased-gc
,@body)))
@@ -866,8 +913,8 @@ Also temporarily increase the gc limit via `consult--with-increased-gc'."
"Get marker in BUFFER from LINE and COLUMN."
(when (buffer-live-p buffer)
(with-current-buffer buffer
- (save-restriction
- (save-excursion
+ (save-excursion
+ (save-restriction
(widen)
(goto-char (point-min))
;; Location data might be invalid by now!
@@ -940,6 +987,54 @@ MARKER is the cursor position."
"Return current line where the cursor MARKER is highlighted."
(consult--region-with-cursor (pos-bol) (pos-eol) marker))
+;;;; Tofu cooks
+
+(defsubst consult--tofu-p (char)
+ "Return non-nil if CHAR is a tofu."
+ (<= consult--tofu-char char (+ consult--tofu-char consult--tofu-range -1)))
+
+(defun consult--tofu-hide (str)
+ "Hide the tofus in STR."
+ (let* ((max (length str))
+ (end max))
+ (while (and (> end 0) (consult--tofu-p (aref str (1- end))))
+ (cl-decf end))
+ (when (< end max)
+ (setq str (copy-sequence str))
+ (put-text-property end max 'invisible t str))
+ str))
+
+(defsubst consult--tofu-append (cand id)
+ "Append tofu-encoded ID to CAND.
+The ID must fit within a single character. It must be smaller
+than `consult--tofu-range'."
+ (setq id (char-to-string (+ consult--tofu-char id)))
+ (add-text-properties 0 1 '(invisible t consult-strip t) id)
+ (concat cand id))
+
+(defsubst consult--tofu-get (cand)
+ "Extract tofu-encoded ID from CAND.
+See `consult--tofu-append'."
+ (- (aref cand (1- (length cand))) consult--tofu-char))
+
+;; We must disambiguate the lines by adding a prefix such that two lines with
+;; the same text can be distinguished. In order to avoid matching the line
+;; number, such that the user can search for numbers with `consult-line', we
+;; encode the line number as characters outside the Unicode range. By doing
+;; that, no accidental matching can occur.
+(defun consult--tofu-encode (n)
+ "Return tofu-encoded number N as a string.
+Large numbers are encoded as multiple tofu characters."
+ (let (str tofu)
+ (while (progn
+ (setq tofu (char-to-string
+ (+ consult--tofu-char (% n consult--tofu-range)))
+ str (if str (concat tofu str) tofu))
+ (and (>= n consult--tofu-range)
+ (setq n (/ n consult--tofu-range)))))
+ (add-text-properties 0 (length str) '(invisible t consult-strip t) str)
+ str))
+
;;;; Regexp utilities
(defun consult--find-highlights (str start &rest ignored-faces)
@@ -1066,7 +1161,7 @@ matches case insensitively."
(defun consult--join-regexps (regexps type)
"Join REGEXPS of TYPE."
- ;; Add lookahead wrapper only if there is more than one regular expression
+ ;; Add look-ahead wrapper only if there is more than one regular expression
(cond
((and (eq type 'pcre) (cdr regexps))
(concat "^" (mapconcat (lambda (x) (format "(?=.*%s)" x))
@@ -1078,20 +1173,18 @@ matches case insensitively."
(message "Too many regexps, %S ignored. Use post-filtering!"
(string-join (seq-drop regexps 3) " "))
(setq regexps (seq-take regexps 3)))
- (consult--regexp-join-permutations regexps
- (and (memq type '(basic emacs)) "\\")))))
+ (consult--join-regexps-permutations regexps (and (eq type 'emacs) "\\")))))
-(defun consult--regexp-join-permutations (regexps esc)
+(defun consult--join-regexps-permutations (regexps esc)
"Join all permutations of REGEXPS.
ESC is the escaping string for choice and groups."
(pcase regexps
('nil "")
(`(,r) r)
- (`(,r1 ,r2) (concat r1 ".*" r2 esc "|" r2 ".*" r1))
(_ (mapconcat
(lambda (r)
- (concat r ".*" esc "("
- (consult--regexp-join-permutations (remove r regexps) esc)
+ (concat esc "(" r esc ").*" esc "("
+ (consult--join-regexps-permutations (remove r regexps) esc)
esc ")"))
regexps (concat esc "|")))))
@@ -1118,7 +1211,7 @@ ESC is the escaping string for choice and groups."
(assoc selected candidates))
(defun consult--lookup-cdr (selected candidates &rest _)
- "Lookup SELECTED in CANDIDATES alist, return cdr of element."
+ "Lookup SELECTED in CANDIDATES alist, return `cdr' of element."
(cdr (assoc selected candidates)))
(defun consult--lookup-location (selected candidates &rest _)
@@ -1160,18 +1253,21 @@ ORIG is the original function, HOOKS the arguments."
;; file-attributes may throw permission denied error
(attrs (ignore-errors (file-attributes name)))
(size (file-attribute-size attrs)))
- (if (> size consult-preview-max-size)
+ (if (>= size consult-preview-max-size)
(format "File `%s' (%s) is too large for preview"
name (file-size-human-readable size))
- (let ((buf (find-file-noselect name 'nowarn (> size consult-preview-raw-size))))
+ (let ((buf (find-file-noselect name 'nowarn (>= size consult-preview-raw-size))))
(cond
- ((and (> size consult-preview-raw-size)
- (with-current-buffer buf
- (save-excursion
- (goto-char (point-min))
- (search-forward "\0" nil 'noerror))))
- (kill-buffer buf)
- (format "Binary file `%s' not previewed literally" name))
+ ((>= size consult-preview-raw-size)
+ (with-current-buffer buf
+ (if (save-excursion
+ (goto-char (point-min))
+ (search-forward "\0" nil 'noerror))
+ (progn
+ (kill-buffer buf)
+ (format "Binary file `%s' not previewed literally" name))
+ (set-buffer-multibyte t)
+ buf)))
((ignore-errors (buffer-local-value 'so-long-detected-p buf))
(kill-buffer buf)
(format "File `%s' with long lines not previewed" name))
@@ -1204,7 +1300,7 @@ ORIG is the original function, HOOKS the arguments."
(defun consult--temporary-files ()
"Return a function to open files temporarily for preview."
(let ((dir default-directory)
- (hook (make-symbol "consult--temporary-files-window-selection-change"))
+ (hook (make-symbol "consult--temporary-files-upgrade-hook"))
(orig-buffers (buffer-list))
temporary-buffers)
(fset hook
@@ -1268,7 +1364,7 @@ ORIG is the original function, HOOKS the arguments."
;; like `pdf-view-mode' or `doc-view-mode' which rely on
;; `buffer-file-name'. Executing (set-visited-file-name nil)
;; early also prevents the major mode initialization.
- (let ((hook (make-symbol "consult--temporary-files-disassociate")))
+ (let ((hook (make-symbol "consult--temporary-files-disassociate-hook")))
(fset hook (lambda ()
(when (buffer-live-p buf)
(with-current-buffer buf
@@ -1316,20 +1412,23 @@ See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'."
(delq nil (org-fold-core-get-regions
:with-markers t :from (point-min) :to (point-max))))
(when consult--org-fold-regions
- (let ((hook (make-symbol "consult--invisible-open-temporarily-cleanup")))
- (fset hook (apply-partially
- #'run-at-time 0 nil
- (lambda (buffer)
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (pcase-dolist (`(,beg ,end ,_) consult--org-fold-regions)
- (when (markerp beg) (set-marker beg nil))
- (when (markerp end) (set-marker end nil)))
- (kill-local-variable 'consult--org-fold-regions))))
- (current-buffer)))
- (when-let (win (active-minibuffer-window))
- (with-current-buffer (window-buffer win)
- (add-hook 'minibuffer-exit-hook hook nil 'local))))))
+ (let ((hook (make-symbol "consult--invisible-open-temporarily-cleanup-hook"))
+ (buffer (current-buffer))
+ (depth (recursion-depth)))
+ (fset hook
+ (lambda ()
+ (when (= (recursion-depth) depth)
+ (remove-hook 'minibuffer-exit-hook hook)
+ (run-at-time
+ 0 nil
+ (lambda ()
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (pcase-dolist (`(,beg ,end ,_) consult--org-fold-regions)
+ (when (markerp beg) (set-marker beg nil))
+ (when (markerp end) (set-marker end nil)))
+ (kill-local-variable 'consult--org-fold-regions))))))))
+ (add-hook 'minibuffer-exit-hook hook))))
(org-fold-show-set-visibility 'canonical)
(list (lambda ()
(pcase-dolist (`(,beg ,end ,spec) consult--org-fold-regions)
@@ -1357,7 +1456,7 @@ See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'."
(when-let (buf (and (markerp pos) (marker-buffer pos)))
(unless (and (eq (current-buffer) buf) (eq (window-buffer) buf))
(consult--buffer-action buf 'norecord)))
- ;; Widen if we cannot jump to the position (idea from flycheck-jump-to-error)
+ ;; Widen if we cannot jump to the position
(unless (= (goto-char pos) (point))
(widen)
(goto-char pos))))
@@ -1386,13 +1485,12 @@ The function can be used as the `:state' argument of `consult--read'."
(let ((saved-min (point-min-marker))
(saved-max (point-max-marker))
(saved-pos (point-marker))
- overlays invisible)
+ restore)
(set-marker-insertion-type saved-max t) ;; Grow when text is inserted
(lambda (action cand)
(when (eq action 'preview)
- (mapc #'funcall invisible)
- (mapc #'delete-overlay overlays)
- (setq invisible nil overlays nil)
+ (mapc #'funcall restore)
+ (setq restore nil)
(if (not cand)
;; If position cannot be previewed, return to saved position
(let ((saved-buffer (marker-buffer saved-pos)))
@@ -1401,29 +1499,43 @@ The function can be used as the `:state' argument of `consult--read'."
(set-buffer saved-buffer)
(narrow-to-region saved-min saved-max)
(goto-char saved-pos)))
- ;; Handle positions with overlay information
+ ;; Candidate can be previewed
(consult--jump-1 (or (car-safe cand) cand))
- (setq invisible (consult--invisible-open-temporarily)
- overlays
- (list (save-excursion
- (let ((vbeg (progn (beginning-of-visual-line) (point)))
- (vend (progn (end-of-visual-line) (point)))
- (end (pos-eol)))
- (consult--overlay vbeg (if (= vend end) (1+ end) vend)
- 'face 'consult-preview-line
- 'window (selected-window)
- 'priority 1)))
- (consult--overlay (point) (1+ (point))
- 'face 'consult-preview-cursor
- 'window (selected-window)
- 'priority 3)))
- (dolist (match (cdr-safe cand))
- (push (consult--overlay (+ (point) (car match))
- (+ (point) (cdr match))
- 'face 'consult-preview-match
- 'window (selected-window)
- 'priority 2)
- overlays))
+ (setq restore (consult--invisible-open-temporarily))
+ ;; Ensure that cursor is properly previewed (gh:minad/consult#764)
+ (unless (eq cursor-in-non-selected-windows 'box)
+ (let ((orig cursor-in-non-selected-windows)
+ (buf (current-buffer)))
+ (push
+ (if (local-variable-p 'cursor-in-non-selected-windows)
+ (lambda ()
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (setq-local cursor-in-non-selected-windows orig))))
+ (lambda ()
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (kill-local-variable 'cursor-in-non-selected-windows)))))
+ restore)
+ (setq-local cursor-in-non-selected-windows 'box)))
+ ;; Match previews
+ (let ((overlays
+ (list (save-excursion
+ (let ((vbeg (progn (beginning-of-visual-line) (point)))
+ (vend (progn (end-of-visual-line) (point)))
+ (end (pos-eol)))
+ (consult--make-overlay vbeg (if (= vend end) (1+ end) vend)
+ 'face 'consult-preview-line
+ 'window (selected-window)
+ 'priority 1))))))
+ (dolist (match (cdr-safe cand))
+ (push (consult--make-overlay (+ (point) (car match))
+ (+ (point) (cdr match))
+ 'face 'consult-preview-match
+ 'window (selected-window)
+ 'priority 2)
+ overlays))
+ (push (lambda () (mapc #'delete-overlay overlays)) restore))
(run-hooks 'consult-after-jump-hook))))))
(defun consult--jump-state ()
@@ -1443,7 +1555,7 @@ The function can be used as the `:state' argument of `consult--read'."
The cheap location markers from CANDIDATES are upgraded on window
selection change to full Emacs markers."
(let ((jump (consult--jump-state))
- (hook (make-symbol "consult--location-upgrade")))
+ (hook (make-symbol "consult--location-upgrade-hook")))
(fset hook
(lambda (_)
(unless (consult--completion-window-p)
@@ -1482,10 +1594,7 @@ The result can be passed as :state argument to `consult--read'." type)
preview-key (cddr preview-key))
(let ((key (car preview-key)))
(unless (eq key 'any)
- (if (key-valid-p key)
- (setq key (key-parse key))
- ;; TODO: Remove compatibility code, throw error.
- (message "Invalid preview key according to `key-valid-p': %S" key)))
+ (setq key (consult--key-parse key)))
(push (cons key debounce) keys))
(pop preview-key)))
keys))
@@ -1504,14 +1613,14 @@ The result can be passed as :state argument to `consult--read'." type)
(setq keys (lookup-key map keys))
(if (functionp keys) (funcall keys) any)))
-(defun consult--append-local-post-command-hook (fun)
+(defun consult--preview-append-local-pch (fun)
"Append FUN to local `post-command-hook' list."
;; Symbol indirection because of bug#46407.
- (let ((hook (make-symbol "consult--preview-post-command")))
+ (let ((hook (make-symbol "consult--preview-post-command-hook")))
(fset hook fun)
;; TODO Emacs 28 has a bug, where the hook--depth-alist is not cleaned up properly
;; Do not use the broken add-hook here.
- ;;(add-hook 'post-command-hook sym 'append 'local)
+ ;;(add-hook 'post-command-hook hook 'append 'local)
(setq-local post-command-hook
(append
(remove t post-command-hook)
@@ -1526,12 +1635,12 @@ PREVIEW-KEY, STATE, TRANSFORM and CANDIDATE."
(consult--minibuffer-with-setup-hook
(if (and state preview-key)
(lambda ()
- (let ((exit-hook (make-symbol "consult--preview-minibuffer-exit"))
+ (let ((hook (make-symbol "consult--preview-minibuffer-exit-hook"))
(depth (recursion-depth)))
- (fset exit-hook
+ (fset hook
(lambda ()
(when (= (recursion-depth) depth)
- (remove-hook 'minibuffer-exit-hook exit-hook)
+ (remove-hook 'minibuffer-exit-hook hook)
(when timer
(cancel-timer timer)
(setq timer nil))
@@ -1541,7 +1650,7 @@ PREVIEW-KEY, STATE, TRANSFORM and CANDIDATE."
(funcall state 'preview nil))
;; STEP 4: Notify the preview function of the minibuffer exit
(funcall state 'exit nil)))))
- (add-hook 'minibuffer-exit-hook exit-hook))
+ (add-hook 'minibuffer-exit-hook hook))
;; STEP 1: Setup the preview function
(with-selected-window (or (minibuffer-selected-window) (next-window))
(funcall state 'setup nil))
@@ -1593,13 +1702,13 @@ PREVIEW-KEY, STATE, TRANSFORM and CANDIDATE."
(funcall state 'preview (setq previewed transformed))))))))
;; STEP 2: Preview candidate
(funcall state 'preview (setq previewed transformed)))))))))))
- (consult--append-local-post-command-hook
+ (consult--preview-append-local-pch
(lambda ()
(setq mb-input (minibuffer-contents-no-properties)
mb-narrow consult--narrow)
(funcall consult--preview-function))))
(lambda ()
- (consult--append-local-post-command-hook
+ (consult--preview-append-local-pch
(lambda ()
(setq mb-input (minibuffer-contents-no-properties)
mb-narrow consult--narrow)))))
@@ -1682,17 +1791,9 @@ The candidate must have a `consult--prefix-group' property."
The default is twice the `consult-narrow-key'."
(cond
(consult-widen-key
- (if (key-valid-p consult-widen-key)
- (key-parse consult-widen-key)
- ;; TODO: Remove compatibility code, throw error.
- (message "Invalid `consult-widen-key' according to `key-valid-p': %S" consult-widen-key)
- consult-widen-key))
+ (consult--key-parse consult-widen-key))
(consult-narrow-key
- (let ((key consult-narrow-key))
- (if (key-valid-p key)
- (setq key (key-parse key))
- ;; TODO: Remove compatibility code, throw error.
- (message "Invalid `consult-narrow-key' according to `key-valid-p': %S" key))
+ (let ((key (consult--key-parse consult-narrow-key)))
(vconcat key key)))))
(defun consult-narrow (key)
@@ -1710,7 +1811,7 @@ This command is used internally by the narrowing system of `consult--read'."
(delete-overlay consult--narrow-overlay))
(when consult--narrow
(setq consult--narrow-overlay
- (consult--overlay
+ (consult--make-overlay
(1- (minibuffer-prompt-end)) (minibuffer-prompt-end)
'before-string
(propertize (format " [%s]" (alist-get consult--narrow
@@ -1735,7 +1836,7 @@ This command is used internally by the narrowing system of `consult--read'."
(when-let (pair (or (and (length= str 1)
(assoc (aref str 0) consult--narrow-keys))
(and (equal str "")
- (assoc 32 consult--narrow-keys))))
+ (assoc ?\s consult--narrow-keys))))
(lambda ()
(interactive)
(delete-minibuffer-contents)
@@ -1766,10 +1867,7 @@ to make it available for commands with narrowing."
(setq consult--narrow-predicate nil
consult--narrow-keys settings))
(when-let ((key consult-narrow-key))
- (if (key-valid-p key)
- (setq key (key-parse key))
- ;; TODO: Remove compatibility code, throw error.
- (message "Invalid `consult-narrow-key' according to `key-valid-p': %S" key))
+ (setq key (consult--key-parse key))
(dolist (pair consult--narrow-keys)
(define-key map (vconcat key (vector (car pair)))
(cons (cdr pair) #'consult-narrow))))
@@ -1882,13 +1980,13 @@ BIND is the asynchronous function binding."
;; We use a symbol in order to avoid adding lambdas to
;; the hook variable. Symbol indirection because of
;; bug#46407.
- (sym (make-symbol "consult--async-after-change")))
+ (hook (make-symbol "consult--async-after-change-hook")))
;; Delay modification hook to ensure that minibuffer is still
;; alive after the change, such that we don't restart a new
;; asynchronous search right before exiting the minibuffer.
- (fset sym (lambda (&rest _) (run-at-time 0 nil fun)))
- (add-hook 'after-change-functions sym nil 'local)
- (funcall sym)))))
+ (fset hook (lambda (&rest _) (run-at-time 0 nil fun)))
+ (add-hook 'after-change-functions hook nil 'local)
+ (funcall hook)))))
(let ((,async (if (functionp ,async) ,async (lambda (_) ,async))))
(unwind-protect
,(macroexp-progn body)
@@ -2069,18 +2167,20 @@ PROPS are optional properties passed to `make-process'."
(consult--async-log
"consult--async-process sentinel: event=%s lines=%d\n"
(string-trim event) count)
- (with-current-buffer (get-buffer-create consult--async-log)
- (goto-char (point-max))
- (insert ">>>>> stderr >>>>>\n")
- (insert-buffer-substring proc-buf)
- (insert "<<<<< stderr <<<<<\n"))))
+ (when (> (buffer-size proc-buf) 0)
+ (with-current-buffer (get-buffer-create consult--async-log)
+ (goto-char (point-max))
+ (insert ">>>>> stderr >>>>>\n")
+ (let ((beg (point)))
+ (insert-buffer-substring proc-buf)
+ (save-excursion
+ (goto-char beg)
+ (message #("%s" 0 2 (face error))
+ (buffer-substring-no-properties (pos-bol) (pos-eol)))))
+ (insert "<<<<< stderr <<<<<\n")))))
(args (funcall builder action)))
(unless (stringp (car args))
- (if (not (keywordp (car args)))
- (setq args (car args))
- ;; TODO remove backward compatibility code
- (message "Consult: The command builder return value changed, it should be a pair instead of a plist")
- (setq args (plist-get args :command))))
+ (setq args (car args)))
(unless (equal args last-args)
(setq last-args args)
(when proc
@@ -2112,18 +2212,13 @@ PROPS are optional properties passed to `make-process'."
(_ (funcall async action))))))
(defun consult--async-highlight (async builder)
- "Return ASYNC function which highlightes the candidates.
+ "Return ASYNC function which highlights the candidates.
BUILDER is the command line builder function."
(let (highlight)
(lambda (action)
(cond
((stringp action)
- (let ((tmp (funcall builder action)))
- (if (not (keywordp (car tmp)))
- (setq highlight (cdr tmp))
- ;; TODO remove backward compatibility code
- (message "Consult: The command builder return value changed, it should be a pair instead of a plist")
- (setq highlight (plist-get tmp :highlight))))
+ (setq highlight (cdr (funcall builder action)))
(funcall async action))
((and (consp action) highlight)
(dolist (str action)
@@ -2215,8 +2310,7 @@ highlighting function."
(defmacro consult--async-transform (async &rest transform)
"Use FUN to TRANSFORM candidates of ASYNC."
- (let ((async-var (make-symbol "async"))
- (action-var (make-symbol "action")))
+ (cl-with-gensyms (async-var action-var)
`(let ((,async-var ,async))
(lambda (,action-var)
(funcall ,async-var (if (consp ,action-var) (,@transform ,action-var) ,action-var))))))
@@ -2302,6 +2396,18 @@ Note that `consult-narrow-key' and `consult-widen-key' are bound dynamically."
;;;; Internal API: consult--read
+(defun consult--annotate-align (cand ann)
+ "Align annotation ANN by computing the maximum CAND width."
+ (setq consult--annotate-align-width
+ (max consult--annotate-align-width
+ (* (ceiling (consult--display-width cand)
+ consult--annotate-align-step)
+ consult--annotate-align-step)))
+ (when ann
+ (concat
+ #(" " 0 1 (display (space :align-to (+ left consult--annotate-align-width))))
+ ann)))
+
(defun consult--add-history (async items)
"Add ITEMS to the minibuffer future history.
ASYNC must be non-nil for async completion functions."
@@ -2353,21 +2459,6 @@ PREVIEW-KEY are the preview keys."
map))
old-map))))
-(defsubst consult--tofu-p (char)
- "Return non-nil if CHAR is a tofu."
- (<= consult--tofu-char char (+ consult--tofu-char consult--tofu-range -1)))
-
-(defun consult--tofu-hide (str)
- "Hide the tofus in STR."
- (let* ((max (length str))
- (end max))
- (while (and (> end 0) (consult--tofu-p (aref str (1- end))))
- (cl-decf end))
- (when (< end max)
- (setq str (copy-sequence str))
- (put-text-property end max 'invisible t str))
- str))
-
(defun consult--tofu-hide-in-minibuffer (&rest _)
"Hide the tofus in the minibuffer."
(let* ((min (minibuffer-prompt-end))
@@ -2378,37 +2469,6 @@ PREVIEW-KEY are the preview keys."
(when (< pos max)
(add-text-properties pos max '(invisible t rear-nonsticky t cursor-intangible t)))))
-(defsubst consult--tofu-append (cand id)
- "Append tofu-encoded ID to CAND.
-The ID must fit within a single character. It must be smaller
-than `consult--tofu-range'."
- (setq id (char-to-string (+ consult--tofu-char id)))
- (add-text-properties 0 1 '(invisible t consult-strip t) id)
- (concat cand id))
-
-(defsubst consult--tofu-get (cand)
- "Extract tofu-encoded ID from CAND.
-See `consult--tofu-append'."
- (- (aref cand (1- (length cand))) consult--tofu-char))
-
-;; We must disambiguate the lines by adding a prefix such that two lines with
-;; the same text can be distinguished. In order to avoid matching the line
-;; number, such that the user can search for numbers with `consult-line', we
-;; encode the line number as characters outside the unicode range. By doing
-;; that, no accidential matching can occur.
-(defun consult--tofu-encode (n)
- "Return tofu-encoded number N as a string.
-Large numbers are encoded as multiple tofu characters."
- (let (str tofu)
- (while (progn
- (setq tofu (char-to-string
- (+ consult--tofu-char (% n consult--tofu-range)))
- str (if str (concat tofu str) tofu))
- (and (>= n consult--tofu-range)
- (setq n (/ n consult--tofu-range)))))
- (add-text-properties 0 (length str) '(invisible t consult-strip t) str)
- str))
-
(defun consult--read-annotate (fun cand)
"Annotate CAND with annotation function FUN."
(pcase (funcall fun cand)
@@ -2443,11 +2503,11 @@ Large numbers are encoded as multiple tofu characters."
(setq-local minibuffer-default-add-function
(apply-partially #'consult--add-history (functionp candidates) add-history))))
(consult--with-async (async candidates)
- ;; NOTE: Do not unnecessarily let-bind the lambdas to avoid overcapturing
+ ;; NOTE: Do not unnecessarily let-bind the lambdas to avoid over-capturing
;; in the interpreter. This will make closures and the lambda string
;; representation larger, which makes debugging much worse. Fortunately
- ;; the overcapturing problem does not affect the bytecode interpreter
- ;; which does a proper scope analyis.
+ ;; the over-capturing problem does not affect the bytecode interpreter
+ ;; which does a proper scope analysis.
(let* ((metadata `(metadata
,@(when category `((category . ,category)))
,@(when group `((group-function . ,group)))
@@ -2458,6 +2518,7 @@ Large numbers are encoded as multiple tofu characters."
. ,(apply-partially #'consult--read-annotate annotate))))
,@(unless sort '((cycle-sort-function . identity)
(display-sort-function . identity)))))
+ (consult--annotate-align-width 0)
(result
(consult--with-preview
preview-key state
@@ -2541,6 +2602,47 @@ input method."
:sort t
:lookup (lambda (selected &rest _) selected)))))
+;;;; Internal API: consult--prompt
+
+(cl-defun consult--prompt-1 (&key prompt history add-history initial default
+ keymap state preview-key transform inherit-input-method)
+ "See `consult--prompt' for documentation."
+ (consult--minibuffer-with-setup-hook
+ (:append (lambda ()
+ (consult--setup-keymap keymap nil nil preview-key)
+ (setq-local minibuffer-default-add-function
+ (apply-partially #'consult--add-history nil add-history))))
+ (car (consult--with-preview
+ preview-key state
+ (lambda (_narrow inp _cand) (funcall transform inp))
+ (lambda () "")
+ (read-from-minibuffer prompt initial nil nil history default inherit-input-method)))))
+
+(cl-defun consult--prompt (&rest options &key prompt history add-history initial default
+ keymap state preview-key transform inherit-input-method)
+ "Read from minibuffer.
+
+Keyword OPTIONS:
+
+PROMPT is the string to prompt with.
+TRANSFORM is a function which is applied to the current input string.
+HISTORY is the symbol of the history variable.
+INITIAL is initial input.
+DEFAULT is the default selected value.
+ADD-HISTORY is a list of items to add to the history.
+STATE is the state function, see `consult--with-preview'.
+PREVIEW-KEY are the preview keys (nil, `any', a single key or a list of keys).
+KEYMAP is a command-specific keymap."
+ (ignore prompt history add-history initial default
+ keymap state preview-key transform inherit-input-method)
+ (apply #'consult--prompt-1
+ (append
+ (consult--customize-get)
+ options
+ (list :prompt "Input: "
+ :preview-key consult-preview-key
+ :transform #'identity))))
+
;;;; Internal API: consult--multi
(defsubst consult--multi-source (sources cand)
@@ -2567,14 +2669,14 @@ input method."
(delq nil)
(delete-dups)))
-(defun consult--multi-annotate (sources align cand)
- "Annotate candidate CAND with `consult--multi' type, given SOURCES and ALIGN."
- (let* ((src (consult--multi-source sources cand))
- (annotate (plist-get src :annotate))
- (ann (if annotate
- (funcall annotate (cdr (get-text-property 0 'multi-category cand)))
- (plist-get src :name))))
- (and ann (concat align ann))))
+(defun consult--multi-annotate (sources cand)
+ "Annotate candidate CAND from multi SOURCES."
+ (consult--annotate-align
+ cand
+ (let ((src (consult--multi-source sources cand)))
+ (if-let ((fun (plist-get src :annotate)))
+ (funcall fun (cdr (get-text-property 0 'multi-category cand)))
+ (plist-get src :name)))))
(defun consult--multi-group (sources cand transform)
"Return title of candidate CAND or TRANSFORM the candidate given SOURCES."
@@ -2624,25 +2726,23 @@ input method."
(defun consult--multi-candidates (sources)
"Return `consult--multi' candidates from SOURCES."
- (let ((idx 0) (max-width 0) (candidates))
+ (let ((idx 0) candidates)
(seq-doseq (src sources)
(let* ((face (and (plist-member src :face) `(face ,(plist-get src :face))))
(cat (plist-get src :category))
(items (plist-get src :items))
(items (if (functionp items) (funcall items) items)))
(dolist (item items)
- (let ((cand (consult--tofu-append item idx))
- (width (consult--display-width item)))
+ (let ((cand (consult--tofu-append item idx)))
;; Preserve existing `multi-category' datum of the candidate.
(if (get-text-property 0 'multi-category cand)
(when face (add-text-properties 0 (length item) face cand))
;; Attach `multi-category' datum and face.
(add-text-properties 0 (length item)
`(multi-category (,cat . ,item) ,@face) cand))
- (when (> width max-width) (setq max-width width))
(push cand candidates))))
(cl-incf idx))
- (cons (+ 3 max-width) (nreverse candidates))))
+ (nreverse candidates)))
(defun consult--multi-enabled-sources (sources)
"Return vector of enabled SOURCES."
@@ -2709,7 +2809,7 @@ Required source fields:
* :category - Completion category symbol.
* :items - List of strings to select from or function returning
list of strings. Note that the strings can use text properties
- to carry mtadata, which is then available to the :annotate,
+ to carry metadata, which is then available to the :annotate,
:action and :state functions.
Optional source fields:
@@ -2733,18 +2833,15 @@ Optional source fields:
(let* ((sources (consult--multi-enabled-sources sources))
(candidates (consult--with-increased-gc
(consult--multi-candidates sources)))
- (align (propertize
- " " 'display
- `(space :align-to (+ left ,(car candidates)))))
(selected
(apply #'consult--read
- (cdr candidates)
+ candidates
(append
options
(list
:category 'multi-category
:predicate (apply-partially #'consult--multi-predicate sources)
- :annotate (apply-partially #'consult--multi-annotate sources align)
+ :annotate (apply-partially #'consult--multi-annotate sources)
:group (apply-partially #'consult--multi-group sources)
:lookup (apply-partially #'consult--multi-lookup sources)
:preview-key (consult--multi-preview-key sources)
@@ -2761,47 +2858,6 @@ Optional source fields:
(setq selected `(,(car selected) :match t ,@(cdr selected))))
selected))
-;;;; Internal API: consult--prompt
-
-(cl-defun consult--prompt-1 (&key prompt history add-history initial default
- keymap state preview-key transform inherit-input-method)
- "See `consult--prompt' for documentation."
- (consult--minibuffer-with-setup-hook
- (:append (lambda ()
- (consult--setup-keymap keymap nil nil preview-key)
- (setq-local minibuffer-default-add-function
- (apply-partially #'consult--add-history nil add-history))))
- (car (consult--with-preview
- preview-key state
- (lambda (_narrow inp _cand) (funcall transform inp))
- (lambda () "")
- (read-from-minibuffer prompt initial nil nil history default inherit-input-method)))))
-
-(cl-defun consult--prompt (&rest options &key prompt history add-history initial default
- keymap state preview-key transform inherit-input-method)
- "Read from minibuffer.
-
-Keyword OPTIONS:
-
-PROMPT is the string to prompt with.
-TRANSFORM is a function which is applied to the current input string.
-HISTORY is the symbol of the history variable.
-INITIAL is initial input.
-DEFAULT is the default selected value.
-ADD-HISTORY is a list of items to add to the history.
-STATE is the state function, see `consult--with-preview'.
-PREVIEW-KEY are the preview keys (nil, `any', a single key or a list of keys).
-KEYMAP is a command-specific keymap."
- (ignore prompt history add-history initial default
- keymap state preview-key transform inherit-input-method)
- (apply #'consult--prompt-1
- (append
- (consult--customize-get)
- options
- (list :prompt "Input: "
- :preview-key consult-preview-key
- :transform #'identity))))
-
;;;; Customization macro
(defun consult--customize-put (cmds prop form)
@@ -2863,9 +2919,9 @@ of functions and in `consult-completion-in-region'."
(setq ov nil))
((and (eq action 'preview) cand)
(unless ov
- (setq ov (consult--overlay start end
- 'invisible t
- 'window (selected-window))))
+ (setq ov (consult--make-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)
@@ -2988,8 +3044,9 @@ These configuration options are supported:
(completion--replace start end (setq completion (concat completion)))
(when exit-fun
(funcall exit-fun completion
- ;; If completion is finished and cannot be further completed,
- ;; return 'finished. Otherwise return 'exact.
+ ;; If completion is finished and cannot be further
+ ;; completed, return `finished'. Otherwise return
+ ;; `exact'.
(if (eq (try-completion completion collection predicate) t)
'finished 'exact)))
t)
@@ -3149,8 +3206,8 @@ The symbol at point is added to the future history."
(consult--global-mark-candidates
(or markers global-mark-ring))
:prompt "Go to global mark: "
- ;; Despite `consult-global-mark' formating the candidates in grep-like
- ;; style, we are not using the 'consult-grep category, since the candidates
+ ;; Despite `consult-global-mark' formatting the candidates in grep-like
+ ;; style, we are not using the `consult-grep' category, since the candidates
;; have location markers attached.
:category 'consult-location
:sort nil
@@ -3243,12 +3300,12 @@ and the last `isearch-string' is added to the future history."
:category 'consult-location
:sort nil
:require-match t
- ;; Always add last isearch string to future history
+ ;; Always add last `isearch-string' to future history
:add-history (list (thing-at-point 'symbol) isearch-string)
:history '(:input consult--line-history)
:lookup #'consult--line-match
:default (car candidates)
- ;; Add isearch-string as initial input if starting from isearch
+ ;; Add `isearch-string' as initial input if starting from Isearch
:initial (or initial
(and isearch-mode
(prog1 isearch-string (isearch-done))))
@@ -3331,13 +3388,13 @@ to `consult--buffer-query'."
:category 'consult-location
:sort nil
:require-match t
- ;; Always add last isearch string to future history
+ ;; Always add last Isearch string to future history
:add-history (mapcar #'consult--async-split-initial
(delq nil (list (thing-at-point 'symbol)
isearch-string)))
:history '(:input consult--line-multi-history)
:lookup #'consult--line-multi-match
- ;; Add isearch-string as initial input if starting from isearch
+ ;; Add `isearch-string' as initial input if starting from Isearch
:initial (consult--async-split-initial
(or initial
(and isearch-mode
@@ -3350,6 +3407,7 @@ to `consult--buffer-query'."
(defun consult--keep-lines-state (filter)
"State function for `consult-keep-lines' with FILTER function."
(let ((font-lock-orig font-lock-mode)
+ (whitespace-orig (bound-and-true-p whitespace-mode))
(hl-line-orig (bound-and-true-p hl-line-mode))
(point-orig (point))
lines content-orig replace last-input)
@@ -3388,7 +3446,7 @@ to `consult--buffer-query'."
;; No undo recording, modification hooks, buffer modified-status
(with-silent-modifications (funcall replace content-orig point-orig)))
;; Committing or new input provided -> Update
- (when (and input ;; Input has been povided
+ (when (and input ;; Input has been provided
(or
;; Committing, but not with empty input
(and (eq action 'return) (not (string-match-p "\\`!? ?\\'" input)))
@@ -3410,6 +3468,7 @@ to `consult--buffer-query'."
(funcall filter input (mapcar #'copy-sequence lines)))))))))
(when (stringp filtered-content)
(when font-lock-mode (font-lock-mode -1))
+ (when (bound-and-true-p whitespace-mode) (whitespace-mode -1))
(when (bound-and-true-p hl-line-mode) (hl-line-mode -1))
(if (eq action 'return)
(atomic-change-group
@@ -3423,6 +3482,7 @@ to `consult--buffer-query'."
;; Restore modes
(when (eq action 'return)
(when hl-line-orig (hl-line-mode 1))
+ (when whitespace-orig (whitespace-mode 1))
(when font-lock-orig (font-lock-mode 1))))))
;;;###autoload
@@ -3432,7 +3492,7 @@ to `consult--buffer-query'."
The selected lines are kept and the other lines are deleted. When called
interactively, the lines selected are those that match the minibuffer input. In
order to match the inverse of the input, prefix the input with `! '. When
-called from elisp, the filtering is performed by a FILTER function. This
+called from Elisp, the filtering is performed by a FILTER function. This
command obeys narrowing.
FILTER is the filter function.
@@ -3514,7 +3574,7 @@ INITIAL is the initial input."
(let ((a (if not block-beg block-end))
(b (if not block-end beg)))
(when (/= a b)
- (push (consult--overlay a b 'invisible t) new-overlays)))
+ (push (consult--make-overlay a b 'invisible t) new-overlays)))
(setq block-beg beg))
(setq block-end end old-ind ind)))))
'commit)
@@ -3531,7 +3591,7 @@ INITIAL is the initial input."
(consult-focus-lines 'show)
(goto-char pt-orig))
(t
- ;; Sucessfully terminated -> Remember invisible overlays
+ ;; Successfully terminated -> Remember invisible overlays
(setq consult--focus-lines-overlays
(nconc consult--focus-lines-overlays overlays))
;; move point past invisible
@@ -3549,7 +3609,7 @@ The selected lines are shown and the other lines hidden. When called
interactively, the lines selected are those that match the minibuffer input. In
order to match the inverse of the input, prefix the input with `! '. With
optional prefix argument SHOW reveal the hidden lines. Alternatively the
-command can be restarted to reveal the lines. When called from elisp, the
+command can be restarted to reveal the lines. When called from Elisp, the
filtering is performed by a FILTER function. This command obeys narrowing.
FILTER is the filter function.
@@ -3652,8 +3712,7 @@ narrowing and the settings `consult-goto-line-numbers' and
(find-file
(consult--read
(or
- (let (file-name-handler-alist) ;; No Tramp slowdown please
- (mapcar #'abbreviate-file-name (bound-and-true-p recentf-list)))
+ (mapcar #'consult--fast-abbreviate-file-name (bound-and-true-p recentf-list))
(user-error "No recent files, `recentf-mode' is %s"
(if recentf-mode "enabled" "disabled")))
:prompt "Find recent file: "
@@ -3991,8 +4050,6 @@ history is used."
(unless found
(user-error "No history configured for `%s', see `consult-mode-histories'"
major-mode))
- (unless (consp (cdr found))
- (user-error "Obsolete mode history entry: %S" found))
(cons (symbol-value (cadr found)) (cddr found))))))
;;;###autoload
@@ -4041,14 +4098,14 @@ of the prompt. See also `cape-history' from the Cape package."
;;;;; Command: consult-isearch-history
(defun consult-isearch-forward (&optional reverse)
- "Continue isearch forward optionally in REVERSE."
+ "Continue Isearch forward optionally in REVERSE."
(interactive)
(consult--require-minibuffer)
(setq isearch-new-forward (not reverse) isearch-new-nonincremental nil)
(funcall (or (command-remapping #'exit-minibuffer) #'exit-minibuffer)))
(defun consult-isearch-backward (&optional reverse)
- "Continue isearch backward optionally in REVERSE."
+ "Continue Isearch backward optionally in REVERSE."
(interactive)
(consult-isearch-forward (not reverse)))
@@ -4062,34 +4119,30 @@ of the prompt. See also `cape-history' from the Cape package."
"<remap> <isearch-backward>" #'consult-isearch-backward)
(defun consult--isearch-history-candidates ()
- "Return isearch history candidates."
+ "Return Isearch history candidates."
;; NOTE: Do not throw an error on empty history,
;; in order to allow starting a search.
;; We do not :require-match here!
(let ((history (if (eq t search-default-mode)
(append regexp-search-ring search-ring)
(append search-ring regexp-search-ring))))
- (cons
- (delete-dups
- (mapcar
- (lambda (cand)
- ;; The search type can be distinguished via text properties.
- (let* ((props (plist-member (text-properties-at 0 cand)
- 'isearch-regexp-function))
- (type (pcase (cadr props)
- ((and 'nil (guard (not props))) ?r)
- ('nil ?l)
- ('word-search-regexp ?w)
- ('isearch-symbol-regexp ?s)
- ('char-fold-to-regexp ?c)
- (_ ?u))))
- ;; Disambiguate history items. The same string could
- ;; occur with different search types.
- (consult--tofu-append cand type)))
- history))
- (if history
- (+ 4 (apply #'max (mapcar #'length history)))
- 0))))
+ (delete-dups
+ (mapcar
+ (lambda (cand)
+ ;; The search type can be distinguished via text properties.
+ (let* ((props (plist-member (text-properties-at 0 cand)
+ 'isearch-regexp-function))
+ (type (pcase (cadr props)
+ ((and 'nil (guard (not props))) ?r)
+ ('nil ?l)
+ ('word-search-regexp ?w)
+ ('isearch-symbol-regexp ?s)
+ ('char-fold-to-regexp ?c)
+ (_ ?u))))
+ ;; Disambiguate history items. The same string could
+ ;; occur with different search types.
+ (consult--tofu-append cand type)))
+ history))))
(defconst consult--isearch-history-narrow
'((?c . "Char")
@@ -4107,15 +4160,14 @@ This replaces the current search string if Isearch is active, and
starts a new Isearch session otherwise."
(interactive)
(consult--forbid-minibuffer)
- (let* ((isearch-message-function 'ignore) ;; Avoid flicker in echo area
- (inhibit-redisplay t) ;; Avoid flicker in mode line
- (candidates (consult--isearch-history-candidates))
- (align (propertize " " 'display `(space :align-to (+ left ,(cdr candidates))))))
+ (let* ((isearch-message-function #'ignore)
+ (cursor-in-echo-area t) ;; Avoid cursor flickering
+ (candidates (consult--isearch-history-candidates)))
(unless isearch-mode (isearch-mode t))
(with-isearch-suspended
(setq isearch-new-string
(consult--read
- (car candidates)
+ candidates
:prompt "I-search: "
:category 'consult-isearch
:history t ;; disable history
@@ -4124,7 +4176,9 @@ starts a new Isearch session otherwise."
:keymap consult-isearch-history-map
:annotate
(lambda (cand)
- (concat align (alist-get (consult--tofu-get cand) consult--isearch-history-narrow)))
+ (consult--annotate-align
+ cand
+ (alist-get (consult--tofu-get cand) consult--isearch-history-narrow)))
:group
(lambda (cand transform)
(if transform
@@ -4306,7 +4360,7 @@ QUERY is passed to `consult--buffer-query'."
(cond
((and ndir (eq dir 'project))
(format ", Project %s" (consult--project-name ndir)))
- (ndir (concat ", " (consult--abbreviate-directory ndir)))
+ (ndir (concat ", " (consult--left-truncate-file ndir)))
(t "")))
buffers)))
@@ -4362,21 +4416,28 @@ AS is a conversion function."
(defun consult--buffer-preview ()
"Buffer preview function."
- (let ((orig-buf (current-buffer)) other-win)
+ (let ((orig-buf (current-buffer))
+ (orig-prev (copy-sequence (window-prev-buffers)))
+ (orig-next (copy-sequence (window-next-buffers)))
+ other-win)
(lambda (action cand)
- (when (eq action 'preview)
- (when (and (eq consult--buffer-display #'switch-to-buffer-other-window)
- (not other-win))
- (switch-to-buffer-other-window orig-buf)
- (setq other-win (selected-window)))
- (let ((win (or other-win (selected-window))))
- (when (window-live-p win)
- (with-selected-window win
- (cond
- ((and cand (get-buffer cand))
- (switch-to-buffer cand 'norecord))
- ((buffer-live-p orig-buf)
- (switch-to-buffer orig-buf 'norecord))))))))))
+ (pcase action
+ ('exit
+ (set-window-prev-buffers other-win orig-prev)
+ (set-window-next-buffers other-win orig-next))
+ ('preview
+ (when (and (eq consult--buffer-display #'switch-to-buffer-other-window)
+ (not other-win))
+ (switch-to-buffer-other-window orig-buf)
+ (setq other-win (selected-window)))
+ (let ((win (or other-win (selected-window)))
+ (buf (or (and cand (get-buffer cand)) orig-buf)))
+ (when (and (window-live-p win) (buffer-live-p buf))
+ (with-selected-window win
+ (unless (or orig-prev orig-next)
+ (setq orig-prev (copy-sequence (window-prev-buffers))
+ orig-next (copy-sequence (window-next-buffers))))
+ (switch-to-buffer buf 'norecord)))))))))
(defun consult--buffer-action (buffer &optional norecord)
"Switch to BUFFER via `consult--buffer-display' function.
@@ -4397,8 +4458,7 @@ If NORECORD is non-nil, do not record the buffer switch in the buffer list."
(defvar consult--source-project-buffer
`(:name "Project Buffer"
- :narrow (?p . "Project")
- :hidden t
+ :narrow ?b
:category buffer
:face consult-buffer
:history buffer-name-history
@@ -4414,8 +4474,7 @@ If NORECORD is non-nil, do not record the buffer switch in the buffer list."
(defvar consult--source-project-recent-file
`(:name "Project File"
- :narrow (?p . "Project")
- :hidden t
+ :narrow ?f
:category file
:face consult-file
:history file-name-history
@@ -4430,26 +4489,35 @@ If NORECORD is non-nil, do not record the buffer switch in the buffer list."
recentf-mode))
:items
,(lambda ()
- (when-let (root (consult--project-root))
- (let ((len (length root))
- (ht (consult--buffer-file-hash))
- file-name-handler-alist ;; No Tramp slowdown please.
- items)
- (dolist (file (bound-and-true-p recentf-list) (nreverse items))
- ;; Emacs 29 abbreviates file paths by default, see
- ;; `recentf-filename-handlers'.
- (unless (eq (aref file 0) ?/)
- (setq file (expand-file-name file)))
- (when (and (not (gethash file ht)) (string-prefix-p root file))
- (let ((part (substring file len)))
- (when (equal part "") (setq part "./"))
- (put-text-property 0 1 'multi-category `(file . ,file) part)
- (push part items))))))))
+ (when-let (root (consult--project-root))
+ (let ((len (length root))
+ (ht (consult--buffer-file-hash))
+ items)
+ (dolist (file (bound-and-true-p recentf-list) (nreverse items))
+ ;; Emacs 29 abbreviates file paths by default, see
+ ;; `recentf-filename-handlers'. I recommend to set
+ ;; `recentf-filename-handlers' to nil to avoid any slow down.
+ (unless (eq (aref file 0) ?/)
+ (let (file-name-handler-alist) ;; No Tramp slowdown please.
+ (setq file (expand-file-name file))))
+ (when (and (not (gethash file ht)) (string-prefix-p root file))
+ (let ((part (substring file len)))
+ (when (equal part "") (setq part "./"))
+ (put-text-property 0 1 'multi-category `(file . ,file) part)
+ (push part items))))))))
"Project file candidate source for `consult-buffer'.")
+(defvar consult--source-project-buffer-hidden
+ `(:hidden t :narrow (?p . "Project") ,@consult--source-project-buffer)
+ "Like `consult--source-project-buffer' but hidden by default.")
+
+(defvar consult--source-project-recent-file-hidden
+ `(:hidden t :narrow (?p . "Project") ,@consult--source-project-recent-file)
+ "Like `consult--source-project-recent-file' but hidden by default.")
+
(defvar consult--source-hidden-buffer
`(:name "Hidden Buffer"
- :narrow 32
+ :narrow ?\s
:hidden t
:category buffer
:face consult-buffer
@@ -4517,15 +4585,16 @@ If NORECORD is non-nil, do not record the buffer switch in the buffer list."
:items
,(lambda ()
(let ((ht (consult--buffer-file-hash))
- file-name-handler-alist ;; No Tramp slowdown please.
items)
(dolist (file (bound-and-true-p recentf-list) (nreverse items))
;; Emacs 29 abbreviates file paths by default, see
- ;; `recentf-filename-handlers'.
+ ;; `recentf-filename-handlers'. I recommend to set
+ ;; `recentf-filename-handlers' to nil to avoid any slow down.
(unless (eq (aref file 0) ?/)
- (setq file (expand-file-name file)))
+ (let (file-name-handler-alist) ;; No Tramp slowdown please.
+ (setq file (expand-file-name file))))
(unless (gethash file ht)
- (push (abbreviate-file-name file) items))))))
+ (push (consult--fast-abbreviate-file-name file) items))))))
"Recent file candidate source for `consult-buffer'.")
;;;###autoload
@@ -4550,16 +4619,10 @@ configuration of the virtual buffer sources."
(unless (plist-get (cdr selected) :match)
(consult--buffer-action (car selected)))))
-;; Populate `consult-project-buffer-sources'.
-(setq consult-project-buffer-sources
- (list
- `(:hidden nil :narrow ?b ,@consult--source-project-buffer)
- `(:hidden nil :narrow ?f ,@consult--source-project-recent-file)))
-
(defmacro consult--with-project (&rest body)
"Ensure that BODY is executed with a project root."
;; We have to work quite hard here to ensure that the project root is
- ;; only overriden at the current recursion level. When entering a
+ ;; only overridden at the current recursion level. When entering a
;; recursive minibuffer session, we should be able to still switch the
;; project. But who does that? Working on the first level on project A
;; and on the second level on project B and on the third level on project C?
@@ -4606,12 +4669,7 @@ BUILDER is the command line builder function."
(lambda (action)
(cond
((stringp action)
- (let ((tmp (funcall builder action)))
- (if (not (keywordp (car tmp)))
- (setq highlight (cdr tmp))
- ;; TODO remove backward compatibility code
- (message "Consult: The command builder return value changed, it should be a pair instead of a plist")
- (setq highlight (plist-get tmp :highlight))))
+ (setq highlight (cdr (funcall builder action)))
(funcall async action))
((consp action)
(let ((file "") (file-len 0) result)
@@ -4683,19 +4741,21 @@ Take the variables `grep-find-ignored-directories' and
(mapcar (lambda (s) (concat "--exclude-dir=" s))
(bound-and-true-p grep-find-ignored-directories))))
-(defun consult--grep (prompt builder dir initial)
- "Run grep in DIR.
+(defun consult--grep (prompt make-builder dir initial)
+ "Run asynchronous grep.
-BUILDER is the command line builder function.
-PROMPT is the prompt string.
-INITIAL is inital input."
- (let* ((prompt-dir (consult--directory-prompt prompt dir))
- (default-directory (cdr prompt-dir)))
+MAKE-BUILDER is the function that returns the command line
+builder function. DIR is a directory or a list of file or
+directories. PROMPT is the prompt string. INITIAL is initial
+input."
+ (pcase-let* ((`(,prompt ,paths ,dir) (consult--directory-prompt prompt dir))
+ (default-directory dir)
+ (builder (funcall make-builder paths)))
(consult--read
(consult--async-command builder
(consult--grep-format builder)
:file-handler t) ;; allow tramp
- :prompt (car prompt-dir)
+ :prompt prompt
:lookup #'consult--lookup-member
:state (consult--grep-state)
:initial (consult--async-split-initial initial)
@@ -4707,14 +4767,14 @@ INITIAL is inital input."
:sort nil)))
(defun consult--grep-lookahead-p (&rest cmd)
- "Return t if grep CMD supports lookahead."
+ "Return t if grep CMD supports look-ahead."
(with-temp-buffer
(insert "xaxbx")
(eq 0 (apply #'call-process-region (point-min) (point-max)
(car cmd) nil nil nil `(,@(cdr cmd) "^(?=.*b)(?=.*a)")))))
-(defun consult--grep-make-builder ()
- "Create grep command line builder."
+(defun consult--grep-make-builder (paths)
+ "Build grep command line and grep across PATHS."
(let* ((cmd (consult--build-args consult-grep-args))
(type (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended)))
(lambda (input)
@@ -4722,7 +4782,7 @@ INITIAL is inital input."
(flags (append cmd opts))
(ignore-case (or (member "-i" flags) (member "--ignore-case" flags))))
(if (or (member "-F" flags) (member "--fixed-strings" flags))
- (cons (append cmd (list "-e" arg) opts)
+ (cons (append cmd (list "-e" arg) opts paths)
(apply-partially #'consult--highlight-regexps
(list (regexp-quote arg)) ignore-case))
(pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg type ignore-case)))
@@ -4730,33 +4790,43 @@ INITIAL is inital input."
(cons (append cmd
(list (if (eq type 'pcre) "-P" "-E") ;; perl or extended
"-e" (consult--join-regexps re type))
- opts)
+ opts paths)
hl))))))))
;;;###autoload
(defun consult-grep (&optional dir initial)
"Search with `grep' for files in DIR where the content matches a regexp.
-The initial input is given by the INITIAL argument.
-
-The input string is split, the first part of the string (grep input) is
-passed to the asynchronous grep process and the second part of the string is
-passed to the completion-style filtering.
-
-The input string is split at a punctuation character, which is given as the
-first character of the input string. The format is similar to Perl-style
-regular expressions, e.g., /regexp/. Furthermore command line options can be
-passed to grep, specified behind --. The overall prompt input has the form
+The initial input is given by the INITIAL argument. DIR can be
+nil, a directory string or a list of file/directory paths. If
+`consult-grep' is called interactively with a prefix argument,
+the user can specify the directories or files to search in.
+Multiple directories must be separated by comma in the
+minibuffer, since they are read via `completing-read-multiple'.
+By default the project directory is used if
+`consult-project-function' is defined and returns non-nil.
+Otherwise the `default-directory' is searched.
+
+The input string is split, the first part of the string (grep
+input) is passed to the asynchronous grep process and the second
+part of the string is passed to the completion-style filtering.
+
+The input string is split at a punctuation character, which is
+given as the first character of the input string. The format is
+similar to Perl-style regular expressions, e.g., /regexp/.
+Furthermore command line options can be passed to grep, specified
+behind --. The overall prompt input has the form
`#async-input -- grep-opts#filter-string'.
-Note that the grep input string is transformed from Emacs regular expressions
-to Posix regular expressions. Always enter Emacs regular expressions at the
-prompt. `consult-grep' behaves like builtin Emacs search commands, e.g.,
-Isearch, which take Emacs regular expressions. Furthermore the asynchronous
-input split into words, each word must match separately and in any order. See
-`consult--regexp-compiler' for the inner workings. In order to disable
-transformations of the grep input, adjust `consult--regexp-compiler'
-accordingly.
+Note that the grep input string is transformed from Emacs regular
+expressions to Posix regular expressions. Always enter Emacs
+regular expressions at the prompt. `consult-grep' behaves like
+builtin Emacs search commands, e.g., Isearch, which take Emacs
+regular expressions. Furthermore the asynchronous input split
+into words, each word must match separately and in any order.
+See `consult--regexp-compiler' for the inner workings. In order
+to disable transformations of the grep input, adjust
+`consult--regexp-compiler' accordingly.
Here we give a few example inputs:
@@ -4766,43 +4836,41 @@ Here we give a few example inputs:
#word -- -C3 : Search for word, include 3 lines as context
#first#second : Search for first, quick filter for second.
-The symbol at point is added to the future history. If `consult-grep'
-is called interactively with a prefix argument, the user can specify
-the directory to search in. By default the project directory is used
-if `consult-project-function' is defined and returns non-nil.
-Otherwise the `default-directory' is searched."
+The symbol at point is added to the future history."
(interactive "P")
- (consult--grep "Grep" (consult--grep-make-builder) dir initial))
+ (consult--grep "Grep" #'consult--grep-make-builder dir initial))
;;;;; Command: consult-git-grep
-(defun consult--git-grep-builder (input)
- "Build command line given CONFIG and INPUT."
- (pcase-let* ((cmd (consult--build-args consult-git-grep-args))
- (`(,arg . ,opts) (consult--command-split input))
- (flags (append cmd opts))
- (ignore-case (or (member "-i" flags) (member "--ignore-case" flags))))
- (if (or (member "-F" flags) (member "--fixed-strings" flags))
- (cons (append cmd (list "-e" arg) opts)
- (apply-partially #'consult--highlight-regexps
- (list (regexp-quote arg)) ignore-case))
- (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended ignore-case)))
- (when re
- (cons (append cmd (cdr (mapcan (lambda (x) (list "--and" "-e" x)) re)) opts)
- hl))))))
+(defun consult--git-grep-make-builder (paths)
+ "Create grep command line builder given PATHS."
+ (let ((cmd (consult--build-args consult-git-grep-args)))
+ (lambda (input)
+ (pcase-let* ((`(,arg . ,opts) (consult--command-split input))
+ (flags (append cmd opts))
+ (ignore-case (or (member "-i" flags) (member "--ignore-case" flags))))
+ (if (or (member "-F" flags) (member "--fixed-strings" flags))
+ (cons (append cmd (list "-e" arg) opts paths)
+ (apply-partially #'consult--highlight-regexps
+ (list (regexp-quote arg)) ignore-case))
+ (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended ignore-case)))
+ (when re
+ (cons (append cmd
+ (cdr (mapcan (lambda (x) (list "--and" "-e" x)) re))
+ opts paths)
+ hl))))))))
;;;###autoload
(defun consult-git-grep (&optional dir initial)
- "Search with `git grep' for files in DIR where the content matches a regexp.
-The initial input is given by the INITIAL argument. See `consult-grep'
-for more details."
+ "Search with `git grep' for files in DIR with INITIAL input.
+See `consult-grep' for details."
(interactive "P")
- (consult--grep "Git-grep" #'consult--git-grep-builder dir initial))
+ (consult--grep "Git-grep" #'consult--git-grep-make-builder dir initial))
;;;;; Command: consult-ripgrep
-(defun consult--ripgrep-make-builder ()
- "Create ripgrep command line builder."
+(defun consult--ripgrep-make-builder (paths)
+ "Create ripgrep command line builder given PATHS."
(let* ((cmd (consult--build-args consult-ripgrep-args))
(type (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended)))
(lambda (input)
@@ -4814,23 +4882,22 @@ for more details."
(not (string-match-p "[[:upper:]]" arg)))
(or (member "-i" flags) (member "--ignore-case" flags)))))
(if (or (member "-F" flags) (member "--fixed-strings" flags))
- (cons (append cmd (list "-e" arg) opts)
+ (cons (append cmd (list "-e" arg) opts paths)
(apply-partially #'consult--highlight-regexps
(list (regexp-quote arg)) ignore-case))
(pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg type ignore-case)))
(when re
(cons (append cmd (and (eq type 'pcre) '("-P"))
(list "-e" (consult--join-regexps re type))
- opts)
+ opts paths)
hl))))))))
;;;###autoload
(defun consult-ripgrep (&optional dir initial)
- "Search with `rg' for files in DIR where the content matches a regexp.
-The initial input is given by the INITIAL argument. See `consult-grep'
-for more details."
+ "Search with `rg' for files in DIR with INITIAL input.
+See `consult-grep' for details."
(interactive "P")
- (consult--grep "Ripgrep" (consult--ripgrep-make-builder) dir initial))
+ (consult--grep "Ripgrep" #'consult--ripgrep-make-builder dir initial))
;;;;; Command: consult-find
@@ -4842,7 +4909,7 @@ The filename at point is added to the future history.
BUILDER is the command line builder function.
PROMPT is the prompt.
-INITIAL is inital input."
+INITIAL is initial input."
(consult--read
(consult--async-command builder
(consult--async-map (lambda (x) (string-remove-prefix "./" x)))
@@ -4856,9 +4923,11 @@ INITIAL is inital input."
:category 'file
:history '(:input consult--find-history)))
-(defun consult--find-make-builder ()
- "Create find command line builder."
- (let* ((cmd (consult--build-args consult-find-args))
+(defun consult--find-make-builder (paths)
+ "Build find command line, finding across PATHS."
+ (let* ((cmd (seq-mapcat (lambda (x)
+ (if (equal x ".") paths (list x)))
+ (consult--build-args consult-find-args)))
(type (if (eq 0 (call-process-shell-command
(concat (car cmd) " -regextype emacs -version")))
'emacs 'basic)))
@@ -4883,18 +4952,18 @@ INITIAL is inital input."
;;;###autoload
(defun consult-find (&optional dir initial)
"Search for files in DIR matching input regexp given INITIAL input.
-
-The find process is started asynchronously, similar to `consult-grep'.
-See `consult-grep' for more details regarding the asynchronous search."
+See `consult-grep' for details regarding the asynchronous search
+and the arguments."
(interactive "P")
- (let* ((prompt-dir (consult--directory-prompt "Find" dir))
- (default-directory (cdr prompt-dir)))
- (find-file (consult--find (car prompt-dir) (consult--find-make-builder) initial))))
+ (pcase-let* ((`(,prompt ,paths ,dir) (consult--directory-prompt "Find" dir))
+ (default-directory dir)
+ (builder (consult--find-make-builder paths)))
+ (find-file (consult--find prompt builder initial))))
;;;;; Command: consult-locate
(defun consult--locate-builder (input)
- "Build command line given CONFIG and INPUT."
+ "Build command line from INPUT."
(pcase-let ((`(,arg . ,opts) (consult--command-split input)))
(unless (string-blank-p arg)
(cons (append (consult--build-args consult-locate-args)
@@ -4916,12 +4985,12 @@ details regarding the asynchronous search."
;;;;; Command: consult-man
(defun consult--man-builder (input)
- "Build command line given CONFIG and INPUT."
+ "Build command line from INPUT."
(pcase-let* ((`(,arg . ,opts) (consult--command-split input))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t)))
+ (`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended t)))
(when re
(cons (append (consult--build-args consult-man-args)
- (list (consult--join-regexps re 'basic))
+ (list (consult--join-regexps re 'extended))
opts)
hl))))
@@ -4983,7 +5052,9 @@ automatically previewed."
(fun (buffer-local-value 'consult--preview-function buf)))
(funcall fun)))
-;;;; Integration with the default completion system
+;;;; Integration with completion systems
+
+;;;;; Integration: Default *Completions*
(defun consult--default-completion-minibuffer-candidate ()
"Return current minibuffer candidate from default completion system or Icomplete."
@@ -5018,16 +5089,75 @@ automatically previewed."
(or (get-text-property beg 'completion--string)
(buffer-substring-no-properties beg end)))))
-;; Announce now that consult has been loaded
-(provide 'consult)
-
-;;;; Integration with other completion systems
+;;;;; Integration: Vertico
+
+(defvar vertico--input)
+(declare-function vertico--exhibit "ext:vertico")
+(declare-function vertico--candidate "ext:vertico")
+(declare-function vertico--all-completions "ext:vertico")
+
+(defun consult--vertico-candidate ()
+ "Return current candidate for Consult preview."
+ (and vertico--input (vertico--candidate 'highlight)))
+
+(defun consult--vertico-refresh ()
+ "Refresh completion UI."
+ (when vertico--input
+ (setq vertico--input t)
+ (vertico--exhibit)))
+
+(defun consult--vertico-filter-adv (orig pattern cands category highlight)
+ "Advice for ORIG `consult--completion-filter' function.
+See `consult--completion-filter' for arguments PATTERN, CANDS, CATEGORY
+and HIGHLIGHT."
+ (if (and (bound-and-true-p vertico-mode) (not highlight))
+ ;; Optimize `consult--completion-filter' using the deferred highlighting
+ ;; from Vertico. The advice is not necessary - it is a pure optimization.
+ (nconc (car (vertico--all-completions pattern cands nil (length pattern)
+ `(metadata (category . ,category))))
+ nil)
+ (funcall orig pattern cands category highlight)))
+
+(with-eval-after-load 'vertico
+ (advice-add #'consult--completion-filter :around #'consult--vertico-filter-adv)
+ (add-hook 'consult--completion-candidate-hook #'consult--vertico-candidate)
+ (add-hook 'consult--completion-refresh-hook #'consult--vertico-refresh)
+ (define-key consult-async-map [remap vertico-insert] 'vertico-next-group))
+
+;;;;; Integration: Mct
-(with-eval-after-load 'icomplete (require 'consult-icomplete))
-(with-eval-after-load 'vertico (require 'consult-vertico))
(with-eval-after-load 'mct (add-hook 'consult--completion-refresh-hook
'mct--live-completions-refresh))
-(with-eval-after-load 'selectrum
- (warn (propertize "Consult: Selectrum has been deprecated in favor of Vertico" 'face 'warning)))
+;;;;; Integration: Icomplete
+
+(defvar icomplete-mode)
+(declare-function icomplete-exhibit "icomplete")
+
+(defun consult--icomplete-refresh ()
+ "Refresh icomplete view."
+ (when icomplete-mode
+ (let ((top (car completion-all-sorted-completions)))
+ (completion--flush-all-sorted-completions)
+ ;; force flushing, otherwise narrowing is broken!
+ (setq completion-all-sorted-completions nil)
+ (when top
+ (let* ((completions (completion-all-sorted-completions))
+ (last (last completions))
+ (before)) ;; completions before top
+ ;; warning: completions is an improper list
+ (while (consp completions)
+ (if (equal (car completions) top)
+ (progn
+ (setcdr last (append (nreverse before) (cdr last)))
+ (setq completion-all-sorted-completions completions
+ completions nil))
+ (push (car completions) before)
+ (setq completions (cdr completions)))))))
+ (icomplete-exhibit)))
+
+(with-eval-after-load 'icomplete
+ (add-hook 'consult--completion-refresh-hook #'consult--icomplete-refresh))
+
+(provide 'consult)
;;; consult.el ends here
diff --git a/debian/changelog b/debian/changelog
index 085bbe5..23f145e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+consult-el (0.34-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- Debian Janitor <janitor@jelmer.uk> Sun, 14 May 2023 15:57:58 -0000
+
consult-el (0.32-1) unstable; urgency=medium
[ Aymeric Agon-Rambosson ]
diff --git a/debian/patches/remove-external-images.patch b/debian/patches/remove-external-images.patch
index 8e5e963..d8493a7 100644
--- a/debian/patches/remove-external-images.patch
+++ b/debian/patches/remove-external-images.patch
@@ -3,8 +3,10 @@ Date: Wed, 10 Aug 2022 04:55:32 +0200
Subject: Drop references to external images
Forwarded: not-needed
---- a/README.org
-+++ b/README.org
+Index: consult-el.git/README.org
+===================================================================
+--- consult-el.git.orig/README.org
++++ consult-el.git/README.org
@@ -6,12 +6,6 @@
#+texinfo_dir_title: Consult: (consult).
#+texinfo_dir_desc: Useful commands built on completing-read.
diff --git a/debian/patches/replace-external-references-when-possible.patch b/debian/patches/replace-external-references-when-possible.patch
index 9d6136c..6a9a7dc 100644
--- a/debian/patches/replace-external-references-when-possible.patch
+++ b/debian/patches/replace-external-references-when-possible.patch
@@ -3,8 +3,10 @@ Date: Wed, 10 Aug 2022 04:55:32 +0200
Subject: Drop references to external pages and debianise
Forwarded: not-needed
---- a/README.org
-+++ b/README.org
+Index: consult-el.git/README.org
+===================================================================
+--- consult-el.git.orig/README.org
++++ consult-el.git/README.org
@@ -7,7 +7,7 @@
#+texinfo_dir_desc: Useful commands built on completing-read.
@@ -43,7 +45,7 @@ Forwarded: not-needed
all Consult commands with their abbreviated description. Alternatively, type
=C-h a ^consult= to get an overview of all Consult variables and functions with
their descriptions.
-@@ -389,7 +389,7 @@ their descriptions.
+@@ -390,7 +390,7 @@ their descriptions.
#+end_src
Instead of =consult-completion-in-region=, you may prefer to see the
completions directly in the buffer as a small popup. In that case, I recommend
@@ -52,7 +54,7 @@ Forwarded: not-needed
=consult-completion-in-region= in combination with Lsp-mode or Eglot. The Lsp
server relies on the input at point, in order to generate refined candidate
strings. Since the completion is transferred from the original buffer to the
-@@ -507,7 +507,7 @@ pressing =C-h=. When pressing =C-h= afte
+@@ -508,7 +508,7 @@ pressing =C-h=. When pressing =C-h= afte
is invoked, which shows the keybinding help window by default. As a more compact
alternative, there is the =consult-narrow-help= command which can be bound to a
key, for example =?= or =C-h= in the =consult-narrow-map=, as shown in the [[#use-package-example][example
@@ -61,7 +63,7 @@ Forwarded: not-needed
shown in the which-key window after pressing the =consult-narrow-key=.
** Asynchronous search
-@@ -702,11 +702,11 @@ since some details may still change.
+@@ -703,11 +703,11 @@ since some details may still change.
:end:
#+cindex: embark
@@ -76,7 +78,7 @@ Forwarded: not-needed
capabilities.
Actions are commands which can operate on the currently selected candidate (or
-@@ -726,7 +726,7 @@ the matching lines from =consult-line=,
+@@ -727,7 +727,7 @@ the matching lines from =consult-line=,
they can be edited via the =occur-edit-mode= (press key =e=). Similarly, Embark
supports exporting the matches found by =consult-grep=, =consult-ripgrep= and
=consult-git-grep= to a Grep buffer, where the matches across files can be edited,
@@ -85,7 +87,7 @@ Forwarded: not-needed
+ =consult-line= -> =embark-export= to =occur-mode= buffer -> =occur-edit-mode= for editing of matches in buffer.
+ =consult-grep= -> =embark-export= to =grep-mode= buffer -> =wgrep= for editing of all matches.
-@@ -737,14 +737,12 @@ if the [[https://github.com/mhayashi1120
+@@ -738,14 +738,12 @@ if the [[https://github.com/mhayashi1120
:description: Example configuration and customization variables
:end:
@@ -102,7 +104,7 @@ Forwarded: not-needed
configuration. Consult relies on lambdas and lexical closures. For this reason
many Consult-related snippets require lexical binding.
-@@ -760,8 +758,8 @@ modes. Therefore the package is non-intr
+@@ -761,8 +759,8 @@ modes. Therefore the package is non-intr
effort. In order to use the Consult commands, it is advised to add keybindings
for commands which are accessed often. Rarely used commands can be invoked via
=M-x=. Feel free to only bind the commands you consider useful to your workflow.
@@ -113,7 +115,7 @@ Forwarded: not-needed
*NOTE:* There is the [[https://github.com/minad/consult/wiki][Consult wiki]], where you can contribute additional
configuration examples.
-@@ -893,7 +891,7 @@ configuration examples.
+@@ -894,7 +892,7 @@ configuration examples.
:end:
#+cindex: customization
@@ -122,7 +124,7 @@ Forwarded: not-needed
^consult= to see all Consult-specific customizable variables with their current
values and abbreviated description. Alternatively, type =C-h a ^consult= to get
an overview of all Consult variables and functions with their descriptions.
-@@ -1016,10 +1014,12 @@ following techniques:
+@@ -1017,10 +1015,12 @@ following techniques:
I use and recommend this combination of packages:
- consult: This package
@@ -139,7 +141,7 @@ Forwarded: not-needed
There exist many other fine completion UIs beside Vertico, which are supported
by Consult. Give them a try and find out which interaction model fits best for
-@@ -1047,39 +1047,39 @@ You can integrate Consult with special p
+@@ -1048,39 +1048,39 @@ You can integrate Consult with special p
wider Emacs ecosystem. You may want to install some of theses packages depending
on your preferences and requirements.
@@ -192,7 +194,7 @@ Forwarded: not-needed
- [[https://github.com/iyefrat/all-the-icons-completion][all-the-icons-completion]]: Icons for the completion UI.
* Bug reports
-@@ -1137,7 +1137,7 @@ Please provide the necessary important i
+@@ -1141,7 +1141,7 @@ Please provide the necessary important i
Consult does not provide Evil integration out of the box, but there is some
support in [[https://github.com/emacs-evil/evil-collection][evil-collection]].
@@ -201,7 +203,7 @@ Forwarded: not-needed
Consult often relies on lambdas and lexical closures.
* Contributions
-@@ -1161,7 +1161,7 @@ small configuration or command snippets.
+@@ -1165,7 +1165,7 @@ small configuration or command snippets.
:description: Contributors and Sources of Inspiration
:end:
Debdiff
[The following lists of changes regard files as different if they have different names, permissions or owners.]
Files in second set of .debs but not in first
-rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-autoloads.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-compile.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-flymake.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-imenu.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-info.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-kmacro.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-org.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-pkg.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-register.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult-xref.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.34/consult.el
Files in first set of .debs but not in second
-rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-autoloads.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-compile.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-flymake.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-icomplete.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-imenu.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-info.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-kmacro.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-org.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-pkg.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-register.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-vertico.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult-xref.el -rw-r--r-- root/root /usr/share/emacs/site-lisp/elpa-src/consult-0.32/consult.el
Control files: lines which differ (wdiff format)
Depends: elpa-compat (>= 29.1.3.2), 29.1.4.1), dh-elpa-helper, emacsen-common