summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLev Lamberov <dogsleg@debian.org>2023-02-07 05:58:38 +0100
committerLev Lamberov <dogsleg@debian.org>2023-02-07 05:58:38 +0100
commitfd23d18a3d73f2fb059cb1f72c9b91d04dcea977 (patch)
tree4d64407af0d9802c2937d1b80aa875bff507765a
parent6557902baecc110899459376d94f60b9ccc803e1 (diff)
parent5c9edb38f774aae9a9e793e7ac9b5acab004421b (diff)
Record consult-el (0.32-1) in archive suite sid
Diffstat
-rw-r--r--CHANGELOG.org59
-rw-r--r--README.org189
-rw-r--r--consult-compile.el8
-rw-r--r--consult-flymake.el10
-rw-r--r--consult-icomplete.el10
-rw-r--r--consult-imenu.el36
-rw-r--r--consult-info.el181
-rw-r--r--consult-kmacro.el92
-rw-r--r--consult-org.el11
-rw-r--r--consult-register.el51
-rw-r--r--consult-selectrum.el101
-rw-r--r--consult-vertico.el15
-rw-r--r--consult-xref.el26
-rw-r--r--consult.el2549
-rw-r--r--debian/changelog13
-rw-r--r--debian/control2
-rw-r--r--debian/gbp.conf3
-rw-r--r--debian/patches/remove-external-images.patch6
-rw-r--r--debian/patches/replace-external-references-when-possible.patch54
19 files changed, 1956 insertions, 1460 deletions
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 18dfa88..9202293 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -2,6 +2,61 @@
#+author: Daniel Mendler
#+language: en
+* Version 0.32 (2023-02-06)
+
+- Bugfixes
+- Update the 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=.
+- 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
+ Debian stable.
+- =consult-ripgrep-args=: Add =--search-zip= option to automatically search through
+ compressed files. This will allow you to search Elisp files bundled with your
+ Emacs installation. Move to an Elisp library via =find-library=, then invoke
+ =consult-ripgrep=.
+- Drop obsolete =consult-apropos=. Alternatives: =describe-symbol= in combination
+ with =embark-export=. See also =consult-info= and =consult-ripgrep= to search
+ through info manuals and Elisp source code.
+- Drop obsolete =consult-multi-occur=. Alternative: Built-in =multi-occur=,
+ =multi-occur-in-matching-buffers= or =consult-line-multi=.
+- Drop obsolete =consult-file-externally=. The command has been moved to Embark
+ under the name =embark-open-externally=.
+
+* Version 0.31 (2023-01-06)
+
+- Version bump to update the Compat package dependency (29.1.0.1)
+
+* Version 0.30 (2023-01-02)
+
+- Bugfixes
+- Drop Selectrum support
+- Deprecate =consult-file-externally= in favor of =embark-open-externally=
+- Deprecate =consult-multi-occur=. The =multi-occur= command should be improved
+ upstream to take advantage of =completing-read-multiple=. Consult provides the
+ command =consult-line-multi= as an alternative.
+- =consult-history=: Use input as initial completion input
+
+* Version 0.29 (2022-12-03)
+
+- Bugfixes
+- =consult-line-multi= has been rewritten completely. The candidates are computed
+ on demand based on the input. This reduces startup speed greatly. The command
+ behaves like =consult-grep=, but operates on buffers instead of files.
+- Add =consult--source-file-register=, and make the registers available in
+ =consult-buffer=. Registers are often used as quick access keys for files, e.g.,
+ =(add-to-list 'register-alist '(?i file . "~/.emacs.d/init.el")))=.
+- Remove obsolete =consult-line-point-placement=
+- =consult-grep/find=: Always show directory in the prompt
+- Add variable =consult-yank-rotate=, =consult-yank-from-kill-ring= rotates kill ring
+- Emacs 29: =consult-register= supports =buffer= register type
+- Emacs 29: Support =outline-search-function=
+- Org 9.6: Support new =org-fold-core= API (both overlays and text-properties)
+- Support abbreviated file names in =recentf-list=, see =recentf-filename-handler=.
+- Deprecate =consult-apropos=
+
* Version 0.20 (2022-10-16)
- Bugfixes
@@ -70,7 +125,7 @@
* Version 0.16 (2022-03-08)
-- Bug fixes
+- Bugfixes
- Deprecate =consult-project-root-function= in favor of =consult-project-function=.
- Preconfigure =consult-project-function= with a default function based
on project.el.
@@ -204,7 +259,7 @@
- Rename =consult-error= to =consult-compile-error=
- =consult-compile-error=: Allow calling the command from any buffer,
use the errors from all compilation buffers related to the current buffer.
-- =consult-man=: Handle aggreated entries returned by mandoc
+- =consult-man=: Handle aggregated entries returned by mandoc
- =consult-completion-in-region=: Added preview and =consult-preview-region= face
- Added =consult-completion-in-region-styles= customization variable
- Added =consult-xref=. The function can be set as =xref-show-xrefs-function=
diff --git a/README.org b/README.org
index 02bdb18..d000589 100644
--- a/README.org
+++ b/README.org
@@ -6,15 +6,16 @@
#+texinfo_dir_title: Consult: (consult).
#+texinfo_dir_desc: Useful commands built on completing-read.
-Consult provides practical commands based on the Emacs completion function
-[[info:elisp#Minibuffer Completion][completing-read]]. Completion allows you to quickly select an item from a list of
-candidates. Consult offers in particular an advanced buffer switching command
-=consult-buffer= to switch between buffers and recently opened files. Furthermore
-Consult provides multiple search commands, an asynchronous =consult-grep= and
-=consult-ripgrep=, and the line-based search command =consult-line=. Some of the
-Consult commands are enhanced versions of built-in Emacs commands. For example
-the command =consult-imenu= presents a flat list of the Imenu with [[#live-previews][live preview]],
-[[#narrowing-and-grouping][grouping and narrowing]]. Please take a look at the [[#available-commands][full list of commands]].
+Consult provides search and navigation commands based on the Emacs completion
+function [[info:elisp#Minibuffer Completion][completing-read]]. Completion allows you to quickly select an item from a
+list of candidates. Consult offers asynchronous and interactive =consult-grep= and
+=consult-ripgrep= commands, and the line-based search command =consult-line=.
+Furthermore Consult provides an advanced buffer switching command =consult-buffer=
+to switch between buffers, recently opened files, bookmarks and buffer-like
+candidates from other sources. Some of the Consult commands are enhanced
+versions of built-in Emacs commands. For example the command =consult-imenu=
+presents a flat list of the Imenu with [[#live-previews][live preview]], [[#narrowing-and-grouping][grouping and narrowing]].
+Please take a look at the [[#available-commands][full list of commands]].
Consult is fully compatible with completion systems centered around the standard
Emacs =completing-read= API, notably the default completion system, Vertico (~apt install elpa-vertico~), [[https://github.com/protesilaos/mct][Mct]],
@@ -91,6 +92,7 @@ their descriptions.
- SPC Hidden buffers
- * Modified buffers
- f Files (Requires =recentf-mode=)
+ - r File registers
- m Bookmarks
- p Project
- Custom [[#multiple-sources][other sources]] configured in =consult-buffer-sources=.
@@ -194,7 +196,6 @@ their descriptions.
#+findex: consult-line
#+findex: consult-line-multi
-#+findex: consult-multi-occur
#+findex: consult-keep-lines
#+findex: consult-focus-lines
- =consult-line=: Enter search string and select from matching lines.
@@ -202,11 +203,10 @@ their descriptions.
recent Isearch string are added to the "future history" and can be accessed
by pressing =M-n=. When =consult-line= is bound to the =isearch-mode-map= and
is invoked during a running Isearch, it will use the current Isearch string.
-- =consult-line-multi=: Search across multiple buffers. By default search across
- project buffers. If invoked with a prefix argument search across all buffers.
- Behaves like =consult-line=.
-- =consult-multi-occur=: Replacement for =multi-occur= which uses
- =completing-read-multiple=.
+- =consult-line-multi=: Search dynamically across multiple buffers. By default
+ search across project buffers. If invoked with a prefix argument search across
+ all buffers. The candidates are computed on demand based on the input. The
+ command behaves like =consult-grep=, but operates on buffers instead of files.
- =consult-keep-lines=: Replacement for =keep/flush-lines= which uses the current
completion style for filtering the buffer. The function updates the buffer
while typing. In particular =consult-keep-lines= can narrow down an exported
@@ -328,26 +328,46 @@ their descriptions.
- =consult-org-agenda=: Jump to an agenda heading. Supports
narrowing by heading level, priority and TODO state, as well as
live preview and recursive editing.
+** Help
+:properties:
+:description: Searching through help
+:end:
+
+#+findex: consult-info
+#+findex: consult-man
+- =consult-man=: Find Unix man page, via Unix =apropos= or =man -k=. =consult-man= opens
+ the selected man page using the Emacs =man= command.
+- =consult-info=: Full text search through info pages. If the command is invoked
+ from within an ~*info*~ buffer, it will search through the current manual. You
+ may want to create your own commands which search through a predefined set of
+ info pages, for example:
+#+begin_src emacs-lisp
+ (defun consult-info-emacs ()
+ "Search through Emacs info pages."
+ (interactive)
+ (consult-info "emacs" "efaq" "elisp" "cl" "compat"))
+
+ (defun consult-info-org ()
+ "Search through the Org info page."
+ (interactive)
+ (consult-info "org"))
+
+ (defun consult-info-completion ()
+ "Search through completion info pages."
+ (interactive)
+ (consult-info "vertico" "consult" "marginalia" "orderless" "embark"
+ "corfu" "cape" "tempel"))
+#+end_src
** Miscellaneous
:properties:
:description: Various other useful commands
:end:
-#+findex: consult-apropos
-#+findex: consult-file-externally
#+findex: consult-completion-in-region
#+findex: consult-theme
-#+findex: consult-man
#+findex: consult-preview-at-point
#+findex: consult-preview-at-point-mode
-- =consult-apropos=: Replacement for =apropos= with completion. As a better
- alternative, you can run =embark-export= from commands like =M-x= or
- =describe-symbol=.
-- =consult-man=: Find Unix man page, via Unix =apropos= or =man -k=. =consult-man= opens
- the selected man page using the Emacs =man= command.
-- =consult-file-externally=: Select a file and open it externally, e.g. using
- =xdg-open= on Linux.
- =consult-theme=: Select a theme and disable all currently enabled themes.
Supports live preview of the theme while scrolling through the candidates.
- =consult-preview-at-point= and =consult-preview-at-point-mode=: Command and minor
@@ -413,8 +433,8 @@ following settings are possible:
- Automatic and immediate ='any=
- Automatic and delayed =(list :debounce 0.5 'any)=
-- Manual and immediate =(kbd "M-.")=
-- Manual and delayed =(list :debounce 0.5 (kbd "M-."))=
+- Manual and immediate ="M-."=
+- Manual and delayed =(list :debounce 0.5 "M-.")=
- Disabled =nil=
A safe recommendation is to leave automatic immediate previews enabled in
@@ -430,11 +450,11 @@ to be considered.
(consult-customize
consult-ripgrep consult-git-grep consult-grep
consult-bookmark consult-recent-file consult-xref
- consult--source-bookmark consult--source-recent-file
- consult--source-project-recent-file
- ;; my/command-wrapping-consult ;; disable auto previews inside my command
- ;; :preview-key '(:debounce 0.2 any) ;; Option 1: Delay preview
- :preview-key (kbd "M-.")) ;; Option 2: Manual preview
+ consult--source-bookmark consult--source-file-register
+ consult--source-recent-file consult--source-project-recent-file
+ ;; my/command-wrapping-consult ;; disable auto previews inside my command
+ :preview-key '(:debounce 0.4 any) ;; Option 1: Delay preview
+ ;; :preview-key "M-.") ;; Option 2: Manual preview
#+end_src
In this case one may wonder what the difference is between using an Embark
@@ -454,9 +474,9 @@ UI experience.
;; Preview immediately on M-., on up/down after 0.5s, on any other key after 1s
(consult-customize consult-theme
:preview-key
- (list (kbd "M-.")
- :debounce 0.5 (kbd "<up>") (kbd "<down>")
- :debounce 1 'any))
+ '("M-."
+ :debounce 0.5 "<up>" "<down>"
+ :debounce 1 any))
#+end_src
** Narrowing and grouping
@@ -608,8 +628,9 @@ configure a manual preview as follows.
#+begin_src emacs-lisp
(consult-customize
- consult--source-bookmark consult--source-recent-file
- consult--source-project-recent-file :preview-key (kbd "M-."))
+ consult--source-bookmark consult--source-file-register
+ consult--source-recent-file consult--source-project-recent-file
+ :preview-key "M-.")
#+end_src
Sources can be added directly to the =consult-buffer-source= list for convenience.
@@ -748,9 +769,12 @@ configuration examples.
(use-package consult
;; Replace bindings. Lazily loaded due by `use-package'.
:bind (;; C-c bindings (mode-specific-map)
+ ("C-c M-x" . consult-mode-command)
("C-c h" . consult-history)
- ("C-c m" . consult-mode-command)
("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 M-:" . consult-complex-command) ;; orig. repeat-complex-command
("C-x b" . consult-buffer) ;; orig. switch-to-buffer
@@ -764,7 +788,6 @@ configuration examples.
("C-M-#" . consult-register)
;; Other custom bindings
("M-y" . consult-yank-pop) ;; orig. yank-pop
- ("<help> a" . consult-apropos) ;; orig. apropos-command
;; M-g bindings (goto-map)
("M-g e" . consult-compile-error)
("M-g f" . consult-flymake) ;; Alternative: consult-flycheck
@@ -783,7 +806,6 @@ configuration examples.
("M-s r" . consult-ripgrep)
("M-s l" . consult-line)
("M-s L" . consult-line-multi)
- ("M-s m" . consult-multi-occur)
("M-s k" . consult-keep-lines)
("M-s u" . consult-focus-lines)
;; Isearch integration
@@ -826,22 +848,22 @@ configuration examples.
;; Optionally configure preview. The default value
;; is 'any, such that any key triggers the preview.
;; (setq consult-preview-key 'any)
- ;; (setq consult-preview-key (kbd "M-."))
- ;; (setq consult-preview-key (list (kbd "<S-down>") (kbd "<S-up>")))
+ ;; (setq consult-preview-key "M-.")
+ ;; (setq consult-preview-key '("S-<down>" "S-<up>"))
;; For some commands and buffer sources it is useful to configure the
;; :preview-key on a per-command basis using the `consult-customize' macro.
(consult-customize
- consult-theme
- :preview-key '(:debounce 0.2 any)
+ consult-theme :preview-key '(:debounce 0.2 any)
consult-ripgrep consult-git-grep consult-grep
consult-bookmark consult-recent-file consult-xref
- consult--source-bookmark consult--source-recent-file
- consult--source-project-recent-file
- :preview-key (kbd "M-."))
+ consult--source-bookmark consult--source-file-register
+ consult--source-recent-file consult--source-project-recent-file
+ ;; :preview-key "M-."
+ :preview-key '(:debounce 0.4 any))
;; Optionally configure the narrowing key.
;; Both < and C-+ work reasonably well.
- (setq consult-narrow-key "<") ;; (kbd "C-+")
+ (setq consult-narrow-key "<") ;; "C-+"
;; Optionally make narrowing help available in the minibuffer.
;; You may want to use `embark-prefix-help-command' or which-key instead.
@@ -849,16 +871,17 @@ configuration examples.
;; By default `consult-project-function' uses `project-root' from project.el.
;; Optionally configure a different project root function.
- ;; There are multiple reasonable alternatives to chose from.
;;;; 1. project.el (the default)
;; (setq consult-project-function #'consult--default-project--function)
- ;;;; 2. projectile.el (projectile-project-root)
- ;; (autoload 'projectile-project-root "projectile")
- ;; (setq consult-project-function (lambda (_) (projectile-project-root)))
- ;;;; 3. vc.el (vc-root-dir)
+ ;;;; 2. vc.el (vc-root-dir)
;; (setq consult-project-function (lambda (_) (vc-root-dir)))
- ;;;; 4. locate-dominating-file
+ ;;;; 3. locate-dominating-file
;; (setq consult-project-function (lambda (_) (locate-dominating-file "." ".git")))
+ ;;;; 4. projectile.el (projectile-project-root)
+ ;; (autoload 'projectile-project-root "projectile")
+ ;; (setq consult-project-function (lambda (_) (projectile-project-root)))
+ ;;;; 5. No project support
+ ;; (setq consult-project-function nil)
)
#+end_src
@@ -914,6 +937,7 @@ an overview of all Consult variables and functions with their descriptions.
| consult-ripgrep-args | Command line arguments for ripgrep |
| consult-themes | List of themes to be presented for selection |
| consult-widen-key | Widening key during completion |
+| consult-yank-rotate | Rotate kill ring |
** Fine-tuning of individual commands
:properties:
@@ -948,13 +972,13 @@ Useful options are:
;; Disable preview for `consult-theme' completely.
consult-theme :preview-key nil
;; Set preview for `consult-buffer' to key `M-.'
- consult-buffer :preview-key (kbd "M-.")
+ consult-buffer :preview-key "M-."
;; For `consult-line' change the prompt and specify multiple preview
;; keybindings. Note that you should bind <S-up> and <S-down> in the
;; `minibuffer-local-completion-map' or `vertico-map' to the commands which
;; select the previous or next candidate.
consult-line :prompt "Search: "
- :preview-key (list (kbd "<S-down>") (kbd "<S-up>")))
+ :preview-key '("S-<down>" "S-<up>"))
#+end_src
The configuration values are evaluated at runtime, just before the completion
@@ -999,24 +1023,40 @@ I use and recommend this combination of packages:
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
-you!
+you.
- The builtin completion UI, which pops up the =*Completions*= buffer.
- The builtin =icomplete-vertical-mode= in Emacs 28.
- [[https://git.sr.ht/~protesilaos/mct][mct by Protesilaos Stavrou]]: Minibuffer and Completions in Tandem, which builds
on the default completion UI (development currently [[https://protesilaos.com/codelog/2022-04-14-emacs-discontinue-mct/][discontinued]]).
-You can integrated Consult with special programs or with other packages in the
+Note that all packages are independent and can be exchanged with alternative
+components, since there exist no hard dependencies. Furthermore it is possible
+to get started with only default completion and Consult and add more components
+later to the mix. For example you can omit Marginalia if you don't need
+annotations. I highly recommend the Embark package, but in order to familiarize
+yourself with the other components, you can first start without it - or you could
+use with Embark right away and add the other components later on.
+
+* Auxiliary packages
+:properties:
+:description: Integrations with the wider ecosystem
+:end:
+
+You can integrate Consult with special programs or with other packages in the
wider Emacs ecosystem. You may want to install some of theses packages depending
on your preferences and requirements.
- [[https://github.com/yadex205/consult-ag][consult-ag]]: Support for the Silver Searcher (~apt install silversearcher-ag~) in the style of =consult-grep=.
-- [[https://github.com/mohkale/consult-company][consult-company]]: Completion at point using the [[https://github.com/company-mode/company-mode][Company]] backends.
+- [[https://github.com/mohkale/consult-company][consult-company]]: Completion at point using the Company (~apt install elpa-company~) backends.
+- [[https://github.com/youngker/consult-codesearch.el][consult-codesearch]]: Integration with [[https://github.com/google/codesearch][Code Search]].
- [[https://github.com/karthink/consult-dir][consult-dir]]: Directory jumper using Consult multi sources.
- [[https://codeberg.org/ravi/consult-dash][consult-dash]]: Consult interface to [[https://github.com/dash-docs-el/dash-docs][Dash documentation]]
- [[https://github.com/mohkale/consult-eglot][consult-eglot]]: Integration with Eglot (LSP client, ~apt install elpa-eglot~).
-- [[https://github.com/minad/consult-flycheck][consult-flycheck]]: Additional Flycheck (~apt install elpa-flycheck~)integration.
+- [[https://github.com/minad/consult-flycheck][consult-flycheck]]: Additional Flycheck (~apt install elpa-flycheck~) integration.
- [[https://gitlab.com/OlMon/consult-flyspell][consult-flyspell]]: Additional Flyspell integration.
+- [[https://github.com/ghosty141/consult-git-log-grep][consult-git-log-grep]]: Consult interface to git log.
+- [[https://github.com/Nyoho/consult-hatena-bookmark][consult-hatena-bookmark]]: Access Hatena bookmarks.
- [[https://github.com/rcj/consult-ls-git][consult-ls-git]]: List files from git via Consult.
- [[https://github.com/gagbo/consult-lsp][consult-lsp]]: Integration with Lsp-mode (LSP client, ~apt install elpa-lsp-mode~).
- [[https://codeberg.org/jao/consult-notmuch][consult-notmuch]]: Access the Notmuch (~apt install notmuch~) email system using Consult.
@@ -1024,7 +1064,7 @@ on your preferences and requirements.
- [[https://github.com/jgru/consult-org-roam][consult-org-roam]]: Integration with Org-roam (~apt install elpa-org-roam~).
- [[https://github.com/Qkessler/consult-project-extra/][consult-project-extra]]: Additional project.el extras and buffer sources.
- [[https://gitlab.com/OlMon/consult-projectile/][consult-projectile]]: Additional Projectile (~apt install elpa-projectile~) integration and buffer sources.
-- [[https://codeberg.org/jao/consult-recoll][consult-recoll]]: Access the Recoll (~apt install recoll~) desktop full-text search using Consult.
+- [[https://codeberg.org/jao/consult-recoll][consult-recoll]]: Access the Recoll (~apt install elpa-recoll~) desktop full-text search using Consult.
- [[https://codeberg.org/jao/espotify][consult-spotify]]: Access the Spotify API and control your local music player.
- [[https://github.com/mohkale/consult-yasnippet][consult-yasnippet]]: Integration with Yasnippet (~apt install elpa-yasnippet elpa-yasnippet-snippets~).
- [[https://github.com/minad/affe][affe]]: Asynchronous Fuzzy Finder for Emacs based on Consult.
@@ -1042,14 +1082,6 @@ offer functionality based on ~completing-read~.
- wgrep (~apt install elpa-wgrep~): Editing of grep buffers, use together with =consult-grep= via =embark-export=.
- [[https://github.com/iyefrat/all-the-icons-completion][all-the-icons-completion]]: Icons for the completion UI.
-Note that all packages are independent and can be exchanged with alternative
-components, since there exist no hard dependencies. Furthermore it is possible
-to get started with only default completion and Consult and add more components
-later to the mix. For example you can omit Marginalia if you don't need
-annotations. I highly recommend the Embark package, but in order to familiarize
-yourself with the other components, you can first start without it - or you could
-use with Embark right away and add the other components later on.
-
* Bug reports
:properties:
:description: How to create reproducible bug reports
@@ -1058,15 +1090,17 @@ use with Embark right away and add the other components later on.
If you find a bug or suspect that there is a problem with Consult, please carry
out the following steps:
-1. *Update all the relevant packages to the newest version*.
- This includes Consult, Vertico or other completion UIs, Marginalia, Embark
- and Orderless.
-2. Either use the default completion UI or ensure that exactly one of
+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
=vertico-mode=, =mct-mode=, or =icomplete-mode= is enabled. The unsupported modes
- =ivy-mode=, =helm-mode= and =ido-ubiquitous-mode= must be disabled.
-3. Ensure that the =completion-styles= variable is properly configured. Try to set
+ =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
=completion-styles= to a list including =substring= or =orderless=.
-4. Try to reproduce the issue by starting a bare bone Emacs instance with =emacs -Q=
+5. 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
@@ -1184,6 +1218,9 @@ Authors of supplementary =consult-*= packages:
- [[https://github.com/rcj][Robin Joy]] ([[https://github.com/rcj/consult-ls-git][consult-ls-git]])
- [[https://codeberg.org/ravi][Ravi R Kiran]] [[https://codeberg.org/ravi/consult-dash][(consult-dash]])
- [[https://github.com/mclearc][Colin McLear]] ([[https://github.com/mclear-tools/consult-notes][consult-notes]])
+- [[https://github.com/Nyoho][Yukinori Kitadai]] ([[https://github.com/Nyoho/consult-hatena-bookmark][consult-hatena-bookmark]])
+- [[https://github.com/ghosty141][ghosty141]] ([[https://github.com/ghosty141/consult-git-log-grep][consult-git-log-grep]])
+- [[https://github.com/youngker][YoungJoo Lee]] ([[https://github.com/youngker/consult-codesearch.el][consult-codesearch]])
#+html: <!--
diff --git a/consult-compile.el b/consult-compile.el
index c23a0b0..4c585d5 100644
--- a/consult-compile.el
+++ b/consult-compile.el
@@ -1,6 +1,6 @@
;;; consult-compile.el --- Provides the command `consult-compile-error' -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -19,8 +19,8 @@
;;; Commentary:
-;; Provides the command `consult-compile-error'. This is an extra
-;; package, to allow lazy loading of compile.el. The
+;; Provides the command `consult-compile-error'. This is an extra
+;; package, to allow lazy loading of compile.el. The
;; `consult-compile-error' command is autoloaded.
;;; Code:
@@ -55,7 +55,7 @@
(when-let (msg (get-text-property pos 'compilation-message))
(goto-char pos)
(push (propertize
- (consult-compile--font-lock (consult--buffer-substring pos (line-end-position)))
+ (consult-compile--font-lock (consult--buffer-substring pos (pos-eol)))
'consult--type (pcase (compilation--message->type msg)
(0 ?i)
(1 ?w)
diff --git a/consult-flymake.el b/consult-flymake.el
index 0af8a90..ae47e55 100644
--- a/consult-flymake.el
+++ b/consult-flymake.el
@@ -1,6 +1,6 @@
;;; consult-flymake.el --- Provides the command `consult-flymake' -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -19,8 +19,8 @@
;;; Commentary:
-;; Provides the command `consult-flymake'. This is an extra package,
-;; to allow lazy loading of flymake.el. The `consult-flymake' command
+;; Provides the command `consult-flymake'. This is an extra package,
+;; to allow lazy loading of flymake.el. The `consult-flymake' command
;; is autoloaded.
;;; Code:
@@ -56,7 +56,9 @@ DIAGS should be a list of diagnostics as returned from `flymake-diagnostics'."
('flymake-error ?e)
('flymake-warning ?w)
(_ ?n))))))))
- diags))
+ (seq-filter (lambda (diag)
+ (buffer-live-p (flymake-diagnostic-buffer diag)))
+ diags)))
(buffer-width (apply #'max (mapcar (lambda (x) (length (nth 0 x))) diags)))
(line-width (apply #'max (mapcar (lambda (x) (length (number-to-string (nth 1 x)))) diags)))
(fmt (format "%%-%ds %%-%dd %%-7s %%s" buffer-width line-width)))
diff --git a/consult-icomplete.el b/consult-icomplete.el
index 403bf70..4dcf2c1 100644
--- a/consult-icomplete.el
+++ b/consult-icomplete.el
@@ -1,6 +1,6 @@
;;; consult-icomplete.el --- Icomplete integration for Consult -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -19,7 +19,7 @@
;;; Commentary:
-;; Integration code for the Icomplete completion system. This package
+;; Integration code for the Icomplete completion system. This package
;; is automatically loaded by Consult.
;;; Code:
@@ -27,14 +27,14 @@
(require 'consult)
(require 'icomplete)
-(defun consult-icomplete--refresh (&optional reset)
- "Refresh icomplete view, keep current candidate unless RESET is non-nil."
+(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 (and top (not reset))
+ (when top
(let* ((completions (completion-all-sorted-completions))
(last (last completions))
(before)) ;; completions before top
diff --git a/consult-imenu.el b/consult-imenu.el
index 58c6e7a..53f65e5 100644
--- a/consult-imenu.el
+++ b/consult-imenu.el
@@ -1,6 +1,6 @@
;;; consult-imenu.el --- Consult commands for imenu -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -35,10 +35,11 @@
(?v "Variables" font-lock-variable-name-face))))
"Imenu configuration, faces and narrowing keys used by `consult-imenu'.
-For each type a narrowing key and a name must be specified. The face is
-optional. The imenu representation provided by the backend usually puts
-functions directly at the toplevel. `consult-imenu' moves them instead under the
-type specified by :toplevel."
+For each type a narrowing key and a name must be specified. The
+face is optional. The imenu representation provided by the
+backend usually puts functions directly at the toplevel.
+`consult-imenu' moves them instead under the type specified by
+:toplevel."
:type '(repeat (cons symbol plist))
:group 'consult)
@@ -157,7 +158,17 @@ TYPES is the mode-specific types configuration."
(defun consult-imenu--multi-items (buffers)
"Return all imenu items from BUFFERS."
- (apply #'append (consult--buffer-map buffers #'consult-imenu--items-safe)))
+ (consult--with-increased-gc
+ (let ((reporter (make-progress-reporter "Collecting" 0 (length buffers))))
+ (prog1
+ (apply #'append
+ (seq-map-indexed (lambda (buf idx)
+ (with-current-buffer buf
+ (prog1 (consult-imenu--items-safe)
+ (progress-reporter-update
+ reporter (1+ idx) (buffer-name)))))
+ buffers))
+ (progress-reporter-done reporter)))))
(defun consult-imenu--jump (item)
"Jump to imenu ITEM via `consult--jump'.
@@ -221,22 +232,25 @@ this function can jump across buffers."
(defun consult-imenu ()
"Select item from flattened `imenu' using `completing-read' with preview.
-The command supports preview and narrowing. See the variable
+The command supports preview and narrowing. See the variable
`consult-imenu-config', which configures the narrowing.
The symbol at point is added to the future history.
See also `consult-imenu-multi'."
(interactive)
- (consult-imenu--select "Go to item: " (consult-imenu--items)))
+ (consult-imenu--select
+ "Go to item: "
+ (consult--slow-operation "Building Imenu..."
+ (consult-imenu--items))))
;;;###autoload
(defun consult-imenu-multi (&optional query)
"Select item from the imenus of all buffers from the same project.
In order to determine the buffers belonging to the same project, the
-`consult-project-function' is used. Only the buffers with the
-same major mode as the current buffer are used. See also
-`consult-imenu' for more details. In order to search a subset of buffers,
+`consult-project-function' is used. Only the buffers with the
+same major mode as the current buffer are used. See also
+`consult-imenu' for more details. In order to search a subset of buffers,
QUERY can be set to a plist according to `consult--buffer-query'."
(interactive "P")
(unless (keywordp (car-safe query))
diff --git a/consult-info.el b/consult-info.el
new file mode 100644
index 0000000..ef05f54
--- /dev/null
+++ b/consult-info.el
@@ -0,0 +1,181 @@
+;;; consult-info.el --- Search through the info manuals -*- 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:
+
+;; Provides the command `consult-info'. This is an extra package,
+;; to allow lazy loading of info.el. The `consult-info' command
+;; is autoloaded.
+
+;;; Code:
+
+(require 'consult)
+(require 'info)
+
+(defvar consult-info--history nil)
+
+(defun consult-info--candidates (manuals input)
+ "Dynamically find lines in MANUALS matching INPUT."
+ (pcase-let* ((`(,regexps . ,hl)
+ (funcall consult--regexp-compiler input 'emacs t))
+ (re (concat "\\(\^_\n\\(?:.*Node:[ \t]*\\([^,\t\n]+\\)\\)?.*\n\\)\\|" (car regexps)))
+ (candidates nil)
+ (cand-idx 0)
+ (last-node nil)
+ (full-node nil))
+ (pcase-dolist (`(,manual . ,buf) manuals)
+ (with-current-buffer buf
+ (setq last-node nil full-node nil)
+ (widen)
+ (goto-char (point-min))
+ ;; TODO Info has support for subfiles, which is currently not supported
+ ;; by the `consult-info' search routine. Fortunately most (or all?)
+ ;; Emacs info files are generated with the --no-split option. See the
+ ;; comment in doc/emacs/Makefile.in. Given the computing powers these
+ ;; days split info files are probably also not necessary anymore.
+ ;; However it could happen that info files installed as part of the
+ ;; Linux distribution are split.
+ (while (and (not (eobp)) (re-search-forward re nil t))
+ (if (match-end 1)
+ (progn
+ (if-let ((node (match-string 2)))
+ (unless (equal node last-node)
+ (setq full-node (concat "(" manual ")" node)
+ last-node node))
+ (setq last-node nil full-node nil))
+ (goto-char (1+ (pos-eol))))
+ (let ((bol (pos-bol))
+ (eol (pos-eol)))
+ (goto-char bol)
+ (when (and
+ full-node
+ ;; Information separator character
+ (>= (- (point) 2) (point-min))
+ (not (eq (char-after (- (point) 2)) ?\^_))
+ ;; Non-blank line, only printable characters on the line.
+ (not (looking-at-p "^\\s-*$"))
+ (looking-at-p "^[[:print:]]*$")
+ ;; Matches all regexps
+ (seq-every-p (lambda (r)
+ (goto-char bol)
+ (re-search-forward r eol t))
+ (cdr regexps)))
+ (let ((cand (concat
+ (funcall hl (buffer-substring-no-properties bol eol))
+ (consult--tofu-encode cand-idx))))
+ (put-text-property 0 1 'consult--info (list full-node bol buf) cand)
+ (cl-incf cand-idx)
+ (push cand candidates)))
+ (goto-char (1+ eol)))))))
+ (nreverse candidates)))
+
+(defun consult-info--position (cand)
+ "Return position information for CAND."
+ (when-let ((pos (and cand (get-text-property 0 'consult--info cand)))
+ (matches (consult--point-placement cand 0))
+ (dest (+ (cadr pos) (car matches))))
+ `( ,(cdr matches) ,dest . ,pos)))
+
+(defun consult-info--action (cand)
+ "Jump to info CAND."
+ (pcase (consult-info--position cand)
+ (`( ,_matches ,pos ,node ,_bol ,_buf)
+ (info node)
+ (widen)
+ (goto-char pos)
+ (Info-select-node)
+ (run-hooks 'consult-after-jump-hook))))
+
+(defun consult-info--state ()
+ "Info manual preview state."
+ (let ((preview (consult--jump-preview)))
+ (lambda (action cand)
+ (pcase action
+ ('preview
+ (setq cand (consult-info--position cand))
+ (funcall preview 'preview
+ (pcase cand
+ (`(,matches ,pos ,_node ,_bol ,buf)
+ (cons (set-marker (make-marker) pos buf) matches))))
+ (let (Info-history Info-history-list Info-history-forward)
+ (when cand (ignore-errors (Info-select-node)))))
+ ('return
+ (consult-info--action cand))))))
+
+(defun consult-info--group (cand transform)
+ "Return title for CAND or TRANSFORM the candidate."
+ (if transform cand
+ (car (get-text-property 0 'consult--info cand))))
+
+(defun consult-info--prepare-buffers (manuals fun)
+ "Prepare buffers for MANUALS and call FUN with buffers."
+ (declare (indent 1))
+ (let (buffers)
+ (unwind-protect
+ (let ((reporter (make-progress-reporter "Preparing" 0 (length manuals))))
+ (consult--with-increased-gc
+ (seq-do-indexed
+ (lambda (manual idx)
+ (push (cons manual (generate-new-buffer (format "*info-preview-%s*" manual)))
+ buffers)
+ (with-current-buffer (cdar buffers)
+ (let (Info-history Info-history-list Info-history-forward)
+ (Info-mode)
+ (Info-find-node manual "Top")))
+ (progress-reporter-update reporter (1+ idx) manual))
+ manuals))
+ (progress-reporter-done reporter)
+ (funcall fun (reverse buffers)))
+ (dolist (buf buffers)
+ (kill-buffer (cdr buf))))))
+
+;;;###autoload
+(defun consult-info (&rest manuals)
+ "Full text search through info MANUALS."
+ (interactive
+ (if Info-current-file
+ (list (file-name-base Info-current-file))
+ (info-initialize)
+ (completing-read-multiple
+ "Info Manuals: "
+ (info--manual-names current-prefix-arg)
+ nil t)))
+ (consult-info--prepare-buffers manuals
+ (lambda (buffers)
+ (consult--read
+ (consult--dynamic-collection
+ (apply-partially #'consult-info--candidates buffers))
+ :state (consult-info--state)
+ :prompt
+ (format "Info (%s): "
+ (string-join (if (length> manuals 3)
+ `(,@(seq-take manuals 3) ,"…")
+ manuals)
+ ", "))
+ :require-match t
+ :sort nil
+ :category 'consult-info
+ :history '(:input consult-info--history)
+ :group #'consult-info--group
+ :initial (consult--async-split-initial "")
+ :add-history (consult--async-split-thingatpt 'symbol)
+ :lookup #'consult--lookup-member))))
+
+(provide 'consult-info)
+;;; consult-info.el ends here
diff --git a/consult-kmacro.el b/consult-kmacro.el
new file mode 100644
index 0000000..8c043e0
--- /dev/null
+++ b/consult-kmacro.el
@@ -0,0 +1,92 @@
+;;; consult-kmacro.el --- Provides the command `consult-kmacro' -*- 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:
+
+;; Provides the command `consult-kmacro'. This is an extra package,
+;; to allow lazy loading of kmacro.el. The `consult-kmacro' command
+;; is autoloaded.
+
+;;; Code:
+
+(require 'consult)
+(require 'kmacro)
+
+(defvar consult-kmacro--history nil)
+
+(defun consult-kmacro--candidates ()
+ "Return alist of kmacros and indices."
+ (thread-last
+ ;; List of macros
+ (append (and last-kbd-macro (list (kmacro-ring-head))) kmacro-ring)
+ ;; Emacs 29 uses OClosures. I like OClosures but it would have been better
+ ;; if public APIs wouldn't change like that.
+ (mapcar (lambda (x)
+ (if (eval-when-compile (> emacs-major-version 28))
+ (list (kmacro--keys x) (kmacro--counter x) (kmacro--format x) x)
+ `(,@x ,x))))
+ ;; Filter mouse clicks
+ (seq-remove (lambda (x) (seq-some #'mouse-event-p (car x))))
+ ;; Format macros
+ (mapcar (pcase-lambda (`(,keys ,counter ,format ,km))
+ (propertize
+ (format-kbd-macro keys 1)
+ 'consult--candidate km
+ 'consult-kmacro--annotation
+ ;; If the counter is 0 and the counter format is its default,
+ ;; then there is a good chance that the counter isn't actually
+ ;; being used. This can only be wrong when a user
+ ;; intentionally starts the counter with a negative value and
+ ;; then increments it to 0.
+ (cond
+ ((not (equal format "%d")) ;; show counter for non-default format
+ (format " (counter=%d, format=%s) " counter format))
+ ((/= counter 0) ;; show counter if non-zero
+ (format " (counter=%d)" counter))))))
+ (delete-dups)))
+
+;;;###autoload
+(defun consult-kmacro (arg)
+ "Run a chosen keyboard macro.
+
+With prefix ARG, run the macro that many times.
+Macros containing mouse clicks are omitted."
+ (interactive "p")
+ (let ((km (consult--read
+ (or (consult-kmacro--candidates)
+ (user-error "No keyboard macros defined"))
+ :prompt "Keyboard macro: "
+ :category 'consult-kmacro
+ :require-match t
+ :sort nil
+ :history 'consult-kmacro--history
+ :annotate
+ (lambda (cand)
+ (get-text-property 0 'consult-kmacro--annotation cand))
+ :lookup #'consult--lookup-candidate)))
+ (unless km (user-error "No kmacro selected"))
+ (funcall
+ ;; Kmacros are lambdas (oclosures) on Emacs 29
+ (if (eval-when-compile (> emacs-major-version 28))
+ km
+ (kmacro-lambda-form km))
+ arg)))
+
+(provide 'consult-kmacro)
+;;; consult-kmacro.el ends here
diff --git a/consult-org.el b/consult-org.el
index 56c66fb..6512c34 100644
--- a/consult-org.el
+++ b/consult-org.el
@@ -1,6 +1,6 @@
;;; consult-org.el --- Consult commands for org-mode -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -72,7 +72,8 @@ MATCH, SCOPE and SKIP are as in `org-map-entries'."
(org-get-outline-path 'with-self 'use-cache)
most-positive-fixnum)))
(when tags
- (setq tags (concat " " (propertize tags 'face 'org-tag))))
+ (setq tags (concat " " tags))
+ (put-text-property 1 (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)))))
@@ -94,7 +95,9 @@ buffer are offered."
(user-error "Must be called from an Org buffer")))
(let ((prefix (not (memq scope '(nil tree region region-start-level file)))))
(consult--read
- (consult-org--headings prefix match scope)
+ (consult--slow-operation "Collecting headings..."
+ (or (consult-org--headings prefix match scope)
+ (user-error "No headings")))
:prompt "Go to heading: "
:category 'consult-org-heading
:sort nil
@@ -115,7 +118,7 @@ buffer are offered."
(defun consult-org-agenda (&optional match)
"Jump to an Org agenda heading.
-By default, all agenda entries are offered. MATCH is as in
+By default, all agenda entries are offered. MATCH is as in
`org-map-entries' and can used to refine this."
(interactive)
(unless org-agenda-files
diff --git a/consult-register.el b/consult-register.el
index 7b5f0f7..72f1867 100644
--- a/consult-register.el
+++ b/consult-register.el
@@ -1,6 +1,6 @@
;;; consult-register.el --- Consult commands for registers -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -24,8 +24,9 @@
;;; Code:
(require 'consult)
+(require 'kmacro)
-(defcustom consult-register-prefix #("@" 0 1 (face consult-key))
+(defcustom consult-register-prefix #("#" 0 1 (face consult-key))
"Prepend prefix in front of register keys during completion."
:type '(choice (const nil) string)
:group 'consult)
@@ -38,9 +39,10 @@
(?t . "Frameset")
(?k . "Kmacro")
(?f . "File")
+ (?b . "Buffer")
(?w . "Window"))
"Register type names.
-Each element of the list must have the form \\='(char . name).")
+Each element of the list must have the form (char . name).")
(cl-defun consult-register--format-value (val)
"Format generic register VAL as string."
@@ -71,7 +73,7 @@ Each element of the list must have the form \\='(char . name).")
(let* ((line (line-number-at-pos))
(str (propertize (consult--line-with-cursor val)
'consult-location (cons val line))))
- (list (consult--format-location (buffer-name) line str)
+ (list (consult--format-file-line-match (buffer-name) line str)
'multi-category `(consult-location . ,str)
'consult--type ?p))))))
@@ -84,6 +86,11 @@ Each element of the list must have the form \\='(char . name).")
(list (propertize (abbreviate-file-name (cdr val)) 'face 'consult-file)
'consult--type ?f 'multi-category `(file . ,(cdr val))))
+(cl-defmethod consult-register--describe ((val (head buffer)))
+ "Describe buffer register VAL."
+ (list (propertize (cdr val) 'face 'consult-buffer)
+ 'consult--type ?f 'multi-category `(buffer . ,(cdr val))))
+
(cl-defmethod consult-register--describe ((val (head file-query)))
"Describe file-query register VAL."
(list (format "%s at position %d"
@@ -160,30 +167,36 @@ If COMPLETION is non-nil format the register for completion."
str))
str))
-(defun consult-register--alist (&optional noerror)
- "Return sorted register list.
+(defun consult-register--alist (&optional noerror filter)
+ "Return register list, sorted and filtered with FILTER.
Raise an error if the list is empty and NOERROR is nil."
- ;; Sometimes, registers are made without a `cdr'.
- ;; Such registers don't do anything, and can be ignored.
- (or (sort (seq-filter #'cdr register-alist) #'car-less-than-car)
+ (or (sort (seq-filter
+ ;; Sometimes, registers are made without a `cdr'.
+ ;; Such registers don't do anything, and can be ignored.
+ (lambda (x) (and (cdr x) (or (not filter) (funcall filter x))))
+ register-alist)
+ #'car-less-than-car)
(and (not noerror) (user-error "All registers are empty"))))
+(defun consult-register--candidates (&optional filter)
+ "Return formatted completion candidates, filtered with FILTER."
+ (mapcar (lambda (reg) (consult-register-format reg 'completion))
+ (consult-register--alist nil filter)))
+
;;;###autoload
(defun consult-register (&optional arg)
"Load register and either jump to location or insert the stored text.
-This command is useful to search the register contents. For quick access
+This command is useful to search the register contents. For quick access
to registers it is still recommended to use the register functions
`consult-register-load' and `consult-register-store' or the built-in
-built-in register access functions. The command supports narrowing, see
-`consult-register--narrow'. Marker positions are previewed. See
+built-in register access functions. The command supports narrowing, see
+`consult-register--narrow'. Marker positions are previewed. See
`jump-to-register' and `insert-register' for the meaning of prefix ARG."
(interactive "P")
(consult-register-load
(consult--read
- (mapcar (lambda (reg)
- (consult-register-format reg 'completion))
- (consult-register--alist))
+ (consult-register--candidates)
:prompt "Register: "
:category 'multi-category
:state
@@ -205,8 +218,8 @@ built-in register access functions. The command supports narrowing, see
(defun consult-register-load (reg &optional arg)
"Do what I mean with a REG.
-For a window configuration, restore it. For a number or text, insert it.
-For a location, jump to it. See `jump-to-register' and `insert-register'
+For a window configuration, restore it. For a number or text, insert it.
+For a location, jump to it. See `jump-to-register' and `insert-register'
for the meaning of prefix ARG."
(interactive
(list
@@ -284,8 +297,8 @@ This function is derived from `register-read-with-preview'."
"Store register dependent on current context, showing an action menu.
With an active region, store/append/prepend the contents, optionally
-deleting the region when a prefix ARG is given. With a numeric prefix
-ARG, store or add the number. Otherwise store point, frameset, window or
+deleting the region when a prefix ARG is given. With a numeric prefix
+ARG, store or add the number. Otherwise store point, frameset, window or
kmacro."
(interactive "P")
(consult-register--action
diff --git a/consult-selectrum.el b/consult-selectrum.el
deleted file mode 100644
index ee2f9a8..0000000
--- a/consult-selectrum.el
+++ /dev/null
@@ -1,101 +0,0 @@
-;;; consult-selectrum.el --- Selectrum integration for Consult -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021, 2022 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 Selectrum completion system. This package
-;; is automatically loaded by Consult.
-
-;;; Code:
-
-(require 'consult)
-
-;; NOTE: It is not guaranteed that Selectrum is available during compilation!
-(defvar selectrum-default-value-format)
-(defvar selectrum-highlight-candidates-function)
-(defvar selectrum-is-active)
-(defvar selectrum-refine-candidates-function)
-(defvar selectrum--history-hash)
-(declare-function selectrum-exhibit "ext:selectrum")
-(declare-function selectrum-get-current-candidate "ext:selectrum")
-
-(defun consult-selectrum--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."
- ;; Do not use selectrum-is-active here, since we want to always use
- ;; the Selectrum filtering when Selectrum is installed, even when
- ;; Selectrum is currently not active.
- ;; However if `selectrum-refine-candidates-function' is the default
- ;; function, which uses the completion styles, the Selectrum filtering
- ;; is not used and the original function is called.
- (if (and (eq completing-read-function 'selectrum-completing-read)
- (not (eq selectrum-refine-candidates-function
- 'selectrum-refine-candidates-using-completions-styles)))
- (if highlight
- (funcall selectrum-highlight-candidates-function pattern
- (funcall selectrum-refine-candidates-function pattern cands))
- (funcall selectrum-refine-candidates-function pattern cands))
- (funcall orig pattern cands category highlight)))
-
-(defun consult-selectrum--candidate ()
- "Return current selectrum candidate."
- (and selectrum-is-active (selectrum-get-current-candidate)))
-
-(defun consult-selectrum--refresh (&optional reset)
- "Refresh completion UI, keep current candidate unless RESET is non-nil."
- (when selectrum-is-active
- (when consult--narrow
- (setq-local selectrum-default-value-format nil))
- (when reset
- (setq-local selectrum--history-hash nil))
- (selectrum-exhibit (not reset))))
-
-(defun consult-selectrum--split-wrap (orig split)
- "Wrap candidates highlight/refinement ORIG function.
-The input is split by the SPLIT function."
- (lambda (str cands)
- (funcall orig (substring str (cadr (funcall split str))) cands)))
-
-(defun consult-selectrum--split-setup-adv (orig split)
- "Advice for `consult--split-setup' to be used by Selectrum.
-
-ORIG is the original function.
-SPLIT is the splitter function."
- (if (not selectrum-is-active)
- (funcall orig split)
- (setq-local
- selectrum-refine-candidates-function
- (consult-selectrum--split-wrap selectrum-refine-candidates-function split)
- selectrum-highlight-candidates-function
- (consult-selectrum--split-wrap selectrum-highlight-candidates-function split))))
-
-(defun consult-selectrum--deprecated (&rest _)
- (warn "%s: Selectrum support has been deprecated in favor of Vertico" this-command)
- (advice-remove #'consult--read #'consult-selectrum--deprecated))
-
-(add-hook 'consult--completion-candidate-hook #'consult-selectrum--candidate)
-(add-hook 'consult--completion-refresh-hook #'consult-selectrum--refresh)
-(advice-add #'consult--completion-filter :around #'consult-selectrum--filter-adv)
-(advice-add #'consult--split-setup :around #'consult-selectrum--split-setup-adv)
-(define-key consult-async-map [remap selectrum-insert-current-candidate] 'selectrum-next-page)
-(advice-add #'consult--read :before #'consult-selectrum--deprecated)
-
-(provide 'consult-selectrum)
-;;; consult-selectrum.el ends here
diff --git a/consult-vertico.el b/consult-vertico.el
index 9f9cfb5..79eb08f 100644
--- a/consult-vertico.el
+++ b/consult-vertico.el
@@ -1,6 +1,6 @@
;;; consult-vertico.el --- Vertico integration for Consult -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -19,7 +19,7 @@
;;; Commentary:
-;; Integration code for the Vertico completion system. This package
+;; Integration code for the Vertico completion system. This package
;; is automatically loaded by Consult.
;;; Code:
@@ -28,8 +28,6 @@
;; NOTE: It is not guaranteed that Vertico is available during compilation!
(defvar vertico--input)
-(defvar vertico--history-hash)
-(defvar vertico--lock-candidate)
(declare-function vertico--exhibit "ext:vertico")
(declare-function vertico--candidate "ext:vertico")
(declare-function vertico--all-completions "ext:vertico")
@@ -38,13 +36,10 @@
"Return current candidate for Consult preview."
(and vertico--input (vertico--candidate 'highlight)))
-(defun consult-vertico--refresh (&optional reset)
- "Refresh completion UI, keep current candidate unless RESET is non-nil."
+(defun consult-vertico--refresh ()
+ "Refresh completion UI."
(when vertico--input
(setq vertico--input t)
- (when reset
- (setq vertico--history-hash nil
- vertico--lock-candidate nil))
(vertico--exhibit)))
(defun consult-vertico--filter-adv (orig pattern cands category highlight)
@@ -53,7 +48,7 @@ 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.
+ ;; 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)
diff --git a/consult-xref.el b/consult-xref.el
index 0291398..306990f 100644
--- a/consult-xref.el
+++ b/consult-xref.el
@@ -1,6 +1,6 @@
;;; consult-xref.el --- Xref integration for Consult -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -19,8 +19,8 @@
;;; Commentary:
-;; Provides Xref integration for Consult. This is an extra package, to
-;; allow lazy loading of xref.el. The `consult-xref' function is
+;; Provides Xref integration for Consult. This is an extra package, to
+;; allow lazy loading of xref.el. The `consult-xref' function is
;; autoloaded.
;;; Code:
@@ -29,7 +29,11 @@
(require 'xref)
(defvar consult-xref--history nil)
-(defvar consult-xref--fetcher nil)
+
+(defvar consult-xref--fetcher nil
+ "The current xref fetcher.
+The fetch is stored globally such that it can be accessed by
+ Embark for `embark-export'.")
(defun consult-xref--candidates ()
"Return xref candidate list."
@@ -41,12 +45,12 @@
(xref--group-name-for-display
(xref-location-group loc) root)
(xref-location-group loc)))
- (cand (consult--format-location
+ (cand (consult--format-file-line-match
group
(or (xref-location-line loc) 0)
(xref-item-summary xref))))
(add-text-properties
- 0 1 `(consult-xref ,xref consult-xref--group ,group) cand)
+ 0 1 `(consult-xref ,xref consult--prefix-group ,group) cand)
cand))
(funcall consult-xref--fetcher))))
@@ -67,7 +71,7 @@
('xref-buffer-location
(xref-location-marker loc))
((or 'xref-file-location 'xref-etags-location)
- (consult--position-marker
+ (consult--marker-from-line-column
(funcall open
;; xref-location-group returns the file name
(let ((xref-file-name-display 'abs))
@@ -77,12 +81,6 @@
(xref-file-location-column loc)
0)))))))))))
-(defun consult-xref--group (cand transform)
- "Return title for CAND or TRANSFORM the candidate."
- (if transform
- (substring cand (1+ (length (get-text-property 0 'consult-xref--group cand))))
- (get-text-property 0 'consult-xref--group cand)))
-
;;;###autoload
(defun consult-xref (fetcher &optional alist)
"Show xrefs with preview in the minibuffer.
@@ -106,7 +104,7 @@ FETCHER and ALIST arguments."
:require-match t
:sort nil
:category 'consult-xref
- :group #'consult-xref--group
+ :group #'consult--prefix-group
:state
;; do not preview other frame
(when-let (fun (pcase-exhaustive display
diff --git a/consult.el b/consult.el
index 979546a..80cbb93 100644
--- a/consult.el
+++ b/consult.el
@@ -1,12 +1,12 @@
;;; consult.el --- Consulting completing-read -*- lexical-binding: t -*-
-;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; Author: Daniel Mendler and Consult contributors
;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
;; Created: 2020
-;; Version: 0.20
-;; Package-Requires: ((emacs "27.1") (compat "28.1"))
+;; Version: 0.32
+;; Package-Requires: ((emacs "27.1") (compat "29.1.3.2"))
;; Homepage: https://github.com/minad/consult
;; This file is part of GNU Emacs.
@@ -26,38 +26,43 @@
;;; Commentary:
-;; Consult implements a set of `consult-<thing>' commands which use
-;; `completing-read' to select from a list of candidates. Consult
-;; provides an enhanced buffer switcher `consult-buffer' and search and
-;; navigation commands like `consult-imenu' and `consult-line'.
-;; Searching through multiple files is supported by the asynchronous
-;; `consult-grep' command. Many Consult commands allow previewing
-;; candidates - if a candidate is selected in the completion view, the
-;; buffer shows the candidate immediately.
+;; Consult implements a set of `consult-<thing>' commands, which aim to
+;; improve the way you use Emacs. The commands are founded on
+;; `completing-read', which selects from a list of candidate strings.
+;; Consult provides an enhanced buffer switcher `consult-buffer' and
+;; search and navigation commands like `consult-imenu' and
+;; `consult-line'. Searching through multiple files is supported by the
+;; asynchronous `consult-grep' command. Many Consult commands support
+;; previewing candidates. If a candidate is selected in the completion
+;; view, the buffer shows the candidate immediately.
-;; The Consult commands are compatible with completion systems based on
-;; the Emacs `completing-read' API, including the default completion
-;; system, Vertico, Mct and Icomplete.
+;; The Consult commands are compatible with multiple completion systems
+;; based on the Emacs `completing-read' API, including the default
+;; completion system, Vertico, Mct and Icomplete.
-;; Consult has been inspired by Counsel. Some of the Consult commands
-;; originated in the Counsel package or the wiki of the Selectrum
-;; package. See the README for a full list of contributors.
+;; See the README for an overview of the available Consult commands and
+;; the documentation of the configuration and installation of the
+;; package.
+
+;; The full list of contributors can be found in the acknowledgments
+;; section of the README.
;;; Code:
(eval-when-compile
(require 'cl-lib)
(require 'subr-x))
-(require 'bookmark)
-(require 'kmacro)
-(require 'recentf)
(require 'seq)
(require 'compat)
-(require 'compat-28)
+(require 'bookmark)
(defgroup consult nil
"Consulting `completing-read'."
- :group 'convenience
+ :link '(info-link :tag "Info Manual" "(consult)")
+ :link '(url-link :tag "Homepage" "https://github.com/minad/consult")
+ :link '(emacs-library-link :tag "Library Source" "consult.el")
+ :group 'files
+ :group 'outlines
:group 'minibuffer
:prefix "consult-")
@@ -66,25 +71,21 @@
(defcustom consult-narrow-key nil
"Prefix key for narrowing during completion.
-Good choices for this key are (kbd \"<\") or (kbd \"C-+\") for example.
-
-The key must be either a string or a vector.
-This is the key representation accepted by `define-key'."
- :type '(choice key-sequence (const nil)))
+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)))
(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 either a string or a vector.
-This is the key representation accepted by `define-key'."
- :type '(choice key-sequence (const nil)))
+The key must be a string accepted by `key-valid-p'."
+ :type '(choice string (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 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'."
:type '(choice function (const nil)))
@@ -93,7 +94,7 @@ The root directory is used by `consult-buffer' and `consult-grep'."
"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
+seconds. This applies to asynchronous commands like for example
`consult-grep'."
:type 'float)
@@ -101,7 +102,7 @@ seconds. This applies to asynchronous commands like for example
"Input throttle for asynchronous commands.
The asynchronous process is started only every
-`consult-async-input-throttle' seconds. This applies to asynchronous
+`consult-async-input-throttle' seconds. This applies to asynchronous
commands, e.g., `consult-grep'."
:type 'float)
@@ -109,7 +110,7 @@ commands, e.g., `consult-grep'."
"Input debounce for asynchronous commands.
The asynchronous process is started only when there has not been new
-input for `consult-async-input-debounce' seconds. This applies to
+input for `consult-async-input-debounce' seconds. This applies to
asynchronous commands, e.g., `consult-grep'."
:type 'float)
@@ -135,18 +136,19 @@ This applies to asynchronous commands, e.g., `consult-grep'."
:type '(alist :key-type symbol :value-type plist))
(defcustom consult-mode-histories
- '((eshell-mode eshell-history-ring eshell-history-index)
- (comint-mode comint-input-ring comint-input-ring-index)
- (term-mode term-input-ring term-input-ring-index))
- "Alist of mode histories as (mode . history) or (mode history index).
-The histories can be rings or lists. INDEX, if provided, is a
+ '((eshell-mode eshell-history-ring eshell-history-index eshell-bol)
+ (comint-mode comint-input-ring comint-input-ring-index comint-bol)
+ (term-mode term-input-ring term-input-ring-index term-bol))
+ "Alist of mode histories (mode history index bol).
+The histories can be rings or lists. Index, if provided, is a
variable to set to the index of the selection within the ring or
-list."
+list. Bol, if provided is a function which jumps to the beginning
+of the line after the prompt."
:type '(alist :key-type symbol
- :value-type (choice (symbol :tag "List or Ring Name")
- (group :tag "Include Index"
- (symbol :tag "List/Ring")
- (symbol :tag "Index Variable")))))
+ :value-type (group :tag "Include Index"
+ (symbol :tag "List/Ring")
+ (symbol :tag "Index Variable")
+ (symbol :tag "Bol Function"))))
(defcustom consult-themes nil
"List of themes (symbols or regexps) to be presented for selection.
@@ -157,9 +159,9 @@ nil shows all `custom-available-themes'."
"Function called after jumping to a location.
Commonly used functions for this hook are `recenter' and
-`reposition-window'. You may want to add a function which pulses the
+`reposition-window'. You may want to add a function which pulses the
current line, e.g., `pulse-momentary-highlight-one-line' is supported on
-Emacs 28 and newer. The hook called during preview and for the jump
+Emacs 28 and newer. The hook called during preview and for the jump
after selection."
:type 'hook)
@@ -168,10 +170,6 @@ after selection."
Otherwise start the search at the current line and wrap around."
:type 'boolean)
-(define-obsolete-variable-alias
- 'consult-line-point-placement
- 'consult-point-placement "0.19")
-
(defcustom consult-point-placement 'match-beginning
"Where to leave point when jumping to a match.
This setting affects the command `consult-line' and the `consult-grep' variants."
@@ -217,6 +215,7 @@ character, the *Completions* buffer and a few log buffers."
consult--source-modified-buffer
consult--source-buffer
consult--source-recent-file
+ consult--source-file-register
consult--source-bookmark
consult--source-project-buffer
consult--source-project-recent-file)
@@ -265,7 +264,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 ."
+ --smart-case --no-heading --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."
@@ -279,7 +278,7 @@ Can be either a string, or a list of strings or expressions."
:type '(choice string (repeat (choice string expression))))
(defcustom consult-locate-args
- "locate --ignore-case --existing"
+ "locate --ignore-case" ;; --existing not supported by Debian plocate
"Command line arguments for locate, see `consult-locate'.
The dynamically computed arguments are appended.
Can be either a string, or a list of strings or expressions."
@@ -293,12 +292,17 @@ Can be either a string, or a list of strings or expressions."
:type '(choice string (repeat (choice string expression))))
(defcustom consult-preview-key 'any
- "Preview trigger keys, can be nil, \\='any, a single key or a list of keys."
+ "Preview trigger keys, can be nil, `any', a single key or a list of keys.
+Debouncing can be specified via the `:debounce' attribute. The
+individual keys must be strings accepted by `key-valid-p'."
:type '(choice (const :tag "Any key" any)
- (list :tag "Debounced" (const :debounce) (float :tag "Seconds" 0.1) (const any))
+ (list :tag "Debounced"
+ (const :debounce)
+ (float :tag "Seconds" 0.1)
+ (const any))
(const :tag "No preview" nil)
- (key-sequence :tag "Key")
- (repeat :tag "List of keys" key-sequence)))
+ (string :tag "Key")
+ (repeat :tag "List of keys" string)))
(defcustom consult-preview-max-size 10485760
"Files larger than this byte limit are not previewed."
@@ -346,9 +350,16 @@ Can be either a string, or a list of strings or expressions."
(?v "VC Directory" vc-dir-bookmark-jump))
"Bookmark narrowing configuration.
-Each element of the list must have the form \\='(char name handler)."
+Each element of the list must have the form (char name handler)."
:type '(repeat (list character string function)))
+(defcustom consult-yank-rotate
+ (if (boundp 'yank-from-kill-ring-rotate)
+ yank-from-kill-ring-rotate
+ t)
+ "Rotate the `kill-ring' in the `consult-yank' commands."
+ :type 'boolean)
+
;;;; Faces
(defgroup consult-faces nil
@@ -432,7 +443,7 @@ Used by `consult-completion-in-region', `consult-yank' and `consult-history'.")
(defface consult-line-number-wrapped
'((t :inherit consult-line-number-prefix :inherit font-lock-warning-face))
- "Face used to highlight line number prefixes, if the line number wrapped around.")
+ "Face used to highlight line number prefixes after wrap around.")
(defface consult-separator
'((((class color) (min-colors 88) (background light))
@@ -448,10 +459,9 @@ Used by `consult-completion-in-region', `consult-yank' and `consult-history'.")
(defvar consult--find-history nil)
(defvar consult--man-history nil)
(defvar consult--line-history nil)
-(defvar consult--apropos-history nil)
+(defvar consult--line-multi-history nil)
(defvar consult--theme-history nil)
(defvar consult--minor-mode-menu-history nil)
-(defvar consult--kmacro-history nil)
(defvar consult--buffer-history nil)
;;;; Internal variables
@@ -464,14 +474,14 @@ function.")
(defvar consult--customize-alist
;; Disable preview in frames, since frames do not get up cleaned
- ;; properly. Preview is only supported by `consult-buffer' and
+ ;; properly. Preview is only supported by `consult-buffer' and
;; `consult-buffer-other-window'.
`((,#'consult-buffer-other-frame :preview-key nil))
"Command configuration alist for fine-grained configuration.
-Each element of the list must have the form (command-name plist...). The
+Each element of the list must have the form (command-name plist...). The
options set here will be evaluated and passed to `consult--read', when
-called from the corresponding command. Note that the options depend on
+called from the corresponding command. Note that the options depend on
the private `consult--read' API and should not be considered as stable
as the public API.")
@@ -526,40 +536,10 @@ We use invalid characters outside the Unicode range.")
(defvar-local consult--focus-lines-overlays nil
"Overlays used by `consult-focus-lines'.")
-;;;; Customization helper
+(defvar-local consult--org-fold-regions nil
+ "Stored regions for the org-fold API.")
-(defun consult--customize-put (cmds prop form)
- "Set property PROP to FORM of commands CMDS."
- (dolist (cmd cmds)
- (cond
- ((and (boundp cmd) (consp (symbol-value cmd)))
- (set cmd (plist-put (symbol-value cmd) prop (eval form 'lexical))))
- ((functionp cmd)
- (setf (alist-get cmd consult--customize-alist)
- (plist-put (alist-get cmd consult--customize-alist) prop form)))
- (t (user-error "%s is neither a Consult command nor a Consult source"
- cmd))))
- nil)
-
-(defmacro consult-customize (&rest args)
- "Set properties of commands or sources.
-ARGS is a list of commands or sources followed by the list of keyword-value
-pairs."
- (let ((setter))
- (while args
- (let ((cmds (seq-take-while (lambda (x) (not (keywordp x))) args)))
- (setq args (seq-drop-while (lambda (x) (not (keywordp x))) args))
- (while (keywordp (car args))
- (push `(consult--customize-put ',cmds ,(car args) ',(cadr args)) setter)
- (setq args (cddr args)))))
- (macroexp-progn setter)))
-
-(defun consult--customize-get (&optional cmd)
- "Get configuration from `consult--customize-alist' for CMD."
- (mapcar (lambda (x) (eval x 'lexical))
- (alist-get (or cmd this-command) consult--customize-alist)))
-
-;;;; Helper functions and macros
+;;;; Miscellaneous helper functions
(defun consult--in-buffer (fun &optional buffer)
"Ensure that FUN is executed inside BUFFER."
@@ -602,170 +582,9 @@ Turn ARG into a list, and for each element either:
(let ((opts (when (string-match " +--\\( +\\|\\'\\)" str)
(prog1 (substring str (match-end 0))
(setq str (substring str 0 (match-beginning 0)))))))
- ;; split-string-and-unquote fails if the quotes are invalid. Ignore it.
+ ;; split-string-and-unquote fails if the quotes are invalid. Ignore it.
(cons str (and opts (ignore-errors (split-string-and-unquote opts)))))))
-(defun consult--find-highlights (str start &rest ignored-faces)
- "Find highlighted regions in STR from position START.
-Highlighted regions have a non-nil face property.
-IGNORED-FACES are ignored when searching for matches."
- (let (highlights
- (end (length str))
- (beg start))
- (while (< beg end)
- (let ((next (next-single-property-change beg 'face str end))
- (val (get-text-property beg 'face str)))
- (when (and val
- (not (memq val ignored-faces))
- (not (and (consp val)
- (seq-some (lambda (x) (memq x ignored-faces)) val))))
- (push (cons (- beg start) (- next start)) highlights))
- (setq beg next)))
- (nreverse highlights)))
-
-(defun consult--point-placement (str start &rest ignored-faces)
- "Compute point placement from STR with START offset.
-IGNORED-FACES are ignored when searching for matches.
-Return cons of point position and a list of match begin/end pairs."
- (let* ((matches (apply #'consult--find-highlights str start ignored-faces))
- (pos (pcase-exhaustive consult-point-placement
- ('match-beginning (or (caar matches) 0))
- ('match-end (or (cdar (last matches)) 0))
- ('line-beginning 0))))
- (dolist (match matches)
- (cl-decf (car match) pos)
- (cl-decf (cdr match) pos))
- (cons pos matches)))
-
-(defun consult--highlight-regexps (regexps ignore-case str)
- "Highlight REGEXPS in STR.
-If a regular expression contains capturing groups, only these are highlighted.
-If no capturing groups are used highlight the whole match. Case is ignored
-if IGNORE-CASE is non-nil."
- (let ((case-fold-search ignore-case))
- (dolist (re regexps)
- (when (string-match re str)
- ;; Unfortunately there is no way to avoid the allocation of the match
- ;; data, since the number of capturing groups is unknown.
- (let ((m (match-data)))
- (setq m (or (cddr m) m))
- (while m
- (when (car m)
- (add-face-text-property (car m) (cadr m)
- 'consult-highlight-match nil str))
- (setq m (cddr m))))))))
-
-(defconst consult--convert-regexp-table
- (append
- ;; For simplicity, treat word beginning/end as word boundaries,
- ;; since PCRE does not make this distinction. Usually the
- ;; context determines if \b is the beginning or the end.
- '(("\\<" . "\\b") ("\\>" . "\\b")
- ("\\_<" . "\\b") ("\\_>" . "\\b"))
- ;; Treat \` and \' as beginning and end of line. This is more
- ;; widely supported and makes sense for line-based commands.
- '(("\\`" . "^") ("\\'" . "$"))
- ;; Historical: Unescaped *, +, ? are supported at the beginning
- (mapcan (lambda (x)
- (mapcar (lambda (y)
- (cons (concat x y)
- (concat (string-remove-prefix "\\" x) "\\" y)))
- '("*" "+" "?")))
- '("" "\\(" "\\(?:" "\\|" "^"))
- ;; Different escaping
- (mapcan (lambda (x) `(,x (,(cdr x) . ,(car x))))
- '(("\\|" . "|")
- ("\\(" . "(") ("\\)" . ")")
- ("\\{" . "{") ("\\}" . "}"))))
- "Regexp conversion table.")
-
-(defun consult--convert-regexp (regexp type)
- "Convert Emacs REGEXP to regexp syntax TYPE."
- (if (memq type '(emacs basic))
- regexp
- ;; Support for Emacs regular expressions is fairly complete for basic
- ;; usage. There are a few unsupported Emacs regexp features:
- ;; - \= point matching
- ;; - Syntax classes \sx \Sx
- ;; - Character classes \cx \Cx
- ;; - Explicitly numbered groups (?3:group)
- (replace-regexp-in-string
- (rx (or "\\\\" "\\^" ;; Pass through
- (seq (or "\\(?:" "\\|") (any "*+?")) ;; Historical: \|+ or \(?:* etc
- (seq "\\(" (any "*+")) ;; Historical: \(* or \(+
- (seq (or bos "^") (any "*+?")) ;; Historical: + or * at the beginning
- (seq (opt "\\") (any "(){|}")) ;; Escape parens/braces/pipe
- (seq "\\" (any "'<>`")) ;; Special escapes
- (seq "\\_" (any "<>")))) ;; Beginning or end of symbol
- (lambda (x) (or (cdr (assoc x consult--convert-regexp-table)) x))
- regexp 'fixedcase 'literal)))
-
-(defun consult--default-regexp-compiler (input type ignore-case)
- "Compile the INPUT string to a list of regular expressions.
-The function should return a pair, the list of regular expressions and a
-highlight function. The highlight function should take a single
-argument, the string to highlight given the INPUT. TYPE is the desired
-type of regular expression, which can be `basic', `extended', `emacs' or
-`pcre'. If IGNORE-CASE is non-nil return a highlight function which
-matches case insensitively."
- (setq input (consult--split-escaped input))
- (cons (mapcar (lambda (x) (consult--convert-regexp x type)) input)
- (when-let (regexps (seq-filter #'consult--valid-regexp-p input))
- (apply-partially #'consult--highlight-regexps regexps ignore-case))))
-
-(defun consult--split-escaped (str)
- "Split STR at spaces, which can be escaped with backslash."
- (mapcar
- (lambda (x) (string-replace "\0" " " x))
- (split-string (replace-regexp-in-string
- "\\\\\\\\\\|\\\\ "
- (lambda (x) (if (equal x "\\ ") "\0" x))
- str 'fixedcase 'literal)
- " +" t)))
-
-(defun consult--join-regexps (regexps type)
- "Join REGEXPS of TYPE."
- ;; Add lookahead wrapper only if there is more than one regular expression
- (cond
- ((and (eq type 'pcre) (cdr regexps))
- (concat "^" (mapconcat (lambda (x) (format "(?=.*%s)" x))
- regexps "")))
- ((eq type 'basic)
- (string-join regexps ".*"))
- (t
- (when (length> regexps 3)
- (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)) "\\")))))
-
-(defun consult--regexp-join-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)
- esc ")"))
- regexps (concat esc "|")))))
-
-(defun consult--valid-regexp-p (re)
- "Return t if regexp RE is valid."
- (condition-case nil
- (progn (string-match-p re "") t)
- (invalid-regexp nil)))
-
-(defun consult--regexp-filter (regexps)
- "Create filter regexp from REGEXPS."
- (if (stringp regexps)
- regexps
- (mapconcat (lambda (x) (concat "\\(?:" x "\\)")) regexps "\\|")))
-
(defmacro consult--keep! (list form)
"Evaluate FORM for every element of LIST and keep the non-nil results."
(declare (indent 1))
@@ -783,7 +602,7 @@ ESC is the escaping string for choice and groups."
(setq ,list (cdr ,head))
nil)))
-;; Upstream bug#46326, Consult issue https://github.com/minad/consult/issues/193
+;; Upstream bug#46326, Consult issue gh:minad/consult#193.
(defmacro consult--minibuffer-with-setup-hook (fun &rest body)
"Variant of `minibuffer-with-setup-hook' using a symbol and `fset'.
@@ -827,7 +646,7 @@ See `consult--completion-filter' for the arguments CATEGORY and HIGHLIGHT."
"Filter CANDS with PATTERN with optional complement.
Either using `consult--completion-filter' or
`consult--completion-filter-complement', depending on if the pattern starts
-with a bang. See `consult--completion-filter' for the arguments CATEGORY and
+with a bang. See `consult--completion-filter' for the arguments CATEGORY and
HIGHLIGHT."
(cond
((string-match-p "\\`!? ?\\'" pattern) cands) ;; empty pattern
@@ -845,8 +664,7 @@ The line beginning/ending BEG/END is bound in BODY."
(let ((,beg (point-min)) (,max (point-max)) end)
(while (< ,beg ,max)
(goto-char ,beg)
- (let ((inhibit-field-text-motion t))
- (setq ,end (line-end-position)))
+ (setq ,end (pos-eol))
,@body
(setq ,beg (1+ ,end)))))))
@@ -862,7 +680,7 @@ The line beginning/ending BEG/END is bound in BODY."
(while (< pos nextd)
(let ((nexti (next-single-property-change pos 'invisible string nextd)))
(unless (get-text-property pos 'invisible string)
- (setq width (+ width (compat-string-width string pos nexti))))
+ (setq width (+ width (compat-call string-width string pos nexti))))
(setq pos nexti))))))
width))
@@ -903,10 +721,10 @@ The line beginning/ending BEG/END is bound in BODY."
(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
+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.
@@ -926,12 +744,10 @@ Otherwise the `default-directory' is returned."
;; Bind default-directory in order to find the project
(pdir (let ((default-directory edir)) (consult--project-root))))
(cons
- (cond
- ((equal edir pdir)
- (format "%s (Project %s): " prompt (consult--project-name pdir)))
- ((equal edir (file-name-as-directory (expand-file-name default-directory)))
- (concat prompt ": "))
- (t (format "%s (%s): " prompt (consult--abbreviate-directory dir))))
+ (format "%s (%s): " prompt
+ (if (equal edir pdir)
+ (concat "Project " (consult--project-name pdir))
+ (consult--abbreviate-directory dir)))
edir)))
(defun consult--default-project-function (may-prompt)
@@ -958,14 +774,17 @@ When no project is found and MAY-PROMPT is non-nil ask the user."
(match-string 1 dir)
dir))
-(defun consult--format-location (file line &optional str)
- "Format location string 'FILE:LINE:STR'."
+(defun consult--format-file-line-match (file line &optional match)
+ "Format string FILE:LINE:MATCH with faces."
(setq line (number-to-string line)
- str (concat file ":" line (and str ":") str)
+ match (concat file ":" line (and match ":") match)
file (length file))
- (put-text-property 0 file 'face 'consult-file str)
- (put-text-property (1+ file) (+ 1 file (length line)) 'face 'consult-line-number str)
- str)
+ (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)
"Make consult overlay between BEG and END with PROPS."
@@ -986,76 +805,11 @@ When no project is found and MAY-PROMPT is non-nil ask the user."
"Return t if position POS lies in range `point-min' to `point-max'."
(<= (point-min) pos (point-max)))
-(defun consult--type-group (types)
- "Return group function for TYPES."
- (lambda (cand transform)
- (if transform
- cand
- (alist-get (get-text-property 0 'consult--type cand) types))))
-
-(defun consult--type-narrow (types)
- "Return narrowing configuration from TYPES."
- (list :predicate
- (lambda (cand) (eq (get-text-property 0 'consult--type cand) consult--narrow))
- :keys types))
-
(defun consult--completion-window-p ()
"Return non-nil if the selected window belongs to the completion UI."
(or (eq (selected-window) (active-minibuffer-window))
(eq #'completion-list-mode (buffer-local-value 'major-mode (window-buffer)))))
-(defun consult--location-state (candidates)
- "Location state function.
-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")))
- (fset hook
- (lambda (_)
- (unless (consult--completion-window-p)
- (remove-hook 'window-selection-change-functions hook)
- (mapc #'consult--get-location candidates))))
- (lambda (action cand)
- (pcase action
- ('setup (add-hook 'window-selection-change-functions hook))
- ('exit (remove-hook 'window-selection-change-functions hook)))
- (funcall jump action cand))))
-
-(defun consult--get-location (cand)
- "Return location from CAND."
- (let ((loc (get-text-property 0 'consult-location cand)))
- (when (consp (car loc))
- ;; Transform cheap marker to real marker
- (setcar loc (set-marker (make-marker) (cdar loc) (caar loc))))
- loc))
-
-(defun consult--lookup-member (selected candidates &rest _)
- "Lookup SELECTED in CANDIDATES list, return original element."
- (car (member selected candidates)))
-
-(defun consult--lookup-cons (selected candidates &rest _)
- "Lookup SELECTED in CANDIDATES alist, return cons."
- (assoc selected candidates))
-
-(defun consult--lookup-cdr (selected candidates &rest _)
- "Lookup SELECTED in CANDIDATES alist, return cdr of element."
- (cdr (assoc selected candidates)))
-
-(defun consult--lookup-location (selected candidates &rest _)
- "Lookup SELECTED in CANDIDATES list of `consult-location' category.
-Return the location marker."
- (when-let (found (member selected candidates))
- (car (consult--get-location (car found)))))
-
-(defun consult--lookup-prop (prop selected candidates &rest _)
- "Lookup SELECTED in CANDIDATES list and return PROP value."
- (when-let (found (member selected candidates))
- (get-text-property 0 prop (car found))))
-
-(defun consult--lookup-candidate (selected candidates &rest _)
- "Lookup SELECTED in CANDIDATES list and return property `consult--candidate'."
- (consult--lookup-prop 'consult--candidate selected candidates))
-
(defun consult--forbid-minibuffer ()
"Raise an error if executed from the minibuffer."
(when (minibufferp)
@@ -1069,8 +823,8 @@ Return the location marker."
(defun consult--fontify-all ()
"Ensure that the whole buffer is fontified."
;; Font-locking is lazy, i.e., if a line has not been looked at yet, the line
- ;; is not font-locked. We would observe this if consulting an unfontified
- ;; line. Therefore we have to enforce font-locking now, which is slow. In
+ ;; is not font-locked. We would observe this if consulting an unfontified
+ ;; line. Therefore we have to enforce font-locking now, which is slow. In
;; order to prevent is hang-up we check the buffer size against
;; `consult-fontify-max-size'.
(when (and consult-fontify-preserve jit-lock-mode
@@ -1090,17 +844,25 @@ Return the location marker."
(gc-cons-percentage (if ,overwrite consult--gc-percentage gc-cons-percentage)))
,@body)))
+(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'."
+ (declare (indent 1))
+ `(with-delayed-message (1 ,message)
+ (consult--with-increased-gc
+ ,@body)))
+
(defun consult--count-lines (pos)
"Move to position POS and return number of lines."
- (let ((line 0))
+ (let ((line 1))
(while (< (point) pos)
(forward-line)
(when (<= (point) pos)
- (setq line (1+ line))))
+ (cl-incf line)))
(goto-char pos)
line))
-(defun consult--position-marker (buffer line column)
+(defun consult--marker-from-line-column (buffer line column)
"Get marker in BUFFER from LINE and COLUMN."
(when (buffer-live-p buffer)
(with-current-buffer buffer
@@ -1114,18 +876,6 @@ Return the location marker."
(forward-char column))
(point-marker))))))
-(defun consult--line-group (cand transform)
- "Group function used by `consult-line-multi'.
-If TRANSFORM non-nil, return transformed CAND, otherwise return title."
- (if transform
- cand
- (let ((marker (car (get-text-property 0 'consult-location cand))))
- (buffer-name
- ;; Handle cheap marker
- (if (consp marker)
- (car marker)
- (marker-buffer marker))))))
-
(defun consult--line-prefix (&optional curr-line)
"Annotate `consult-location' candidates with line numbers.
CURR-LINE is the current line number."
@@ -1139,22 +889,22 @@ CURR-LINE is the current line number."
(let ((line (cdr (get-text-property 0 'consult-location cand))))
(list cand (format (if (< line curr-line) before after) line) "")))))
-(defun consult--location-candidate (cand marker line &rest props)
- "Add MARKER and LINE as \\='consult-location text property to CAND.
+(defsubst consult--location-candidate (cand marker line tofu &rest props)
+ "Add MARKER and LINE as `consult-location' text property to CAND.
Furthermore add the additional text properties PROPS, and append
-tofu-encoded MARKER suffix for disambiguation."
- ;; Handle cheap marker
- (setq cand (concat cand (consult--tofu-encode (if (consp marker) (cdr marker) marker))))
+TOFU suffix for disambiguation."
+ (setq cand (concat cand (consult--tofu-encode tofu)))
(add-text-properties 0 1 `(consult-location (,marker . ,line) ,@props) cand)
cand)
-;; There is a similar variable `yank-excluded-properties'. Unfortunately
+;; There is a similar variable `yank-excluded-properties'. Unfortunately
;; we cannot use it here since it excludes too much (e.g., invisible)
;; and at the same time not enough (e.g., cursor-sensor-functions).
(defconst consult--remove-text-properties
'(category cursor cursor-intangible cursor-sensor-functions field follow-link
- fontified front-sticky help-echo insert-behind-hooks insert-in-front-hooks intangible keymap
- local-map modification-hooks mouse-face pointer read-only rear-nonsticky yank-handler)
+ fontified front-sticky help-echo insert-behind-hooks insert-in-front-hooks
+ intangible keymap local-map modification-hooks mouse-face pointer read-only
+ rear-nonsticky yank-handler)
"List of text properties to remove from buffer strings.")
(defsubst consult--buffer-substring (beg end &optional fontify)
@@ -1165,8 +915,11 @@ region has been fontified."
(let (str)
(when fontify (consult--fontify-region beg end))
(setq str (buffer-substring beg end))
- ;; TODO Propose the addition of a function `preserve-list-of-text-properties'
- (remove-list-of-text-properties 0 (- end beg) consult--remove-text-properties str)
+ ;; TODO Propose the upstream addition of a function
+ ;; `preserve-list-of-text-properties', which should be as efficient as
+ ;; `remove-list-of-text-properties'.
+ (remove-list-of-text-properties
+ 0 (- end beg) consult--remove-text-properties str)
str)
(buffer-substring-no-properties beg end)))
@@ -1185,8 +938,205 @@ MARKER is the cursor position."
(defun consult--line-with-cursor (marker)
"Return current line where the cursor MARKER is highlighted."
- (let ((inhibit-field-text-motion t))
- (consult--region-with-cursor (line-beginning-position) (line-end-position) marker)))
+ (consult--region-with-cursor (pos-bol) (pos-eol) marker))
+
+;;;; Regexp utilities
+
+(defun consult--find-highlights (str start &rest ignored-faces)
+ "Find highlighted regions in STR from position START.
+Highlighted regions have a non-nil face property.
+IGNORED-FACES are ignored when searching for matches."
+ (let (highlights
+ (end (length str))
+ (beg start))
+ (while (< beg end)
+ (let ((next (next-single-property-change beg 'face str end))
+ (val (get-text-property beg 'face str)))
+ (when (and val
+ (not (memq val ignored-faces))
+ (not (and (consp val)
+ (seq-some (lambda (x) (memq x ignored-faces)) val))))
+ (push (cons (- beg start) (- next start)) highlights))
+ (setq beg next)))
+ (nreverse highlights)))
+
+(defun consult--point-placement (str start &rest ignored-faces)
+ "Compute point placement from STR with START offset.
+IGNORED-FACES are ignored when searching for matches.
+Return cons of point position and a list of match begin/end pairs."
+ (let* ((matches (apply #'consult--find-highlights str start ignored-faces))
+ (pos (pcase-exhaustive consult-point-placement
+ ('match-beginning (or (caar matches) 0))
+ ('match-end (or (cdar (last matches)) 0))
+ ('line-beginning 0))))
+ (dolist (match matches)
+ (cl-decf (car match) pos)
+ (cl-decf (cdr match) pos))
+ (cons pos matches)))
+
+(defun consult--highlight-regexps (regexps ignore-case str)
+ "Highlight REGEXPS in STR.
+If a regular expression contains capturing groups, only these are highlighted.
+If no capturing groups are used highlight the whole match. Case is ignored
+if IGNORE-CASE is non-nil."
+ (dolist (re regexps)
+ (let ((i 0))
+ (while (and (let ((case-fold-search ignore-case))
+ (string-match re str i))
+ ;; Ensure that regexp search made progress (edge case for .*)
+ (> (match-end 0) i))
+ ;; Unfortunately there is no way to avoid the allocation of the match
+ ;; data, since the number of capturing groups is unknown.
+ (let ((m (match-data)))
+ (setq i (cadr m) m (or (cddr m) m))
+ (while m
+ (when (car m)
+ (add-face-text-property (car m) (cadr m)
+ 'consult-highlight-match nil str))
+ (setq m (cddr m)))))))
+ str)
+
+(defconst consult--convert-regexp-table
+ (append
+ ;; For simplicity, treat word beginning/end as word boundaries,
+ ;; since PCRE does not make this distinction. Usually the
+ ;; context determines if \b is the beginning or the end.
+ '(("\\<" . "\\b") ("\\>" . "\\b")
+ ("\\_<" . "\\b") ("\\_>" . "\\b"))
+ ;; Treat \` and \' as beginning and end of line. This is more
+ ;; widely supported and makes sense for line-based commands.
+ '(("\\`" . "^") ("\\'" . "$"))
+ ;; Historical: Unescaped *, +, ? are supported at the beginning
+ (mapcan (lambda (x)
+ (mapcar (lambda (y)
+ (cons (concat x y)
+ (concat (string-remove-prefix "\\" x) "\\" y)))
+ '("*" "+" "?")))
+ '("" "\\(" "\\(?:" "\\|" "^"))
+ ;; Different escaping
+ (mapcan (lambda (x) `(,x (,(cdr x) . ,(car x))))
+ '(("\\|" . "|")
+ ("\\(" . "(") ("\\)" . ")")
+ ("\\{" . "{") ("\\}" . "}"))))
+ "Regexp conversion table.")
+
+(defun consult--convert-regexp (regexp type)
+ "Convert Emacs REGEXP to regexp syntax TYPE."
+ (if (memq type '(emacs basic))
+ regexp
+ ;; Support for Emacs regular expressions is fairly complete for basic
+ ;; usage. There are a few unsupported Emacs regexp features:
+ ;; - \= point matching
+ ;; - Syntax classes \sx \Sx
+ ;; - Character classes \cx \Cx
+ ;; - Explicitly numbered groups (?3:group)
+ (replace-regexp-in-string
+ (rx (or "\\\\" "\\^" ;; Pass through
+ (seq (or "\\(?:" "\\|") (any "*+?")) ;; Historical: \|+ or \(?:* etc
+ (seq "\\(" (any "*+")) ;; Historical: \(* or \(+
+ (seq (or bos "^") (any "*+?")) ;; Historical: + or * at the beginning
+ (seq (opt "\\") (any "(){|}")) ;; Escape parens/braces/pipe
+ (seq "\\" (any "'<>`")) ;; Special escapes
+ (seq "\\_" (any "<>")))) ;; Beginning or end of symbol
+ (lambda (x) (or (cdr (assoc x consult--convert-regexp-table)) x))
+ regexp 'fixedcase 'literal)))
+
+(defun consult--default-regexp-compiler (input type ignore-case)
+ "Compile the INPUT string to a list of regular expressions.
+The function should return a pair, the list of regular expressions and a
+highlight function. The highlight function should take a single
+argument, the string to highlight given the INPUT. TYPE is the desired
+type of regular expression, which can be `basic', `extended', `emacs' or
+`pcre'. If IGNORE-CASE is non-nil return a highlight function which
+matches case insensitively."
+ (setq input (consult--split-escaped input))
+ (cons (mapcar (lambda (x) (consult--convert-regexp x type)) input)
+ (when-let (regexps (seq-filter #'consult--valid-regexp-p input))
+ (apply-partially #'consult--highlight-regexps regexps ignore-case))))
+
+(defun consult--split-escaped (str)
+ "Split STR at spaces, which can be escaped with backslash."
+ (mapcar
+ (lambda (x) (string-replace "\0" " " x))
+ (split-string (replace-regexp-in-string
+ "\\\\\\\\\\|\\\\ "
+ (lambda (x) (if (equal x "\\ ") "\0" x))
+ str 'fixedcase 'literal)
+ " +" t)))
+
+(defun consult--join-regexps (regexps type)
+ "Join REGEXPS of TYPE."
+ ;; Add lookahead wrapper only if there is more than one regular expression
+ (cond
+ ((and (eq type 'pcre) (cdr regexps))
+ (concat "^" (mapconcat (lambda (x) (format "(?=.*%s)" x))
+ regexps "")))
+ ((eq type 'basic)
+ (string-join regexps ".*"))
+ (t
+ (when (length> regexps 3)
+ (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)) "\\")))))
+
+(defun consult--regexp-join-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)
+ esc ")"))
+ regexps (concat esc "|")))))
+
+(defun consult--valid-regexp-p (re)
+ "Return t if regexp RE is valid."
+ (condition-case nil
+ (progn (string-match-p re "") t)
+ (invalid-regexp nil)))
+
+(defun consult--regexp-filter (regexps)
+ "Create filter regexp from REGEXPS."
+ (if (stringp regexps)
+ regexps
+ (mapconcat (lambda (x) (concat "\\(?:" x "\\)")) regexps "\\|")))
+
+;;;; Lookup functions
+
+(defun consult--lookup-member (selected candidates &rest _)
+ "Lookup SELECTED in CANDIDATES list, return original element."
+ (car (member selected candidates)))
+
+(defun consult--lookup-cons (selected candidates &rest _)
+ "Lookup SELECTED in CANDIDATES alist, return cons."
+ (assoc selected candidates))
+
+(defun consult--lookup-cdr (selected candidates &rest _)
+ "Lookup SELECTED in CANDIDATES alist, return cdr of element."
+ (cdr (assoc selected candidates)))
+
+(defun consult--lookup-location (selected candidates &rest _)
+ "Lookup SELECTED in CANDIDATES list of `consult-location' category.
+Return the location marker."
+ (when-let (found (member selected candidates))
+ (setq found (car (consult--get-location (car found))))
+ ;; Check that marker is alive
+ (and (or (not (markerp found)) (marker-buffer found)) found)))
+
+(defun consult--lookup-prop (prop selected candidates &rest _)
+ "Lookup SELECTED in CANDIDATES list and return PROP value."
+ (when-let (found (member selected candidates))
+ (get-text-property 0 prop (car found))))
+
+(defun consult--lookup-candidate (selected candidates &rest _)
+ "Lookup SELECTED in CANDIDATES list and return property `consult--candidate'."
+ (consult--lookup-prop 'consult--candidate selected candidates))
;;;; Preview support
@@ -1205,11 +1155,11 @@ ORIG is the original function, HOOKS the arguments."
(defun consult--find-file-temporarily-1 (name)
"Open file NAME, helper function for `consult--find-file-temporarily'."
- (when-let* (((not (seq-find (lambda (x) (string-match-p x name))
- consult-preview-excluded-files)))
- ;; file-attributes may throw permission denied error
- (attrs (ignore-errors (file-attributes name)))
- (size (file-attribute-size attrs)))
+ (when-let (((not (seq-find (lambda (x) (string-match-p x name))
+ consult-preview-excluded-files)))
+ ;; file-attributes may throw permission denied error
+ (attrs (ignore-errors (file-attributes name)))
+ (size (file-attribute-size attrs)))
(if (> size consult-preview-max-size)
(format "File `%s' (%s) is too large for preview"
name (file-size-human-readable size))
@@ -1284,18 +1234,18 @@ ORIG is the original function, HOOKS the arguments."
(let ((default-directory dir))
(setq name (abbreviate-file-name (expand-file-name name)))
(or
- ;; Find existing fully initialized buffer (non-previewed). We have
+ ;; Find existing fully initialized buffer (non-previewed). We have
;; to check for fully initialized buffer before accessing the
;; previewed buffers, since `embark-act' can open a buffer which is
;; currently previewed, such that we end up with two buffers for
;; the same file - one previewed and only partially initialized and
- ;; one fully initialized. In this case we prefer the fully
- ;; initialized buffer. For directories `get-file-buffer' returns nil,
+ ;; one fully initialized. In this case we prefer the fully
+ ;; initialized buffer. For directories `get-file-buffer' returns nil,
;; therefore we have to special case Dired.
(if (and (fboundp 'dired-find-buffer-nocreate) (file-directory-p name))
(dired-find-buffer-nocreate name)
(get-file-buffer name))
- ;; Find existing previewed buffer. Previewed buffers are not fully
+ ;; Find existing previewed buffer. Previewed buffers are not fully
;; initialized (hooks are delayed) in order to ensure fast preview.
(cdr (assoc name temporary-buffers))
;; Finally, if no existing buffer has been found, open the file for
@@ -1306,7 +1256,7 @@ ORIG is the original function, HOOKS the arguments."
(add-hook 'window-selection-change-functions hook)
(push (cons name buf) temporary-buffers)
;; Disassociate buffer from file by setting `buffer-file-name'
- ;; and `dired-directory' to nil and rename the buffer. This
+ ;; and `dired-directory' to nil and rename the buffer. This
;; lets us open an already previewed buffer with the Embark
;; default action C-. RET.
(with-current-buffer buf
@@ -1316,7 +1266,7 @@ ORIG is the original function, HOOKS the arguments."
'unique))
;; The buffer disassociation is delayed to avoid breaking modes
;; like `pdf-view-mode' or `doc-view-mode' which rely on
- ;; `buffer-file-name'. Executing (set-visited-file-name nil)
+ ;; `buffer-file-name'. Executing (set-visited-file-name nil)
;; early also prevents the major mode initialization.
(let ((hook (make-symbol "consult--temporary-files-disassociate")))
(fset hook (lambda ()
@@ -1337,31 +1287,65 @@ ORIG is the original function, HOOKS the arguments."
(kill-buffer buf))
(setq temporary-buffers nil)))))
+(declare-function org-fold-core-region "org-fold-core")
+(declare-function org-fold-core-get-regions "org-fold-core")
+
(defun consult--invisible-open-permanently ()
"Open overlays which hide the current line.
See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'."
- (dolist (ov (let ((inhibit-field-text-motion t))
- (overlays-in (line-beginning-position) (line-end-position))))
- (when-let (fun (overlay-get ov 'isearch-open-invisible))
- (when (invisible-p (overlay-get ov 'invisible))
- (funcall fun ov)))))
+ (if (and (derived-mode-p #'org-mode) (fboundp 'org-fold-show-set-visibility))
+ ;; New Org 9.6 fold-core API
+ (org-fold-show-set-visibility 'canonical)
+ (dolist (ov (overlays-in (pos-bol) (pos-eol)))
+ (when-let (fun (overlay-get ov 'isearch-open-invisible))
+ (when (invisible-p (overlay-get ov 'invisible))
+ (funcall fun ov))))))
(defun consult--invisible-open-temporarily ()
"Temporarily open overlays which hide the current line.
See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'."
- (let (restore)
- (dolist (ov (let ((inhibit-field-text-motion t))
- (overlays-in (line-beginning-position) (line-end-position))))
- (let ((inv (overlay-get ov 'invisible)))
- (when (and (invisible-p inv) (overlay-get ov 'isearch-open-invisible))
- (push (if-let (fun (overlay-get ov 'isearch-open-invisible-temporary))
- (progn
- (funcall fun ov nil)
- (lambda () (funcall fun ov t)))
- (overlay-put ov 'invisible nil)
- (lambda () (overlay-put ov 'invisible inv)))
- restore))))
- restore))
+ (if (and (derived-mode-p #'org-mode) (fboundp 'org-fold-show-set-visibility))
+ ;; New Org 9.6 fold-core API
+ ;; TODO The provided Org API `org-fold-show-set-visibility' cannot be used
+ ;; efficiently. We obtain all regions in the whole buffer in order to
+ ;; restore them. A better show API would return all the applied
+ ;; modifications such that we can restore the ones which got modified.
+ (progn
+ (unless consult--org-fold-regions
+ (setq consult--org-fold-regions
+ (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))))))
+ (org-fold-show-set-visibility 'canonical)
+ (list (lambda ()
+ (pcase-dolist (`(,beg ,end ,spec) consult--org-fold-regions)
+ (org-fold-core-region beg end t spec)))))
+ (let (restore)
+ (dolist (ov (overlays-in (pos-bol) (pos-eol)))
+ (let ((inv (overlay-get ov 'invisible)))
+ (when (and (invisible-p inv) (overlay-get ov 'isearch-open-invisible))
+ (push (if-let (fun (overlay-get ov 'isearch-open-invisible-temporary))
+ (progn
+ (funcall fun ov nil)
+ (lambda () (funcall fun ov t)))
+ (overlay-put ov 'invisible nil)
+ (lambda () (overlay-put ov 'invisible inv)))
+ restore))))
+ restore)))
(defun consult--jump-1 (pos)
"Go to POS and recenter."
@@ -1370,8 +1354,9 @@ See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'."
;; with the minibuffer update hook.
(message "Buffer is dead")
;; Switch to buffer if it is not visible
- (when (and (markerp pos) (not (eq (current-buffer) (marker-buffer pos))))
- (consult--buffer-action (marker-buffer pos) 'norecord))
+ (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)
(unless (= (goto-char pos) (point))
(widen)
@@ -1416,35 +1401,61 @@ 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
- (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 (line-end-position)))
- (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))
- (run-hooks 'consult-after-jump-hook))))))
+ ;; Handle positions with overlay information
+ (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))
+ (run-hooks 'consult-after-jump-hook))))))
(defun consult--jump-state ()
"The state function used if selecting from a list of candidate positions."
(consult--state-with-return (consult--jump-preview) #'consult--jump))
+(defun consult--get-location (cand)
+ "Return location from CAND."
+ (let ((loc (get-text-property 0 'consult-location cand)))
+ (when (consp (car loc))
+ ;; Transform cheap marker to real marker
+ (setcar loc (set-marker (make-marker) (cdar loc) (caar loc))))
+ loc))
+
+(defun consult--location-state (candidates)
+ "Location state function.
+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")))
+ (fset hook
+ (lambda (_)
+ (unless (consult--completion-window-p)
+ (remove-hook 'window-selection-change-functions hook)
+ (mapc #'consult--get-location
+ (if (functionp candidates) (funcall candidates) candidates)))))
+ (lambda (action cand)
+ (pcase action
+ ('setup (add-hook 'window-selection-change-functions hook))
+ ('exit (remove-hook 'window-selection-change-functions hook)))
+ (funcall jump action cand))))
+
(defun consult--state-with-return (state return)
"Compose STATE function with RETURN function."
(lambda (action cand)
@@ -1469,7 +1480,13 @@ The result can be passed as :state argument to `consult--read'." type)
(if (eq (car preview-key) :debounce)
(setq debounce (cadr preview-key)
preview-key (cddr preview-key))
- (push (cons (car preview-key) debounce) keys)
+ (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)))
+ (push (cons key debounce) keys))
(pop preview-key)))
keys))
@@ -1480,10 +1497,10 @@ The result can be passed as :state argument to `consult--read'." type)
(let ((map (make-sparse-keymap))
(keys (this-single-command-keys))
any)
- (dolist (x (consult--preview-key-normalize preview-key))
- (if (eq (car x) 'any)
- (setq any (cdr x))
- (define-key map (car x) `(lambda () ,(cdr x)))))
+ (pcase-dolist (`(,k . ,d) (consult--preview-key-normalize preview-key))
+ (if (eq k 'any)
+ (setq any d)
+ (define-key map k `(lambda () ,d))))
(setq keys (lookup-key map keys))
(if (functionp keys) (funcall keys) any)))
@@ -1505,7 +1522,7 @@ The result can be passed as :state argument to `consult--read'." type)
"Add preview support for FUN.
See `consult--with-preview' for the arguments
PREVIEW-KEY, STATE, TRANSFORM and CANDIDATE."
- (let ((input "") narrow selected timer last-preview)
+ (let ((mb-input "") mb-narrow selected timer previewed)
(consult--minibuffer-with-setup-hook
(if (and state preview-key)
(lambda ()
@@ -1520,7 +1537,7 @@ PREVIEW-KEY, STATE, TRANSFORM and CANDIDATE."
(setq timer nil))
(with-selected-window (or (minibuffer-selected-window) (next-window))
;; STEP 3: Reset preview
- (when last-preview
+ (when previewed
(funcall state 'preview nil))
;; STEP 4: Notify the preview function of the minibuffer exit
(funcall state 'exit nil)))))
@@ -1531,16 +1548,39 @@ PREVIEW-KEY, STATE, TRANSFORM and CANDIDATE."
(setq consult--preview-function
(lambda ()
(when-let ((cand (funcall candidate)))
+ ;; Drop properties to prevent bugs regarding candidate
+ ;; lookup, which must handle candidates without
+ ;; properties. Otherwise the arguments passed to the
+ ;; lookup function are confusing, since during preview
+ ;; the candidate has properties but for the final lookup
+ ;; after completion it does not.
+ (setq cand (substring-no-properties cand))
(with-selected-window (active-minibuffer-window)
- (let* ((input (minibuffer-contents-no-properties))
- (transformed (funcall transform narrow input cand))
- (new-preview (cons input cand)))
+ (let ((input (minibuffer-contents-no-properties))
+ (narrow consult--narrow))
(with-selected-window (or (minibuffer-selected-window) (next-window))
- (when-let (debounce (consult--preview-key-debounce preview-key transformed))
+ (when-let ((transformed (funcall transform narrow input cand))
+ (debounce (consult--preview-key-debounce preview-key transformed)))
(when timer
(cancel-timer timer)
(setq timer nil))
- (unless (equal-including-properties last-preview new-preview)
+ ;; The transformed candidate may have text
+ ;; properties, which change the preview display.
+ ;; This matters for example for `consult-grep',
+ ;; where the current candidate and input may
+ ;; stay equal, but the highlighting of the
+ ;; candidate changes while the candidates list
+ ;; is lagging a bit behind and updates
+ ;; asynchronously.
+ ;;
+ ;; NOTE: In older Consult versions the input was
+ ;; compared instead, since I was worried that
+ ;; comparing the transformed candidates could be
+ ;; potentially expensive or problematic. However
+ ;; comparing the transformed candidates is more
+ ;; correct, since the transformed candidate is
+ ;; the thing which is actually previewed.
+ (unless (equal-including-properties previewed transformed)
(if (> debounce 0)
(let ((win (selected-window)))
(setq timer
@@ -1550,24 +1590,23 @@ PREVIEW-KEY, STATE, TRANSFORM and CANDIDATE."
(when (window-live-p win)
(with-selected-window win
;; STEP 2: Preview candidate
- (funcall state 'preview transformed)
- (setq last-preview new-preview)))))))
+ (funcall state 'preview (setq previewed transformed))))))))
;; STEP 2: Preview candidate
- (funcall state 'preview transformed)
- (setq last-preview new-preview))))))))))
+ (funcall state 'preview (setq previewed transformed)))))))))))
(consult--append-local-post-command-hook
(lambda ()
- (setq input (minibuffer-contents-no-properties)
- narrow consult--narrow)
+ (setq mb-input (minibuffer-contents-no-properties)
+ mb-narrow consult--narrow)
(funcall consult--preview-function))))
(lambda ()
(consult--append-local-post-command-hook
- (lambda () (setq input (minibuffer-contents-no-properties)
- narrow consult--narrow)))))
+ (lambda ()
+ (setq mb-input (minibuffer-contents-no-properties)
+ mb-narrow consult--narrow)))))
(unwind-protect
(cons (setq selected (when-let (result (funcall fun))
- (funcall transform narrow input result)))
- input)
+ (funcall transform mb-narrow mb-input result)))
+ mb-input)
(when state
;; STEP 5: The preview function should perform its final action
(funcall state 'return selected))))))
@@ -1581,8 +1620,8 @@ CANDIDATE is the function returning the current candidate.
PREVIEW-KEY are the keys which triggers the preview.
The state function takes two arguments, an action argument and the
-selected candidate. The candidate argument can be nil if no candidate is
-selected or if the selection was aborted. The function is called in
+selected candidate. The candidate argument can be nil if no candidate is
+selected or if the selection was aborted. The function is called in
sequence with the following arguments:
1. \\='setup nil After entering the mb (minibuffer-setup-hook).
@@ -1595,34 +1634,66 @@ sequence with the following arguments:
5. \\='return CAND/nil After leaving the mb, CAND has been selected.
The state function is always executed with the original window selected,
-see `minibuffer-selected-window'. The state function is called once in
-the beginning of the minibuffer setup with the `setup' argument. This is
+see `minibuffer-selected-window'. The state function is called once in
+the beginning of the minibuffer setup with the `setup' argument. This is
useful in order to perform certain setup operations which require that
-the minibuffer is initialized. During completion candidates are
-previewed. Then the function is called with the `preview' argument and a
-candidate CAND or nil if no candidate is selected. Furthermore if nil is
+the minibuffer is initialized. During completion candidates are
+previewed. Then the function is called with the `preview' argument and a
+candidate CAND or nil if no candidate is selected. Furthermore if nil is
passed for CAND, then the preview must be undone and the original state
-must be restored. The call with the `exit' argument happens once at the
-end of the completion process, just before exiting the minibuffer. The
-minibuffer is still alive at that point. Both `setup' and `exit' are
-only useful for setup and cleanup operations. They don't receive a
-candidate as argument. After leaving the minibuffer, the selected
+must be restored. The call with the `exit' argument happens once at the
+end of the completion process, just before exiting the minibuffer. The
+minibuffer is still alive at that point. Both `setup' and `exit' are
+only useful for setup and cleanup operations. They don't receive a
+candidate as argument. After leaving the minibuffer, the selected
candidate or nil is passed to the state function with the action
-argument `return'. At this point the state function can perform the
-actual action on the candidate. The state function with the `return'
-argument is the continuation of `consult--read'. Via `unwind-protect' it
+argument `return'. At this point the state function can perform the
+actual action on the candidate. The state function with the `return'
+argument is the continuation of `consult--read'. Via `unwind-protect' it
is guaranteed, that if the `setup' action of a state function is
invoked, the state function will also be called with `exit' and
`return'."
(declare (indent 4))
`(consult--with-preview-1 ,preview-key ,state ,transform ,candidate (lambda () ,@body)))
-;;;; Narrowing support
+;;;; Narrowing and grouping
+
+(defun consult--prefix-group (cand transform)
+ "Return title for CAND or TRANSFORM the candidate.
+The candidate must have a `consult--prefix-group' property."
+ (if transform
+ (substring cand (1+ (length (get-text-property 0 'consult--prefix-group cand))))
+ (get-text-property 0 'consult--prefix-group cand)))
+
+(defun consult--type-group (types)
+ "Return group function for TYPES."
+ (lambda (cand transform)
+ (if transform cand
+ (alist-get (get-text-property 0 'consult--type cand) types))))
+
+(defun consult--type-narrow (types)
+ "Return narrowing configuration from TYPES."
+ (list :predicate
+ (lambda (cand) (eq (get-text-property 0 'consult--type cand) consult--narrow))
+ :keys types))
(defun consult--widen-key ()
"Return widening key, if `consult-widen-key' is not set.
The default is twice the `consult-narrow-key'."
- (or consult-widen-key (and consult-narrow-key (vconcat consult-narrow-key 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-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))
+ (vconcat key key)))))
(defun consult-narrow (key)
"Narrow current completion with KEY.
@@ -1651,7 +1722,7 @@ This command is used internally by the narrowing system of `consult--read'."
`(menu-item
"" nil :filter
,(lambda (&optional _)
- (when (string= (minibuffer-contents-no-properties) "")
+ (when (equal (minibuffer-contents-no-properties) "")
(lambda ()
(interactive)
(consult-narrow nil))))))
@@ -1663,7 +1734,7 @@ This command is used internally by the narrowing system of `consult--read'."
(let ((str (minibuffer-contents-no-properties)))
(when-let (pair (or (and (length= str 1)
(assoc (aref str 0) consult--narrow-keys))
- (and (string= str "")
+ (and (equal str "")
(assoc 32 consult--narrow-keys))))
(lambda ()
(interactive)
@@ -1679,13 +1750,13 @@ to make it available for commands with narrowing."
(consult--require-minibuffer)
(let ((minibuffer-message-timeout 1000000))
(minibuffer-message
- (mapconcat
- (lambda (x) (concat
- (propertize (char-to-string (car x)) 'face 'consult-key) " "
+ (mapconcat (lambda (x)
+ (concat
+ (propertize (key-description (list (car x))) 'face 'consult-key)
+ " "
(propertize (cdr x) 'face 'consult-help)))
- (seq-filter (lambda (x) (/= (car x) 32))
- consult--narrow-keys)
- " "))))
+ consult--narrow-keys
+ " "))))
(defun consult--narrow-setup (settings map)
"Setup narrowing with SETTINGS and keymap MAP."
@@ -1694,12 +1765,15 @@ to make it available for commands with narrowing."
consult--narrow-keys (plist-get settings :keys))
(setq consult--narrow-predicate nil
consult--narrow-keys settings))
- (when consult-narrow-key
+ (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))
(dolist (pair consult--narrow-keys)
- (define-key map
- (vconcat consult-narrow-key (vector (car pair)))
- (cons (cdr pair) #'consult-narrow))))
- (when-let (widen (consult--widen-key))
+ (define-key map (vconcat key (vector (car pair)))
+ (cons (cdr pair) #'consult-narrow))))
+ (when-let ((widen (consult--widen-key)))
(define-key map widen (cons "All" #'consult-narrow))))
;; Emacs 28: hide in M-X
@@ -1713,8 +1787,8 @@ to make it available for commands with narrowing."
The function returns a list with three elements: The async
string, the start position of the completion filter string and a
-force flag. If the first character is a punctuation character it
-determines the separator. Examples: \"/async/filter\",
+force flag. If the first character is a punctuation character it
+determines the separator. Examples: \"/async/filter\",
\"#async#filter\"."
(if (string-match-p "^[[:punct:]]" str)
(save-match-data
@@ -1776,7 +1850,7 @@ PLIST is the splitter configuration, including the separator."
completion-category-defaults nil
completion-category-overrides nil)))
-;;;; Async support
+;;;; Asynchronous filtering functions
(defmacro consult--with-async (bind &rest body)
"Setup asynchronous completion in BODY.
@@ -1789,7 +1863,7 @@ BIND is the asynchronous function binding."
orig-chunk)
(consult--minibuffer-with-setup-hook
;; Append such that we overwrite the completion style setting of
- ;; `fido-mode'. See `consult--async-split' and
+ ;; `fido-mode'. See `consult--async-split' and
;; `consult--split-setup'.
(:append
(lambda ()
@@ -1806,7 +1880,7 @@ BIND is the asynchronous function binding."
;; Push input string to request refresh.
(funcall ,async (minibuffer-contents-no-properties))))))))
;; We use a symbol in order to avoid adding lambdas to
- ;; the hook variable. Symbol indirection because of
+ ;; the hook variable. Symbol indirection because of
;; bug#46407.
(sym (make-symbol "consult--async-after-change")))
;; Delay modification hook to ensure that minibuffer is still
@@ -1825,17 +1899,18 @@ BIND is the asynchronous function binding."
(defun consult--async-sink ()
"Create ASYNC sink function.
-An async function must accept a single action argument. For the \\='setup action
-it is guaranteed that the call originates from the minibuffer. For the other
-actions no assumption about the context can be made.
+An async function must accept a single action argument. For the
+\\='setup action it is guaranteed that the call originates from
+the minibuffer. For the other actions no assumption about the
+context can be made.
-\\='setup Setup the internal closure state. Return nil.
-\\='destroy Destroy the internal closure state. Return nil.
-\\='flush Flush the list of candidates. Return nil.
-\\='refresh Request UI refresh. Return nil.
+\\='setup Setup the internal closure state. Return nil.
+\\='destroy Destroy the internal closure state. Return nil.
+\\='flush Flush the list of candidates. Return nil.
+\\='refresh Request UI refresh. Return nil.
nil Return the list of candidates.
list Append the list to the already existing candidates list and return it.
-string Update with the current user input string. Return nil."
+string Update with the current user input string. Return nil."
(let (candidates last buffer)
(lambda (action)
(pcase-exhaustive action
@@ -1853,7 +1928,7 @@ string Update with the current user input string. Return nil."
(run-hooks 'consult--completion-refresh-hook)
;; Interaction between asynchronous completion tables and
;; preview: We have to trigger preview immediately when
- ;; candidates arrive (Issue #436).
+ ;; candidates arrive (gh:minad/consult#436).
(when (and consult--preview-function candidates)
(funcall consult--preview-function)))))
nil)
@@ -1895,12 +1970,18 @@ SPLIT is the splitting function."
(funcall split action))
(async-len (length async-str))
(input-len (length action))
- (end (minibuffer-prompt-end)))
+ (prompt (minibuffer-prompt-end))
+ (field-beg prompt)
+ (field-idx 0))
;; Highlight punctuation characters
- (remove-list-of-text-properties end (+ end input-len) '(face))
+ (remove-list-of-text-properties prompt (+ prompt input-len) '(face field))
(dolist (hl highlights)
- (put-text-property (+ end (car hl)) (+ end (cdr hl))
- 'face 'consult-async-split))
+ (put-text-property field-beg (+ prompt (cdr hl))
+ 'field field-idx)
+ (put-text-property (+ prompt (car hl)) (+ prompt (cdr hl))
+ 'face 'consult-async-split)
+ (setq field-beg (+ prompt (cdr hl))
+ field-idx (1+ field-idx)))
(funcall async
;; Pass through if the input is long enough!
(if (or force (>= async-len consult-async-min-input))
@@ -1909,29 +1990,42 @@ SPLIT is the splitting function."
""))))
(_ (funcall async action)))))
+(defun consult--async-indicator (async)
+ "Create async function with a state indicator overlay.
+ASYNC is the async sink."
+ (let (ov)
+ (lambda (action &optional state)
+ (pcase action
+ ('indicator
+ (overlay-put ov 'display
+ (pcase-exhaustive state
+ ('running #("*" 0 1 (face consult-async-running)))
+ ('finished #(":" 0 1 (face consult-async-finished)))
+ ('killed #(";" 0 1 (face consult-async-failed)))
+ ('failed #("!" 0 1 (face consult-async-failed))))))
+ ('setup
+ (setq ov (make-overlay (- (minibuffer-prompt-end) 2)
+ (- (minibuffer-prompt-end) 1)))
+ (funcall async 'setup))
+ ('destroy
+ (delete-overlay ov)
+ (funcall async 'destroy))
+ (_ (funcall async action))))))
+
(defun consult--async-log (formatted &rest args)
"Log FORMATTED ARGS to variable `consult--async-log'."
(with-current-buffer (get-buffer-create consult--async-log)
(goto-char (point-max))
(insert (apply #'format formatted args))))
-(defun consult--process-indicator (event)
- "Return the process indicator character for EVENT."
- (cond
- ((string-prefix-p "killed" event)
- #(";" 0 1 (face consult-async-failed)))
- ((string-prefix-p "finished" event)
- #(":" 0 1 (face consult-async-finished)))
- (t
- #("!" 0 1 (face consult-async-failed)))))
-
-(defun consult--async-process (async cmd &rest props)
+(defun consult--async-process (async builder &rest props)
"Create process source async function.
ASYNC is the async function which receives the candidates.
-CMD is the command line builder function.
+BUILDER is the command line builder function.
PROPS are optional properties passed to `make-process'."
- (let (proc proc-buf last-args indicator count)
+ (setq async (consult--async-indicator async))
+ (let (proc proc-buf last-args count)
(lambda (action)
(pcase action
("" ;; If no input is provided kill current process
@@ -1942,8 +2036,7 @@ PROPS are optional properties passed to `make-process'."
(setq last-args nil))
((pred stringp)
(funcall async action)
- (let* ((args (funcall cmd action))
- (flush t)
+ (let* ((flush t)
(rest "")
(proc-filter
(lambda (_ out)
@@ -1965,9 +2058,13 @@ PROPS are optional properties passed to `make-process'."
(when flush
(setq flush nil)
(funcall async 'flush))
- (overlay-put indicator 'display (consult--process-indicator event))
- (when (and (string-prefix-p "finished" event) (not (string= rest "")))
- (setq count (+ count 1))
+ (funcall async 'indicator
+ (cond
+ ((string-prefix-p "killed" event) 'killed)
+ ((string-prefix-p "finished" event) 'finished)
+ (t 'failed)))
+ (when (and (string-prefix-p "finished" event) (not (equal rest "")))
+ (cl-incf count)
(funcall async (list rest)))
(consult--async-log
"consult--async-process sentinel: event=%s lines=%d\n"
@@ -1976,7 +2073,14 @@ PROPS are optional properties passed to `make-process'."
(goto-char (point-max))
(insert ">>>>> stderr >>>>>\n")
(insert-buffer-substring proc-buf)
- (insert "<<<<< stderr <<<<<\n")))))
+ (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))))
(unless (equal args last-args)
(setq last-args args)
(when proc
@@ -1984,7 +2088,7 @@ PROPS are optional properties passed to `make-process'."
(kill-buffer proc-buf)
(setq proc nil proc-buf nil))
(when args
- (overlay-put indicator 'display #("*" 0 1 (face consult-async-running)))
+ (funcall async 'indicator 'running)
(consult--async-log "consult--async-process started %S\n" args)
(setq count 0
proc-buf (generate-new-buffer " *consult-async-stderr*")
@@ -2004,22 +2108,22 @@ PROPS are optional properties passed to `make-process'."
(delete-process proc)
(kill-buffer proc-buf)
(setq proc nil proc-buf nil))
- (delete-overlay indicator)
(funcall async 'destroy))
- ('setup
- (setq indicator (make-overlay (- (minibuffer-prompt-end) 2)
- (- (minibuffer-prompt-end) 1)))
- (funcall async 'setup))
(_ (funcall async action))))))
(defun consult--async-highlight (async builder)
"Return ASYNC function which highlightes the candidates.
-BUILDER is the command line builder."
- (let ((highlight))
+BUILDER is the command line builder function."
+ (let (highlight)
(lambda (action)
(cond
((stringp action)
- (setq highlight (plist-get (funcall builder action) :highlight))
+ (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))))
(funcall async action))
((and (consp action) highlight)
(dolist (str action)
@@ -2034,17 +2138,17 @@ The THROTTLE delay defaults to `consult-async-input-throttle'.
The DEBOUNCE delay defaults to `consult-async-input-debounce'."
(setq throttle (or throttle consult-async-input-throttle)
debounce (or debounce consult-async-input-debounce))
- (let ((input "") (last) (timer))
+ (let ((input "") last timer)
(lambda (action)
(pcase action
((pred stringp)
- (unless (string= action input)
+ (unless (equal action input)
(when timer
(cancel-timer timer)
(setq timer nil))
(funcall async "") ;; cancel running process
(setq input action)
- (unless (string= action "")
+ (unless (equal action "")
(setq timer
(run-at-time
(+ debounce
@@ -2091,6 +2195,24 @@ The refresh happens after a DELAY, defaulting to `consult-async-refresh-delay'."
(funcall async 'refresh)))))))
('destroy (when timer (cancel-timer timer))))))))
+(defmacro consult--async-command (builder &rest args)
+ "Asynchronous command pipeline.
+ARGS is a list of `make-process' properties and transforms.
+BUILDER is the command line builder function, which takes the
+input string and must either return a list of command line
+arguments or a pair of the command line argument list and a
+highlighting function."
+ (declare (indent 1))
+ `(thread-first
+ (consult--async-sink)
+ (consult--async-refresh-timer)
+ ,@(seq-take-while (lambda (x) (not (keywordp x))) args)
+ (consult--async-process
+ ,builder
+ ,@(seq-drop-while (lambda (x) (not (keywordp x))) args))
+ (consult--async-throttle)
+ (consult--async-split)))
+
(defmacro consult--async-transform (async &rest transform)
"Use FUN to TRANSFORM candidates of ASYNC."
(let ((async-var (make-symbol "async"))
@@ -2107,51 +2229,76 @@ The refresh happens after a DELAY, defaulting to `consult-async-refresh-delay'."
"Filter candidates of ASYNC by FUN."
(consult--async-transform async seq-filter fun))
-(defun consult--command-builder (builder)
- "Return command line builder given CMD.
-BUILDER is the command line builder function."
- (lambda (input)
- (setq input (funcall builder input))
- (if (stringp (car input))
- input
- (plist-get input :command))))
+;;;; Dynamic collections based
+
+(defun consult--dynamic-compute (async fun &optional debounce)
+ "Dynamic computation of candidates.
+ASYNC is the sink.
+FUN computes the candidates given the input.
+DEBOUNCE is the time after which an interrupted computation
+should be restarted."
+ (setq debounce (or debounce consult-async-input-debounce))
+ (setq async (consult--async-indicator async))
+ (let* ((request) (current) (timer)
+ (cancel (lambda () (when timer (cancel-timer timer) (setq timer nil))))
+ (start (lambda (req) (setq request req) (funcall async 'refresh))))
+ (lambda (action)
+ (pcase action
+ ((and 'nil (guard (not request)))
+ (funcall async nil))
+ ('nil
+ (funcall cancel)
+ (let ((state 'killed))
+ (unwind-protect
+ (progn
+ (funcall async 'indicator 'running)
+ (redisplay)
+ ;; Run computation
+ (let ((response (funcall fun request)))
+ ;; Flush and update candidate list
+ (funcall async 'flush)
+ (setq state 'finished current request)
+ (funcall async response)))
+ (funcall async 'indicator state)
+ ;; If the computation was killed, restart it after some time.
+ (when (eq state 'killed)
+ (setq timer (run-at-time debounce nil start request)))
+ (setq request nil))))
+ ((pred stringp)
+ (funcall cancel)
+ (if (or (equal action "") (equal action current))
+ (funcall async 'indicator 'finished)
+ (funcall start action)))
+ ('destroy
+ (funcall cancel)
+ (funcall async 'destroy))
+ (_ (funcall async action))))))
-(defmacro consult--async-command (builder &rest args)
- "Asynchronous command pipeline.
-ARGS is a list of `make-process' properties and transforms. BUILDER is the
-command line builder function, which takes the input string and must either
-return a list of command line arguments or a plist with the command line
-argument list :command and a highlighting function :highlight."
- (declare (indent 1))
- `(thread-first (consult--async-sink)
- (consult--async-refresh-timer)
- ,@(seq-take-while (lambda (x) (not (keywordp x))) args)
- (consult--async-process
- (consult--command-builder ,builder)
- ,@(seq-drop-while (lambda (x) (not (keywordp x))) args))
- (consult--async-throttle)
- (consult--async-split)))
+(defun consult--dynamic-collection (fun)
+ "Dynamic collection with input splitting.
+FUN computes the candidates given the input."
+ (thread-first
+ (consult--async-sink)
+ (consult--dynamic-compute fun)
+ (consult--async-throttle)
+ (consult--async-split)))
;;;; Special keymaps
-(defvar consult-async-map
- (let ((map (make-sparse-keymap)))
- ;; Async keys overwriting some unusable defaults for the default completion
- (define-key map [remap minibuffer-complete-word] #'self-insert-command)
- ;; Remap Emacs 29 history and default completion for now.
- ;; See https://github.com/minad/consult/issues/613
- (define-key map [remap minibuffer-complete-defaults] #'ignore)
- (define-key map [remap minibuffer-complete-history] #'consult-history)
- map)
- "Keymap added for commands with asynchronous candidates.")
-
-(defvar consult-narrow-map
- (let ((map (make-sparse-keymap)))
- (define-key map " " consult--narrow-space)
- (define-key map "\d" consult--narrow-delete)
- map)
- "Narrowing keymap which is added to the local minibuffer map.
-Note that `consult-narrow-key' and `consult-widen-key' are bound dynamically.")
+(defvar-keymap consult-async-map
+ :doc "Keymap added for commands with asynchronous candidates."
+ ;; Overwriting some unusable defaults of default minibuffer completion.
+ "<remap> <minibuffer-complete-word>" #'self-insert-command
+ ;; Remap Emacs 29 history and default completion for now
+ ;; (gh:minad/consult#613).
+ "<remap> <minibuffer-complete-defaults>" #'ignore
+ "<remap> <minibuffer-complete-history>" #'consult-history)
+
+(defvar-keymap consult-narrow-map
+ :doc "Narrowing keymap which is added to the local minibuffer map.
+Note that `consult-narrow-key' and `consult-widen-key' are bound dynamically."
+ "SPC" consult--narrow-space
+ "DEL" consult--narrow-delete)
;;;; Internal API: consult--read
@@ -2164,10 +2311,11 @@ ASYNC must be non-nil for async completion functions."
(ensure-list minibuffer-default)
;; then our custom items
(remove "" (remq nil (ensure-list items)))
- ;; Add all the completions for non-async commands. For async commands this feature
- ;; is not useful, since if one selects a completion candidate, the async search is
- ;; restarted using that candidate string. This usually does not yield a desired
- ;; result since the async input uses a special format, e.g., `#grep#filter'.
+ ;; Add all the completions for non-async commands. For async commands this
+ ;; feature is not useful, since if one selects a completion candidate, the
+ ;; async search is restarted using that candidate string. This usually does
+ ;; not yield a desired result since the async input uses a special format,
+ ;; e.g., `#grep#filter'.
(unless async
(all-completions ""
minibuffer-completion-table
@@ -2214,7 +2362,7 @@ PREVIEW-KEY are the preview keys."
(let* ((max (length str))
(end max))
(while (and (> end 0) (consult--tofu-p (aref str (1- end))))
- (setq end (1- end)))
+ (cl-decf end))
(when (< end max)
(setq str (copy-sequence str))
(put-text-property end max 'invisible t str))
@@ -2226,27 +2374,31 @@ PREVIEW-KEY are the preview keys."
(max (point-max))
(pos max))
(while (and (> pos min) (consult--tofu-p (char-before pos)))
- (setq pos (1- pos)))
+ (cl-decf pos))
(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."
+ "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."
+ "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
+;; 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.
+;; 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."
+ "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
@@ -2271,8 +2423,9 @@ PREVIEW-KEY are the preview keys."
ann
(setq ann (or ann ""))
(list cand ""
- ;; The default completion UI adds the `completions-annotations' face
- ;; if no other faces are present.
+ ;; The default completion UI adds the
+ ;; `completions-annotations' face if no other faces are
+ ;; present.
(if (text-property-not-all 0 (length ann) 'face nil ann)
ann
(propertize ann 'face 'completions-annotations))))))
@@ -2290,11 +2443,11 @@ PREVIEW-KEY are the preview keys."
(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 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.
+ ;; NOTE: Do not unnecessarily let-bind the lambdas to avoid overcapturing
+ ;; 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.
(let* ((metadata `(metadata
,@(when category `((category . ,category)))
,@(when group `((group-function . ,group)))
@@ -2332,27 +2485,42 @@ PREVIEW-KEY are the preview keys."
prompt predicate require-match history default
keymap category initial narrow add-history annotate
state preview-key sort lookup group inherit-input-method)
- "Enhanced completing read function selecting from CANDIDATES.
+ "Enhanced completing read function to select from CANDIDATES.
+
+The function is a thin wrapper around `completing-read'. Keyword
+arguments are used instead of positional arguments for code
+clarity. On top of `completing-read' it additionally supports
+computing the candidate list asynchronously, candidate preview
+and narrowing.
Keyword OPTIONS:
-PROMPT is the string which is shown as prompt message in the minibuffer.
-PREDICATE is a filter function called for each candidate.
+PROMPT is the string which is shown as prompt in the minibuffer.
+PREDICATE is a filter function called for each candidate, returns
+nil or t.
REQUIRE-MATCH equals t means that an exact match is required.
HISTORY is the symbol of the history variable.
DEFAULT is the default selected value.
ADD-HISTORY is a list of items to add to the history.
-CATEGORY is the completion category.
+CATEGORY is the completion category symbol.
SORT should be set to nil if the candidates are already sorted.
-LOOKUP is a lookup function passed selected, candidates, input and narrow.
-ANNOTATE is a function passed a candidate string to return an annotation.
-INITIAL is the initial input.
+This will disable sorting in the completion UI.
+LOOKUP is a lookup function passed the selected candidate string,
+the list of candidates, the current input string and the current
+narrowing value.
+ANNOTATE is a function passed a candidate string. The function
+should either return an annotation string or a list of three
+strings (candidate prefix postfix).
+INITIAL is the initial input string.
STATE is the state function, see `consult--with-preview'.
-GROUP is a completion metadata `group-function'.
-PREVIEW-KEY are the preview keys (nil, \\='any, a single key or a list of keys).
+GROUP is a completion metadata `group-function' as documented in
+the Elisp manual.
+PREVIEW-KEY are the preview keys. Can be nil, `any', a single
+key or a list of keys.
NARROW is an alist of narrowing prefix strings and description.
KEYMAP is a command-specific keymap.
-INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits the input method."
+INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits the
+input method."
;; supported types
(cl-assert (or (functionp candidates) ;; async table
(obarrayp candidates) ;; obarray
@@ -2410,8 +2578,7 @@ INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits the input method."
(defun consult--multi-group (sources cand transform)
"Return title of candidate CAND or TRANSFORM the candidate given SOURCES."
- (if transform
- cand
+ (if transform cand
(plist-get (consult--multi-source sources cand) :name)))
(defun consult--multi-preview-key (sources)
@@ -2432,31 +2599,37 @@ INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits the input method."
(defun consult--multi-lookup (sources selected candidates _input narrow &rest _)
"Lookup SELECTED in CANDIDATES given SOURCES, with potential NARROW."
- (unless (string-blank-p selected)
- (if-let (found (member selected candidates))
- (cons (cdr (get-text-property 0 'multi-category (car found)))
- (consult--multi-source sources selected))
- (let* ((tofu (consult--tofu-p (aref selected (1- (length selected)))))
- (src (cond
- (tofu (consult--multi-source sources selected))
+ (if (or (string-blank-p selected)
+ (not (consult--tofu-p (aref selected (1- (length selected))))))
+ ;; Non-existing candidate without Tofu or default submitted (empty string)
+ (let* ((src (cond
(narrow (seq-find (lambda (src)
(let ((n (plist-get src :narrow)))
(eq (or (car-safe n) n -1) narrow)))
sources))
((seq-find (lambda (src) (plist-get src :default)) sources))
- ((aref sources 0)))))
- `(,(if tofu (substring selected 0 -1) selected) :match nil ,@src)))))
+ ((aref sources 0))))
+ (idx (seq-position sources src))
+ (def (and (string-blank-p selected) ;; default candidate
+ (seq-find (lambda (cand) (eq idx (consult--tofu-get cand))) candidates))))
+ (if def
+ (cons (cdr (get-text-property 0 'multi-category def)) src)
+ `(,selected :match nil ,@src)))
+ (if-let (found (member selected candidates))
+ ;; Existing candidate submitted
+ (cons (cdr (get-text-property 0 'multi-category (car found)))
+ (consult--multi-source sources selected))
+ ;; Non-existing Tofu'ed candidate submitted, e.g., via Embark
+ `(,(substring selected 0 -1) :match nil ,@(consult--multi-source sources selected)))))
(defun consult--multi-candidates (sources)
"Return `consult--multi' candidates from SOURCES."
- (let ((def) (idx 0) (max-width 0) (candidates))
+ (let ((idx 0) (max-width 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)))
- (when (and (not def) (plist-get src :default) items)
- (setq def (consult--tofu-append (car items) idx)))
(dolist (item items)
(let ((cand (consult--tofu-append item idx))
(width (consult--display-width item)))
@@ -2468,8 +2641,8 @@ INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits the input method."
`(multi-category (,cat . ,item) ,@face) cand))
(when (> width max-width) (setq max-width width))
(push cand candidates))))
- (setq idx (1+ idx)))
- (list def (+ 3 max-width) (nreverse candidates))))
+ (cl-incf idx))
+ (cons (+ 3 max-width) (nreverse candidates))))
(defun consult--multi-enabled-sources (sources)
"Return vector of enabled SOURCES."
@@ -2519,25 +2692,29 @@ INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits the input method."
(defun consult--multi (sources &rest options)
"Select from candidates taken from a list of SOURCES.
-OPTIONS is the plist of options passed to `consult--read'. The following
+OPTIONS is the plist of options passed to `consult--read'. The following
options are supported: :require-match, :history, :keymap, :initial,
-:add-history, :sort and :inherit-input-method. The other options of
+:add-history, :sort and :inherit-input-method. The other options of
`consult--read' are used by the implementation of `consult--multi' and
-should be overwritten only in special scenarios.
+should not be overwritten, except in in special scenarios.
The function returns the selected candidate in the form (cons candidate
-source-plist). The plist has the key :match with a value nil if the
+source-plist). The plist has the key :match with a value nil if the
candidate does not exist, t if the candidate exists and `new' if the
-candidate has been created. The sources of the source list can either be
-symbols of source variables or source values. Source values must be
-plists with the following fields:
+candidate has been created. The sources of the source list can either be
+symbols of source variables or source values. Source values must be
+plists with fields from the following list.
Required source fields:
-* :category - Completion category.
-* :items - List of strings to select from or function returning list of strings.
+* :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,
+ :action and :state functions.
Optional source fields:
-* :name - Name of the source, used for narrowing, group titles and annotations.
+* :name - Name of the source as a string, used for narrowing,
+ group titles and annotations.
* :narrow - Narrowing character or (character . string) pair.
* :enabled - Function which must return t if the source is enabled.
* :hidden - When t candidates of this source are hidden by default.
@@ -2547,28 +2724,32 @@ Optional source fields:
* :default - Must be t if the first item of the source is the default value.
* :action - Function called with the selected candidate.
* :new - Function called with new candidate name, only if :require-match is nil.
-* :state - State constructor for the source, must return the state function.
-* Other source fields can be added specifically to the use case."
+* :state - State constructor for the source, must return the
+ state function. The state function is informed about state
+ changes of the UI and can be used to implement preview.
+* Other custom source fields can be added depending on the use
+ case. Note that the source is returned by `consult--multi'
+ together with the selected candidate."
(let* ((sources (consult--multi-enabled-sources sources))
(candidates (consult--with-increased-gc
(consult--multi-candidates sources)))
(align (propertize
" " 'display
- `(space :align-to (+ left ,(cadr candidates)))))
- (selected (apply #'consult--read
- (caddr candidates)
- (append
- options
- (list
- :default (car candidates)
- :category 'multi-category
- :predicate (apply-partially #'consult--multi-predicate sources)
- :annotate (apply-partially #'consult--multi-annotate sources align)
- :group (apply-partially #'consult--multi-group sources)
- :lookup (apply-partially #'consult--multi-lookup sources)
- :preview-key (consult--multi-preview-key sources)
- :narrow (consult--multi-narrow sources)
- :state (consult--multi-state sources))))))
+ `(space :align-to (+ left ,(car candidates)))))
+ (selected
+ (apply #'consult--read
+ (cdr candidates)
+ (append
+ options
+ (list
+ :category 'multi-category
+ :predicate (apply-partially #'consult--multi-predicate sources)
+ :annotate (apply-partially #'consult--multi-annotate sources align)
+ :group (apply-partially #'consult--multi-group sources)
+ :lookup (apply-partially #'consult--multi-lookup sources)
+ :preview-key (consult--multi-preview-key sources)
+ :narrow (consult--multi-narrow sources)
+ :state (consult--multi-state sources))))))
(when-let (history (plist-get (cdr selected) :history))
(add-to-history history (car selected)))
(if (plist-member (cdr selected) :match)
@@ -2592,7 +2773,8 @@ Optional source fields:
(apply-partially #'consult--add-history nil add-history))))
(car (consult--with-preview
preview-key state
- (lambda (_narrow inp _cand) (funcall transform inp)) #'always
+ (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
@@ -2608,7 +2790,7 @@ 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).
+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)
@@ -2620,21 +2802,56 @@ KEYMAP is a command-specific keymap."
:preview-key consult-preview-key
:transform #'identity))))
-;;;; Functions
+;;;; Customization macro
+
+(defun consult--customize-put (cmds prop form)
+ "Set property PROP to FORM of commands CMDS."
+ (dolist (cmd cmds)
+ (cond
+ ((and (boundp cmd) (consp (symbol-value cmd)))
+ (setf (plist-get (symbol-value cmd) prop) (eval form 'lexical)))
+ ((functionp cmd)
+ (setf (plist-get (alist-get cmd consult--customize-alist) prop) form))
+ (t (user-error "%s is neither a Command command nor a source" cmd))))
+ nil)
+
+(defmacro consult-customize (&rest args)
+ "Set properties of commands or sources.
+ARGS is a list of commands or sources followed by the list of
+keyword-value pairs. For `consult-customize' to succeed, the
+customized sources and commands must exist. When a command is
+invoked, the value of `this-command' is used to lookup the
+corresponding customization options."
+ (let (setter)
+ (while args
+ (let ((cmds (seq-take-while (lambda (x) (not (keywordp x))) args)))
+ (setq args (seq-drop-while (lambda (x) (not (keywordp x))) args))
+ (while (keywordp (car args))
+ (push `(consult--customize-put ',cmds ,(car args) ',(cadr args)) setter)
+ (setq args (cddr args)))))
+ (macroexp-progn setter)))
+
+(defun consult--customize-get (&optional cmd)
+ "Get configuration from `consult--customize-alist' for CMD."
+ (mapcar (lambda (x) (eval x 'lexical))
+ (alist-get (or cmd this-command) consult--customize-alist)))
-;;;;; Function: consult-completion-in-region
+;;;; Commands
+
+;;;;; Command: consult-completion-in-region
(defun consult--insertion-preview (start end)
"State function for previewing a candidate in a specific region.
-The candidates are previewed in the region from START to END. This function is
+The candidates are previewed in the region from START to END. This function is
used as the `:state' argument for `consult--read' in the `consult-yank' family
of functions and in `consult-completion-in-region'."
(unless (or (minibufferp)
- ;; XXX Disable preview if anything odd is going on with the markers. Otherwise we get
- ;; "Marker points into wrong buffer errors". See
- ;; https://github.com/minad/consult/issues/375, where Org mode source blocks are
- ;; completed in a different buffer than the original buffer. This completion is
- ;; probably also problematic in my Corfu completion package.
+ ;; XXX Disable preview if anything odd is going on with the
+ ;; markers. Otherwise we get "Marker points into wrong buffer
+ ;; errors". See gh:minad/consult#375, where Org mode source
+ ;; blocks are completed in a different buffer than the original
+ ;; buffer. This completion is probably also problematic in my
+ ;; Corfu completion package.
(not (eq (window-buffer) (current-buffer)))
(and (markerp start) (not (eq (marker-buffer start) (current-buffer))))
(and (markerp end) (not (eq (marker-buffer end) (current-buffer)))))
@@ -2645,15 +2862,15 @@ of functions and in `consult-completion-in-region'."
(delete-overlay ov)
(setq ov nil))
((and (eq action 'preview) cand)
- (unless ov
- (setq ov (consult--overlay start end
- 'invisible t
- 'window (selected-window))))
- ;; Use `add-face-text-property' on a copy of "cand in order to merge face properties
- (setq cand (copy-sequence cand))
- (add-face-text-property 0 (length cand) 'consult-preview-insertion t cand)
- ;; Use the `before-string' property since the overlay might be empty.
- (overlay-put ov 'before-string cand)))))))
+ (unless ov
+ (setq ov (consult--overlay start end
+ 'invisible t
+ 'window (selected-window))))
+ ;; Use `add-face-text-property' on a copy of "cand in order to merge face properties
+ (setq cand (copy-sequence cand))
+ (add-face-text-property 0 (length cand) 'consult-preview-insertion t cand)
+ ;; Use the `before-string' property since the overlay might be empty.
+ (overlay-put ov 'before-string cand)))))))
;;;###autoload
(defun consult-completion-in-region (start end collection &optional predicate)
@@ -2661,7 +2878,7 @@ of functions and in `consult-completion-in-region'."
The function is called with 4 arguments: START END COLLECTION PREDICATE.
The arguments and expected return value are as specified for
-`completion-in-region'. Use as a value for `completion-in-region-function'.
+`completion-in-region'. Use as a value for `completion-in-region-function'.
The function can be configured via `consult-customize'.
@@ -2678,7 +2895,7 @@ These configuration options are supported:
(barf-if-buffer-read-only)
(cl-letf* ((config (consult--customize-get #'consult-completion-in-region))
;; Overwrite both the local and global value of `completion-styles', such that the
- ;; `completing-read' minibuffer sees the overwritten value in any case. This is
+ ;; `completing-read' minibuffer sees the overwritten value in any case. This is
;; necessary if `completion-styles' is buffer-local.
;; NOTE: The completion-styles will be overwritten for recursive editing sessions!
(cs (or (plist-get config :completion-styles) completion-styles))
@@ -2733,7 +2950,8 @@ These configuration options are supported:
((file-name-absolute-p initial)
(lambda (_narrow _inp cand)
(substitute-in-file-name cand)))
- ;; Ensure that ./ prefix is kept for the shell (#356)
+ ;; Ensure that ./ prefix is kept for the shell
+ ;; (gh:minad/consult#356).
((string-match-p "\\`\\.\\.?/" initial)
(lambda (_narrow _inp cand)
(setq cand (file-relative-name (substitute-in-file-name cand)))
@@ -2760,7 +2978,7 @@ These configuration options are supported:
;; Evaluate completion table in the original buffer.
;; This is a reasonable thing to do and required by
;; some completion tables in particular by lsp-mode.
- ;; See https://github.com/minad/vertico/issues/61.
+ ;; See gh:minad/vertico#61.
(completing-read prompt
(consult--completion-table-in-buffer collection)
predicate require-match initial)))))))))
@@ -2771,29 +2989,13 @@ These configuration options are supported:
(when exit-fun
(funcall exit-fun completion
;; If completion is finished and cannot be further completed,
- ;; return 'finished. Otherwise return 'exact.
+ ;; return 'finished. Otherwise return 'exact.
(if (eq (try-completion completion collection predicate) t)
'finished 'exact)))
t)
(message "No completion")
nil)))))
-;;;; Commands
-
-;;;;; Command: consult-multi-occur
-
-;;;###autoload
-(defun consult-multi-occur (bufs regexp &optional nlines)
- "Improved version of `multi-occur' based on `completing-read-multiple'.
-
-See `multi-occur' for the meaning of the arguments BUFS, REGEXP and NLINES."
- (interactive (cons
- (mapcar #'get-buffer
- (completing-read-multiple "Buffer: "
- #'internal-complete-buffer))
- (occur-read-primary-args)))
- (occur-1 regexp nlines bufs))
-
;;;;; Command: consult-outline
(defun consult--outline-candidates ()
@@ -2809,21 +3011,21 @@ See `multi-occur' for the meaning of the arguments BUFS, REGEXP and NLINES."
(lambda () ;; as in the default from outline.el
(or (cdr (assoc (match-string 0) heading-alist))
(- (match-end 0) (match-beginning 0))))))
- (inhibit-field-text-motion t)
(buffer (current-buffer))
- (candidates))
+ candidates)
(save-excursion
(goto-char (point-min))
- (while (save-excursion (re-search-forward heading-regexp nil t))
- (setq line (+ line (consult--count-lines (match-beginning 0))))
+ (while (save-excursion
+ (if-let (fun (bound-and-true-p outline-search-function))
+ (funcall fun)
+ (re-search-forward heading-regexp nil t)))
+ (cl-incf line (consult--count-lines (match-beginning 0)))
(push (consult--location-candidate
- (consult--buffer-substring (line-beginning-position)
- (line-end-position)
- 'fontify)
- (cons buffer (point)) line
+ (consult--buffer-substring (pos-bol) (pos-eol) 'fontify)
+ (cons buffer (point)) (1- line) (1- line)
'consult--outline-level (funcall level-fun))
candidates)
- (unless (eobp) (forward-char 1))))
+ (goto-char (1+ (pos-eol)))))
(unless candidates
(user-error "No headings"))
(nreverse candidates)))
@@ -2835,7 +3037,9 @@ See `multi-occur' for the meaning of the arguments BUFS, REGEXP and NLINES."
This command supports narrowing to a heading level and candidate preview.
The symbol at point is added to the future history."
(interactive)
- (let* ((candidates (consult--outline-candidates))
+ (let* ((candidates (consult--slow-operation
+ "Collecting headings..."
+ (consult--outline-candidates)))
(min-level (- (apply #'min (mapcar
(lambda (cand)
(get-text-property 0 'consult--outline-level cand))
@@ -2873,12 +3077,14 @@ The symbol at point is added to the future history."
(when (and (eq buf current-buf)
(consult--in-range-p pos))
(goto-char pos)
- ;; `line-number-at-pos' is a very slow function, which should be replaced everywhere.
- ;; However in this case the slow line-number-at-pos does not hurt much, since
- ;; the mark ring is usually small since it is limited by `mark-ring-max'.
+ ;; `line-number-at-pos' is a very slow function, which should be
+ ;; replaced everywhere. However in this case the slow
+ ;; line-number-at-pos does not hurt much, since the mark ring is
+ ;; usually small since it is limited by `mark-ring-max'.
(push (consult--location-candidate
(consult--line-with-cursor marker) marker
- (line-number-at-pos pos consult-line-numbers-widen))
+ (line-number-at-pos pos consult-line-numbers-widen)
+ marker)
candidates)))))
(unless candidates
(user-error "No marks"))
@@ -2921,9 +3127,10 @@ The symbol at point is added to the future history."
;; `line-number-at-pos' is slow, see comment in `consult--mark-candidates'.
(let ((line (line-number-at-pos pos consult-line-numbers-widen)))
(push (concat
- (propertize (consult--format-location (buffer-name buf) line "")
- 'consult-location (cons marker line)
- 'consult-strip t)
+ (propertize
+ (consult--format-file-line-match (buffer-name buf) line "")
+ 'consult-location (cons marker line)
+ 'consult-strip t)
(consult--line-with-cursor marker)
(consult--tofu-encode marker))
candidates))))))))
@@ -2961,128 +3168,182 @@ Start from top if TOP non-nil.
CURR-LINE is the current line number."
(consult--forbid-minibuffer)
(consult--fontify-all)
- (let* (default-cand candidates
- (buffer (current-buffer))
- (line (line-number-at-pos (point-min) consult-line-numbers-widen)))
+ (let* ((buffer (current-buffer))
+ (line (line-number-at-pos (point-min) consult-line-numbers-widen))
+ default-cand candidates)
(consult--each-line beg end
- (let ((str (consult--buffer-substring beg end)))
- (unless (string-blank-p str)
- (push (consult--location-candidate str (cons buffer (point)) line) candidates)
- (when (and (not default-cand) (>= line curr-line))
- (setq default-cand candidates)))
- (setq line (1+ line))))
- (when candidates
- (nreverse
- (if (or top (not default-cand))
- candidates
- (let ((before (cdr default-cand)))
- (setcdr default-cand nil)
- (nconc before candidates)))))))
+ (unless (looking-at-p "^\\s-*$")
+ (push (consult--location-candidate
+ (consult--buffer-substring beg end)
+ (cons buffer beg) line line)
+ candidates)
+ (when (and (not default-cand) (>= line curr-line))
+ (setq default-cand candidates)))
+ (cl-incf line))
+ (unless candidates
+ (user-error "No lines"))
+ (nreverse
+ (if (or top (not default-cand))
+ candidates
+ (let ((before (cdr default-cand)))
+ (setcdr default-cand nil)
+ (nconc before candidates))))))
+
+(defun consult--line-point-placement (selected candidates highlighted &rest ignored-faces)
+ "Find point position on matching line.
+SELECTED is the currently selected candidate.
+CANDIDATES is the list of candidates.
+HIGHLIGHTED is the highlighted string to determine the match position.
+IGNORED-FACES are ignored when determining the match position."
+ (when-let (pos (consult--lookup-location selected candidates))
+ (if highlighted
+ (let* ((matches (apply #'consult--point-placement highlighted 0 ignored-faces))
+ (dest (+ pos (car matches))))
+ ;; Only create a new marker when jumping across buffers (for example
+ ;; `consult-line-multi'). Avoid creating unnecessary markers, when
+ ;; scrolling through candidates, since creating markers is not free.
+ (when (and (markerp pos) (not (eq (marker-buffer pos) (current-buffer))))
+ (setq dest (move-marker (make-marker) dest (marker-buffer pos))))
+ (cons dest (cdr matches)))
+ pos)))
(defun consult--line-match (selected candidates input &rest _)
"Lookup position of match.
-
SELECTED is the currently selected candidate.
CANDIDATES is the list of candidates.
INPUT is the input string entered by the user."
- (when-let (pos (consult--lookup-location selected candidates))
- (if (string-blank-p input)
- pos
- (let* ((highlighted (consult--completion-filter
- input
- (list (substring-no-properties selected))
- 'consult-location 'highlight))
- (matches (and highlighted
- ;; Ignore `completions-first-difference' when
- ;; matching, since this face doesn't yield a
- ;; meaningful jump position.
- (consult--point-placement (car highlighted) 0
- 'completions-first-difference))))
- ;; Marker can be dead, therefore ignore errors. Create a new marker
- ;; instead of an integer, since the location may be in another buffer,
- ;; e.g., for `consult-line-multi'.
- (ignore-errors
- (let ((dest (+ pos (car matches))))
- ;; Only create a new marker when jumping across buffers, to avoid
- ;; creating unnecessary markers, when scrolling through candidates.
- ;; Creating markers is not free.
- (when (and (markerp pos)
- (not (eq (marker-buffer pos)
- (window-buffer (or (minibuffer-selected-window) (next-window))))))
- (setq dest (move-marker (make-marker) dest (marker-buffer pos))))
- (cons dest (cdr matches))))))))
-
-(cl-defun consult--line (candidates &key curr-line prompt initial group)
- "Select from from line CANDIDATES and jump to the match.
-CURR-LINE is the current line. See `consult--read' for the arguments PROMPT,
-INITIAL and GROUP."
- (consult--read
- candidates
- :prompt prompt
- :annotate (consult--line-prefix curr-line)
- :group group
- :category 'consult-location
- :sort nil
- :require-match t
- ;; 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
- :initial (or initial
- (and isearch-mode
- (prog1 isearch-string (isearch-done))))
- :state (consult--location-state candidates)))
+ (consult--line-point-placement selected candidates
+ (and (not (string-blank-p input))
+ (car (consult--completion-filter
+ input
+ (list (substring-no-properties selected))
+ 'consult-location 'highlight)))
+ 'completions-first-difference))
;;;###autoload
(defun consult-line (&optional initial start)
"Search for a matching line.
-Depending on the setting `consult-point-placement' the command jumps to the
-beginning or the end of the first match on the line or the line beginning. The
-default candidate is the non-empty line next to point. This command obeys
-narrowing. Optional INITIAL input can be provided. The search starting point is
-changed if the START prefix argument is set. The symbol at point and the last
-`isearch-string' is added to the future history."
+Depending on the setting `consult-point-placement' the command
+jumps to the beginning or the end of the first match on the line
+or the line beginning. The default candidate is the non-empty
+line next to point. This command obeys narrowing. Optional
+INITIAL input can be provided. The search starting point is
+changed if the START prefix argument is set. The symbol at point
+and the last `isearch-string' is added to the future history."
(interactive (list nil (not (not current-prefix-arg))))
- (let ((curr-line (line-number-at-pos (point) consult-line-numbers-widen))
- (top (not (eq start consult-line-start-from-top))))
- (consult--line
- (or (consult--with-increased-gc
- (consult--line-candidates top curr-line))
- (user-error "No lines"))
- :curr-line (and (not top) curr-line)
+ (let* ((curr-line (line-number-at-pos (point) consult-line-numbers-widen))
+ (top (not (eq start consult-line-start-from-top)))
+ (candidates (consult--slow-operation "Collecting lines..."
+ (consult--line-candidates top curr-line))))
+ (consult--read
+ candidates
:prompt (if top "Go to line from top: " "Go to line: ")
- :initial initial)))
+ :annotate (consult--line-prefix curr-line)
+ :category 'consult-location
+ :sort nil
+ :require-match t
+ ;; 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
+ :initial (or initial
+ (and isearch-mode
+ (prog1 isearch-string (isearch-done))))
+ :state (consult--location-state candidates))))
;;;;; Command: consult-line-multi
-(defun consult--line-multi-candidates (buffers)
- "Collect the line candidates from multiple buffers.
+(defun consult--line-multi-match (selected candidates &rest _)
+ "Lookup position of match.
+SELECTED is the currently selected candidate.
+CANDIDATES is the list of candidates."
+ (consult--line-point-placement selected candidates
+ (car (member selected candidates))))
+
+(defun consult--line-multi-group (cand transform)
+ "Group function used by `consult-line-multi'.
+If TRANSFORM non-nil, return transformed CAND, otherwise return title."
+ (if transform cand
+ (let ((marker (car (get-text-property 0 'consult-location cand))))
+ (buffer-name
+ ;; Handle cheap marker
+ (if (consp marker)
+ (car marker)
+ (marker-buffer marker))))))
+
+(defun consult--line-multi-candidates (buffers input)
+ "Collect matching candidates from multiple buffers.
+INPUT is the user input which should be matched.
BUFFERS is the list of buffers."
- (or (apply #'nconc
- (consult--buffer-map buffers
- #'consult--line-candidates 'top most-positive-fixnum))
- (user-error "No lines")))
+ (pcase-let ((`(,regexps . ,hl)
+ (funcall consult--regexp-compiler
+ input 'emacs completion-ignore-case))
+ (candidates nil)
+ (cand-idx 0))
+ (save-match-data
+ (dolist (buf buffers (nreverse candidates))
+ (with-current-buffer buf
+ (save-excursion
+ (let ((line (line-number-at-pos (point-min) consult-line-numbers-widen)))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (save-excursion (re-search-forward (car regexps) nil t)))
+ (cl-incf line (consult--count-lines (match-beginning 0)))
+ (let ((bol (pos-bol))
+ (eol (pos-eol)))
+ (goto-char bol)
+ (when (and (not (looking-at-p "^\\s-*$"))
+ (seq-every-p (lambda (r)
+ (goto-char bol)
+ (re-search-forward r eol t))
+ (cdr regexps)))
+ (push (consult--location-candidate
+ (funcall hl (buffer-substring-no-properties bol eol))
+ (cons buf bol) (1- line) cand-idx)
+ candidates)
+ (cl-incf cand-idx))
+ (goto-char (1+ eol)))))))))))
;;;###autoload
(defun consult-line-multi (query &optional initial)
"Search for a matching line in multiple buffers.
-By default search across all project buffers. If the prefix argument QUERY is
-non-nil, all buffers are searched. Optional INITIAL input can be provided. See
-`consult-line' for more information. In order to search a subset of buffers,
-QUERY can be set to a plist according to `consult--buffer-query'."
+By default search across all project buffers. If the prefix
+argument QUERY is non-nil, all buffers are searched. Optional
+INITIAL input can be provided. The symbol at point and the last
+`isearch-string' is added to the future history.In order to
+search a subset of buffers, QUERY can be set to a plist according
+to `consult--buffer-query'."
(interactive "P")
(unless (keywordp (car-safe query))
- (setq query (list :sort 'alpha :directory (and (not query) 'project))))
- (let ((buffers (consult--buffer-query-prompt "Go to line" query)))
- (consult--line
- (consult--line-multi-candidates (cdr buffers))
- :prompt (car buffers)
- :initial initial
- :group #'consult--line-group)))
+ (setq query (list :sort 'alpha-current :directory (and (not query) 'project))))
+ (pcase-let* ((`(,prompt . ,buffers) (consult--buffer-query-prompt "Go to line" query))
+ (collection (consult--dynamic-collection
+ (apply-partially #'consult--line-multi-candidates
+ buffers))))
+ (consult--read
+ collection
+ :prompt prompt
+ :annotate (consult--line-prefix)
+ :category 'consult-location
+ :sort nil
+ :require-match t
+ ;; 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
+ :initial (consult--async-split-initial
+ (or initial
+ (and isearch-mode
+ (prog1 isearch-string (isearch-done)))))
+ :state (consult--location-state (lambda () (funcall collection nil)))
+ :group #'consult--line-multi-group)))
;;;;; Command: consult-keep-lines
@@ -3108,7 +3369,7 @@ QUERY can be set to a plist according to `consult--buffer-query'."
(setq content-orig (buffer-string)
replace (lambda (content &optional pos)
(delete-region rbeg rend)
- (insert content)
+ (insert-before-markers content)
(goto-char (or pos rbeg))
(setq rend (+ rbeg (length content)))
(add-face-text-property rbeg rend 'region t)))))
@@ -3168,10 +3429,10 @@ QUERY can be set to a plist according to `consult--buffer-query'."
(defun consult-keep-lines (&optional filter initial)
"Select a subset of the lines in the current buffer with live preview.
-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
+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
command obeys narrowing.
FILTER is the filter function.
@@ -3182,20 +3443,22 @@ INITIAL is the initial input."
(consult--completion-filter-dispatch
pattern cands 'consult-location 'highlight))))
(consult--forbid-minibuffer)
- (cl-letf ((ro buffer-read-only)
- ((buffer-local-value 'buffer-read-only (current-buffer)) nil))
- (consult--minibuffer-with-setup-hook
- (lambda ()
- (when ro
- (minibuffer-message
- (substitute-command-keys
- " [Unlocked read-only buffer. \\[minibuffer-keyboard-quit] to quit.]"))))
- (consult--with-increased-gc
- (consult--prompt
- :prompt "Keep lines: "
- :initial initial
- :history 'consult--keep-lines-history
- :state (consult--keep-lines-state filter))))))
+ (let ((ro buffer-read-only))
+ (unwind-protect
+ (consult--minibuffer-with-setup-hook
+ (lambda ()
+ (when ro
+ (minibuffer-message
+ (substitute-command-keys
+ " [Unlocked read-only buffer. \\[minibuffer-keyboard-quit] to quit.]"))))
+ (setq buffer-read-only nil)
+ (consult--with-increased-gc
+ (consult--prompt
+ :prompt "Keep lines: "
+ :initial initial
+ :history 'consult--keep-lines-history
+ :state (consult--keep-lines-state filter))))
+ (setq buffer-read-only ro))))
;;;;; Command: consult-focus-lines
@@ -3282,12 +3545,12 @@ INITIAL is the initial input."
(defun consult-focus-lines (&optional show filter initial)
"Hide or show lines using overlays.
-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
-filtering is performed by a FILTER function. This command obeys narrowing.
+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
+filtering is performed by a FILTER function. This command obeys narrowing.
FILTER is the filter function.
INITIAL is the initial input."
@@ -3332,7 +3595,7 @@ Print an error message with MSG function."
pos
(funcall msg "Line number out of range.")
nil))
- (when (and str (not (string= str "")))
+ (when (and str (not (equal str "")))
(funcall msg "Please enter a number."))
nil))
@@ -3340,7 +3603,7 @@ Print an error message with MSG function."
(defun consult-goto-line (&optional arg)
"Read line number and jump to the line with preview.
-Jump directly if a line number is given as prefix ARG. The command respects
+Jump directly if a line number is given as prefix ARG. The command respects
narrowing and the settings `consult-goto-line-numbers' and
`consult-line-numbers-widen'."
(interactive "P")
@@ -3352,9 +3615,7 @@ narrowing and the settings `consult-goto-line-numbers' and
(while (if-let (pos (consult--goto-line-position
(consult--prompt
:prompt "Go to line: "
- ;; goto-line-history is available on Emacs 28
- :history
- (and (boundp 'goto-line-history) 'goto-line-history)
+ :history 'goto-line-history
:state
(let ((preview (consult--jump-preview)))
(lambda (action str)
@@ -3390,9 +3651,11 @@ narrowing and the settings `consult-goto-line-numbers' and
(interactive)
(find-file
(consult--read
- (or (mapcar #'abbreviate-file-name recentf-list)
- (user-error "No recent files, `recentf-mode' is %s"
- (if recentf-mode "on" "off")))
+ (or
+ (let (file-name-handler-alist) ;; No Tramp slowdown please
+ (mapcar #'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: "
:sort nil
:require-match t
@@ -3400,22 +3663,6 @@ narrowing and the settings `consult-goto-line-numbers' and
:state (consult--file-preview)
:history 'file-name-history)))
-;;;;; Command: consult-file-externally
-
-;;;###autoload
-(defun consult-file-externally (file)
- "Open FILE externally using the default application of the system."
- (interactive "fOpen externally: ")
- (if (and (eq system-type 'windows-nt)
- (fboundp 'w32-shell-execute))
- (w32-shell-execute "open" file)
- (call-process (pcase system-type
- ('darwin "open")
- ('cygwin "cygstart")
- (_ "xdg-open"))
- nil 0 nil
- (expand-file-name file))))
-
;;;;; Command: consult-mode-command
(defun consult--mode-name (mode)
@@ -3525,16 +3772,21 @@ If no MODES are specified, use currently active major and minor modes."
(defun consult--read-from-kill-ring ()
"Open kill ring menu and return selected string."
- ;; `current-kill' updates `kill-ring' with a possible interprogram-paste (#443)
+ ;; `current-kill' updates `kill-ring' with interprogram paste, see
+ ;; gh:minad/consult#443.
(current-kill 0)
;; Do not specify a :lookup function in order to preserve completion-styles
- ;; highlighting of the current candidate. We have to perform a final lookup
- ;; to obtain the original candidate which may be propertized with
- ;; yank-specific properties, like 'yank-handler.
+ ;; highlighting of the current candidate. We have to perform a final lookup to
+ ;; obtain the original candidate which may be propertized with yank-specific
+ ;; properties, like 'yank-handler.
(consult--lookup-member
(consult--read
(consult--remove-dups
- (or kill-ring (user-error "Kill ring is empty")))
+ (or (if consult-yank-rotate
+ (append kill-ring-yank-pointer
+ (butlast kill-ring (length kill-ring-yank-pointer)))
+ kill-ring)
+ (user-error "Kill ring is empty")))
:prompt "Yank from kill-ring: "
:history t ;; disable history
:sort nil
@@ -3554,7 +3806,7 @@ If no MODES are specified, use currently active major and minor modes."
With prefix ARG, put point at beginning, and mark at end, like `yank' does.
This command behaves like `yank-from-kill-ring' in Emacs 28, which also offers
-a `completing-read' interface to the `kill-ring'. Additionally the Consult
+a `completing-read' interface to the `kill-ring'. Additionally the Consult
version supports preview of the selected string."
(interactive (list (consult--read-from-kill-ring) current-prefix-arg))
(when string
@@ -3562,6 +3814,10 @@ version supports preview of the selected string."
(push-mark)
(insert-for-yank string)
(setq this-command 'yank)
+ (when consult-yank-rotate
+ (if-let (pos (seq-position kill-ring string))
+ (setq kill-ring-yank-pointer (nthcdr pos kill-ring))
+ (kill-new string)))
(when (consp arg)
;; Swap point and mark like in `yank'.
(goto-char (prog1 (mark t)
@@ -3579,7 +3835,7 @@ Otherwise select string from the kill ring and insert it.
See `yank-pop' for the meaning of ARG.
This command behaves like `yank-pop' in Emacs 28, which also offers a
-`completing-read' interface to the `kill-ring'. Additionally the Consult
+`completing-read' interface to the `kill-ring'. Additionally the Consult
version supports preview of the selected string."
(interactive "*p")
(if (eq last-command 'yank)
@@ -3624,13 +3880,13 @@ There exists no equivalent of this command in Emacs 28."
(funcall
preview action
;; Only preview bookmarks with the default handler.
- (when-let* ((bm (and cand (eq action 'preview) (assoc cand bookmark-alist)))
- (handler (bookmark-get-handler bm))
- (file (and (or (not handler)
- (eq handler #'bookmark-default-handler))
- (bookmark-get-filename bm)))
- (pos (bookmark-get-position bm))
- (buf (funcall open file)))
+ (when-let ((bm (and cand (eq action 'preview) (assoc cand bookmark-alist)))
+ (handler (bookmark-get-handler bm))
+ (file (and (or (not handler)
+ (eq handler #'bookmark-default-handler))
+ (bookmark-get-filename bm)))
+ (pos (bookmark-get-position bm))
+ (buf (funcall open file)))
(set-marker (make-marker) pos buf))))))
(defun consult--bookmark-action (bm)
@@ -3656,7 +3912,7 @@ There exists no equivalent of this command in Emacs 28."
(defun consult-bookmark (name)
"If bookmark NAME exists, open it, otherwise create a new bookmark with NAME.
-The command supports preview of file bookmarks and narrowing. See the
+The command supports preview of file bookmarks and narrowing. See the
variable `consult-bookmark-narrow' for the narrowing configuration."
(interactive
(list
@@ -3679,28 +3935,6 @@ variable `consult-bookmark-narrow' for the narrowing configuration."
(bookmark-jump name)
(bookmark-set name)))
-;;;;; Command: consult-apropos
-
-;;;###autoload
-(defun consult-apropos ()
- "Select pattern and call `apropos'.
-
-The default value of the completion is the symbol at point. As a better
-alternative, you can run `embark-export' from commands like `M-x' and
-`describe-symbol'."
- (interactive)
- (let ((pattern
- (consult--read
- obarray
- :prompt "Apropos: "
- :predicate (lambda (x) (or (fboundp x) (boundp x) (facep x) (symbol-plist x)))
- :history 'consult--apropos-history
- :category 'symbol
- :default (thing-at-point 'symbol))))
- (when (string= pattern "")
- (user-error "No pattern given"))
- (apropos pattern)))
-
;;;;; Command: consult-complex-command
;;;###autoload
@@ -3731,22 +3965,24 @@ This command can act as a drop-in replacement for `repeat-complex-command'."
(defun consult--current-history ()
"Return the history and index variable relevant to the current buffer.
If the minibuffer is active, the minibuffer history is returned,
-otherwise the history corresponding to the mode. There is a
+otherwise the history corresponding to the mode. There is a
special case for `repeat-complex-command', for which the command
history is used."
(cond
- ;; If pressing "C-x M-:", i.e., `repeat-complex-command',
- ;; we are instead querying the `command-history' and get a full s-expression.
- ;; Alternatively you might want to use `consult-complex-command',
- ;; which can also be bound to "C-x M-:"!
- ((eq last-command 'repeat-complex-command)
- (list (mapcar #'prin1-to-string command-history)))
;; In the minibuffer we use the current minibuffer history,
;; which can be configured by setting `minibuffer-history-variable'.
((minibufferp)
(when (eq minibuffer-history-variable t)
(user-error "Minibuffer history is disabled for `%s'" this-command))
- (list (mapcar #'consult--tofu-hide (symbol-value minibuffer-history-variable))))
+ (list (mapcar #'consult--tofu-hide
+ (if (eq minibuffer-history-variable 'command-history)
+ ;; If pressing "C-x M-:", i.e., `repeat-complex-command',
+ ;; we are instead querying the `command-history' and get a
+ ;; full s-expression. Alternatively you might want to use
+ ;; `consult-complex-command', which can also be bound to
+ ;; "C-x M-:"!
+ (mapcar #'prin1-to-string command-history)
+ (symbol-value minibuffer-history-variable)))))
;; Otherwise we use a mode-specific history, see `consult-mode-histories'.
(t (let ((found (seq-find (lambda (h)
(and (derived-mode-p (car h))
@@ -3755,39 +3991,49 @@ history is used."
(unless found
(user-error "No history configured for `%s', see `consult-mode-histories'"
major-mode))
- (if (consp (cdr found))
- (cons (symbol-value (cadr found)) (caddr found))
- (list (symbol-value (cdr found))))))))
+ (unless (consp (cdr found))
+ (user-error "Obsolete mode history entry: %S" found))
+ (cons (symbol-value (cadr found)) (cddr found))))))
;;;###autoload
-(defun consult-history (&optional history index)
+(defun consult-history (&optional history index bol)
"Insert string from HISTORY of current buffer.
-In order to select from a specific HISTORY, pass the history variable
-as argument. INDEX is the name of the index variable to update, if any.
-See also `cape-history' from the Cape package."
+In order to select from a specific HISTORY, pass the history
+variable as argument. INDEX is the name of the index variable to
+update, if any. BOL is the function which jumps to the beginning
+of the prompt. See also `cape-history' from the Cape package."
(interactive)
- (let* ((pair (if history (cons history index) (consult--current-history)))
- (history (if (ring-p (car pair)) (ring-elements (car pair)) (car pair)))
- (index (cdr pair))
- (str (consult--local-let ((enable-recursive-minibuffers t))
- (consult--read
- (or (consult--remove-dups history)
- (user-error "History is empty"))
- :prompt "History: "
- :history t ;; disable history
- :category ;; Report category depending on history variable
- (and (minibufferp)
- (pcase minibuffer-history-variable
- ('extended-command-history 'command)
- ('buffer-name-history 'buffer)
- ('face-name-history 'face)
- ('read-envvar-name-history 'environment-variable)
- ('bookmark-history 'bookmark)
- ('file-name-history 'file)))
- :sort nil
- :state (consult--insertion-preview (point) (point))))))
- (when (minibufferp)
- (delete-minibuffer-contents))
+ (pcase-let* ((`(,history ,index ,bol) (if history
+ (list history index bol)
+ (consult--current-history)))
+ (history (if (ring-p history) (ring-elements history) history))
+ (`(,beg . ,end)
+ (if (minibufferp)
+ (cons (minibuffer-prompt-end) (point-max))
+ (if bol
+ (save-excursion
+ (funcall bol)
+ (cons (point) (pos-eol)))
+ (cons (point) (point)))))
+ (str (consult--local-let ((enable-recursive-minibuffers t))
+ (consult--read
+ (or (consult--remove-dups history)
+ (user-error "History is empty"))
+ :prompt "History: "
+ :history t ;; disable history
+ :category ;; Report category depending on history variable
+ (and (minibufferp)
+ (pcase minibuffer-history-variable
+ ('extended-command-history 'command)
+ ('buffer-name-history 'buffer)
+ ('face-name-history 'face)
+ ('read-envvar-name-history 'environment-variable)
+ ('bookmark-history 'bookmark)
+ ('file-name-history 'file)))
+ :sort nil
+ :initial (buffer-substring-no-properties beg end)
+ :state (consult--insertion-preview beg end)))))
+ (delete-region beg end)
(when index
(set index (seq-position history str)))
(insert (substring-no-properties str))))
@@ -3810,12 +4056,10 @@ See also `cape-history' from the Cape package."
(put #'consult-isearch-backward 'completion-predicate #'ignore)
(put #'consult-isearch-forward 'completion-predicate #'ignore)
-(defvar consult-isearch-history-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap isearch-forward] #'consult-isearch-forward)
- (define-key map [remap isearch-backward] #'consult-isearch-backward)
- map)
- "Additional keymap used by `consult-isearch-history'.")
+(defvar-keymap consult-isearch-history-map
+ :doc "Additional keymap used by `consult-isearch-history'."
+ "<remap> <isearch-forward>" #'consult-isearch-forward
+ "<remap> <isearch-backward>" #'consult-isearch-backward)
(defun consult--isearch-history-candidates ()
"Return isearch history candidates."
@@ -3839,7 +4083,7 @@ See also `cape-history' from the Cape package."
('isearch-symbol-regexp ?s)
('char-fold-to-regexp ?c)
(_ ?u))))
- ;; Disambiguate history items. The same string could
+ ;; Disambiguate history items. The same string could
;; occur with different search types.
(consult--tofu-append cand type)))
history))
@@ -4012,7 +4256,7 @@ The command supports previewing the currently selected theme."
;;;;; Command: consult-buffer
(defun consult--buffer-sort-alpha (buffers)
- "Sort BUFFERS alphabetically, but push down starred buffers."
+ "Sort BUFFERS alphabetically, put starred buffers at the end."
(sort buffers
(lambda (x y)
(setq x (buffer-name x) y (buffer-name y))
@@ -4022,6 +4266,14 @@ The command supports previewing the currently selected theme."
(string< x y)
(not a))))))
+(defun consult--buffer-sort-alpha-current (buffers)
+ "Sort BUFFERS alphabetically, put current at the beginning."
+ (let ((buffers (consult--buffer-sort-alpha buffers))
+ (current (current-buffer)))
+ (if (memq current buffers)
+ (cons current (delq current buffers))
+ buffers)))
+
(defun consult--buffer-sort-visibility (buffers)
"Sort BUFFERS by visibility."
(let ((hidden)
@@ -4038,8 +4290,8 @@ The command supports previewing the currently selected theme."
"Normalize directory DIR.
DIR can be project, nil or a path."
(cond
- ((eq dir 'project) (consult--project-root))
- (dir (expand-file-name dir))))
+ ((eq dir 'project) (consult--project-root))
+ (dir (expand-file-name dir))))
(defun consult--buffer-query-prompt (prompt query)
"Buffer query function returning a scope description.
@@ -4069,7 +4321,7 @@ INCLUDE is a list of regexps.
MODE can be a mode or a list of modes to restrict the returned buffers.
PREDICATE is a predicate function.
AS is a conversion function."
- ;; This function is the backbone of most `consult-buffer' source. The
+ ;; This function is the backbone of most `consult-buffer' source. The
;; function supports filtering by various criteria which are used throughout
;; Consult.
(let ((root (consult--normalize-directory directory))
@@ -4104,21 +4356,6 @@ AS is a conversion function."
(if as (funcall as it) it)))))
buffers))
-(defun consult--buffer-map (buffer &rest app)
- "Run function application APP for each BUFFER.
-Report progress and return a list of the results"
- (consult--with-increased-gc
- (let* ((count (length buffer))
- (reporter (make-progress-reporter "Collecting" 0 count)))
- (prog1
- (seq-map-indexed (lambda (buf idx)
- (with-current-buffer buf
- (prog1 (apply app)
- (progress-reporter-update
- reporter (1+ idx) (buffer-name)))))
- buffer)
- (progress-reporter-done reporter)))))
-
(defun consult--buffer-file-hash ()
"Return hash table of all buffer file names."
(consult--string-hash (consult--buffer-query :as #'buffer-file-name)))
@@ -4195,17 +4432,19 @@ If NORECORD is non-nil, do not record the buffer switch in the buffer list."
,(lambda ()
(when-let (root (consult--project-root))
(let ((len (length root))
- (ht (consult--buffer-file-hash)))
- (mapcar (lambda (file)
- (let ((part (substring file len)))
- (when (equal part "") (setq part "./"))
- (put-text-property 0 (length part)
- 'multi-category `(file . ,file) part)
- part))
- (seq-filter (lambda (x)
- (and (not (gethash x ht))
- (string-prefix-p root x)))
- recentf-list))))))
+ (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))))))))
"Project file candidate source for `consult-buffer'.")
(defvar consult--source-hidden-buffer
@@ -4252,6 +4491,20 @@ If NORECORD is non-nil, do not record the buffer switch in the buffer list."
:as #'buffer-name)))
"Buffer candidate source for `consult-buffer'.")
+(defun consult--file-register-p (reg)
+ "Return non-nil if REG is a file register."
+ (memq (car-safe (cdr reg)) '(file-query file)))
+
+(autoload 'consult-register--candidates "consult-register")
+(defvar consult--source-file-register
+ `(:name "File Register"
+ :narrow (?r . "Register")
+ :category file
+ :state ,#'consult--file-state
+ :enabled ,(lambda () (seq-some #'consult--file-register-p register-alist))
+ :items ,(lambda () (consult-register--candidates #'consult--file-register-p)))
+ "File register source.")
+
(defvar consult--source-recent-file
`(:name "File"
:narrow ?f
@@ -4263,9 +4516,16 @@ If NORECORD is non-nil, do not record the buffer switch in the buffer list."
:enabled ,(lambda () recentf-mode)
:items
,(lambda ()
- (let ((ht (consult--buffer-file-hash)))
- (mapcar #'abbreviate-file-name
- (seq-remove (lambda (x) (gethash x ht)) recentf-list)))))
+ (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'.
+ (unless (eq (aref file 0) ?/)
+ (setq file (expand-file-name file)))
+ (unless (gethash file ht)
+ (push (abbreviate-file-name file) items))))))
"Recent file candidate source for `consult-buffer'.")
;;;###autoload
@@ -4273,11 +4533,11 @@ If NORECORD is non-nil, do not record the buffer switch in the buffer list."
"Enhanced `switch-to-buffer' command with support for virtual buffers.
The command supports recent files, bookmarks, views and project files as
-virtual buffers. Buffers are previewed. Narrowing to buffers (b), files (f),
+virtual buffers. Buffers are previewed. Narrowing to buffers (b), files (f),
bookmarks (m) and project files (p) is supported via the corresponding
-keys. In order to determine the project-specific files and buffers, the
-`consult-project-function' is used. The virtual buffer SOURCES
-default to `consult-buffer-sources'. See `consult--multi' for the
+keys. In order to determine the project-specific files and buffers, the
+`consult-project-function' is used. The virtual buffer SOURCES
+default to `consult-buffer-sources'. See `consult--multi' for the
configuration of the virtual buffer sources."
(interactive)
(let ((selected (consult--multi (or sources consult-buffer-sources)
@@ -4299,9 +4559,9 @@ configuration of the virtual buffer sources."
(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 overriden 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
+ ;; 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?
;; You mustn't be afraid to dream a little bigger, darling.
`(let ((consult-project-function
@@ -4318,10 +4578,10 @@ configuration of the virtual buffer sources."
(defun consult-project-buffer ()
"Enhanced `project-switch-to-buffer' command with support for virtual buffers.
The command may prompt you for a project directory if it is invoked from
-outside a project. See `consult-buffer' for more details."
+outside a project. See `consult-buffer' for more details."
(interactive)
(consult--with-project
- (consult-buffer consult-project-buffer-sources)))
+ (consult-buffer consult-project-buffer-sources)))
;;;###autoload
(defun consult-buffer-other-window ()
@@ -4337,108 +4597,50 @@ outside a project. See `consult-buffer' for more details."
(let ((consult--buffer-display #'switch-to-buffer-other-frame))
(consult-buffer)))
-;;;;; Command: consult-kmacro
-
-(defun consult--kmacro-candidates ()
- "Return alist of kmacros and indices."
- (thread-last
- ;; List of macros
- (append (when last-kbd-macro
- `((,last-kbd-macro ,kmacro-counter ,kmacro-counter-format)))
- kmacro-ring)
- ;; Add indices
- (seq-map-indexed #'cons)
- ;; Filter mouse clicks
- (seq-remove (lambda (x) (seq-some #'mouse-event-p (caar x))))
- ;; Format macros
- (mapcar (pcase-lambda (`((,keys ,counter ,format) . ,index))
- (propertize
- (format-kbd-macro keys 1)
- 'consult--candidate index
- 'consult--kmacro-annotation
- ;; If the counter is 0 and the counter format is its default,
- ;; then there is a good chance that the counter isn't actually
- ;; being used. This can only be wrong when a user
- ;; intentionally starts the counter with a negative value and
- ;; then increments it to 0.
- (cond
- ((not (string= format "%d")) ;; show counter for non-default format
- (format " (counter=%d, format=%s) " counter format))
- ((/= counter 0) ;; show counter if non-zero
- (format " (counter=%d)" counter))))))
- (delete-dups)))
-
-;;;###autoload
-(defun consult-kmacro (arg)
- "Run a chosen keyboard macro.
-
-With prefix ARG, run the macro that many times.
-Macros containing mouse clicks are omitted."
- (interactive "p")
- (let ((selected (consult--read
- (or (consult--kmacro-candidates)
- (user-error "No keyboard macros defined"))
- :prompt "Keyboard macro: "
- :category 'consult-kmacro
- :require-match t
- :sort nil
- :history 'consult--kmacro-history
- :annotate
- (lambda (cand)
- (get-text-property 0 'consult--kmacro-annotation cand))
- :lookup #'consult--lookup-candidate)))
- (if (= 0 selected)
- ;; If the first element has been selected, just run the last macro.
- (kmacro-call-macro (or arg 1) t nil)
- ;; Otherwise, run a kmacro from the ring.
- (let* ((selected (1- selected))
- (kmacro (nth selected kmacro-ring))
- ;; Temporarily change the variables to retrieve the correct
- ;; settings. Mainly, we want the macro counter to persist, which
- ;; automatically happens when cycling the ring.
- (last-kbd-macro (car kmacro))
- (kmacro-counter (cadr kmacro))
- (kmacro-counter-format (caddr kmacro)))
- (kmacro-call-macro (or arg 1) t)
- ;; Once done, put updated variables back into the ring.
- (setf (nth selected kmacro-ring)
- (list last-kbd-macro
- kmacro-counter
- kmacro-counter-format))))))
-
;;;;; Command: consult-grep
(defun consult--grep-format (async builder)
"Return ASYNC function highlighting grep match results.
-BUILDER is the command argument builder."
- (let ((highlight))
+BUILDER is the command line builder function."
+ (let (highlight)
(lambda (action)
(cond
((stringp action)
- (setq highlight (plist-get (funcall builder action) :highlight))
+ (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))))
(funcall async action))
((consp action)
- (let (result)
+ (let ((file "") (file-len 0) result)
(save-match-data
(dolist (str action)
(when (and (string-match consult--grep-match-regexp str)
;; Filter out empty context lines
(or (/= (aref str (match-beginning 3)) ?-)
(/= (match-end 0) (length str))))
- (let* ((file (match-string 1 str))
- (line (match-string 2 str))
+ ;; We share the file name across candidates to reduce
+ ;; the amount of allocated memory.
+ (unless (and (= file-len (- (match-end 1) (match-beginning 1)))
+ (eq t (compare-strings
+ file 0 file-len
+ str (match-beginning 1) (match-end 1) nil)))
+ (setq file (match-string 1 str)
+ file-len (length file)))
+ (let* ((line (match-string 2 str))
(ctx (= (aref str (match-beginning 3)) ?-))
(sep (if ctx "-" ":"))
(content (substring str (match-end 0)))
- (file-len (length file))
(line-len (length line)))
(when (length> content consult-grep-max-columns)
(setq content (substring content 0 consult-grep-max-columns)))
(when highlight
(funcall highlight content))
(setq str (concat file sep line sep content))
- ;; Store file name in order to avoid allocations in `consult--grep-group'
- (add-text-properties 0 file-len `(face consult-file consult--grep-file ,file) str)
+ ;; Store file name in order to avoid allocations in `consult--prefix-group'
+ (add-text-properties 0 file-len `(face consult-file consult--prefix-group ,file) str)
(put-text-property (1+ file-len) (+ 1 file-len line-len) 'face 'consult-line-number str)
(when ctx
(add-face-text-property (+ 2 file-len line-len) (length str) 'consult-grep-context 'append str))
@@ -4455,7 +4657,7 @@ FIND-FILE is the file open function, defaulting to `find-file'."
(matches (consult--point-placement cand (1+ line-end) 'consult-grep-context))
(file (substring-no-properties cand 0 file-end))
(line (string-to-number (substring-no-properties cand (+ 1 file-end) line-end))))
- (when-let (pos (consult--position-marker
+ (when-let (pos (consult--marker-from-line-column
(funcall (or find-file #'find-file) file)
line (or (car matches) 0)))
(cons pos (cdr matches))))))
@@ -4471,12 +4673,6 @@ FIND-FILE is the file open function, defaulting to `find-file'."
cand
(and (not (eq action 'return)) open))))))
-(defun consult--grep-group (cand transform)
- "Return title for CAND or TRANSFORM the candidate."
- (if transform
- (substring cand (1+ (length (get-text-property 0 'consult--grep-file cand))))
- (get-text-property 0 'consult--grep-file cand)))
-
(defun consult--grep-exclude-args ()
"Produce grep exclude arguments.
Take the variables `grep-find-ignored-directories' and
@@ -4490,7 +4686,7 @@ Take the variables `grep-find-ignored-directories' and
(defun consult--grep (prompt builder dir initial)
"Run grep in DIR.
-BUILDER is the command builder.
+BUILDER is the command line builder function.
PROMPT is the prompt string.
INITIAL is inital input."
(let* ((prompt-dir (consult--directory-prompt prompt dir))
@@ -4506,7 +4702,7 @@ INITIAL is inital input."
:add-history (consult--async-split-thingatpt 'symbol)
:require-match t
:category 'consult-grep
- :group #'consult--grep-group
+ :group #'consult--prefix-group
:history '(:input consult--grep-history)
:sort nil)))
@@ -4517,30 +4713,25 @@ INITIAL is inital input."
(eq 0 (apply #'call-process-region (point-min) (point-max)
(car cmd) nil nil nil `(,@(cdr cmd) "^(?=.*b)(?=.*a)")))))
-(defvar consult--grep-regexp-type nil)
-
-(defun consult--grep-builder (input)
- "Build command line given INPUT."
- (unless (boundp 'grep-find-ignored-files) (require 'grep))
- (pcase-let* ((cmd (consult--build-args consult-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))
- `(:command (,@cmd "-e" ,arg ,@opts) :highlight
- ,(apply-partially #'consult--highlight-regexps
- (list (regexp-quote arg)) ignore-case))
- (pcase-let* ((type (or consult--grep-regexp-type
- (setq consult--grep-regexp-type
- (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended))))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg type ignore-case)))
- (when re
- `(:command
- (,@cmd
- ,(if (eq type 'pcre) "-P" "-E") ;; perl or extended
- "-e" ,(consult--join-regexps re type)
- ,@opts)
- :highlight ,hl))))))
+(defun consult--grep-make-builder ()
+ "Create grep command line builder."
+ (let* ((cmd (consult--build-args consult-grep-args))
+ (type (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended)))
+ (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)
+ (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
+ (list (if (eq type 'pcre) "-P" "-E") ;; perl or extended
+ "-e" (consult--join-regexps re type))
+ opts)
+ hl))))))))
;;;###autoload
(defun consult-grep (&optional dir initial)
@@ -4553,17 +4744,17 @@ 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
+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
+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.
@@ -4575,13 +4766,13 @@ 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'
+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
+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."
(interactive "P")
- (consult--grep "Grep" #'consult--grep-builder dir initial))
+ (consult--grep "Grep" (consult--grep-make-builder) dir initial))
;;;;; Command: consult-git-grep
@@ -4592,59 +4783,54 @@ Otherwise the `default-directory' is searched."
(flags (append cmd opts))
(ignore-case (or (member "-i" flags) (member "--ignore-case" flags))))
(if (or (member "-F" flags) (member "--fixed-strings" flags))
- `(:command (,@cmd "-e" ,arg ,@opts) :highlight
- ,(apply-partially #'consult--highlight-regexps
- (list (regexp-quote arg)) ignore-case))
+ (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
- `(:command
- (,@cmd ,@(cdr (mapcan (lambda (x) (list "--and" "-e" x)) re)) ,@opts)
- :highlight ,hl))))))
+ (cons (append cmd (cdr (mapcan (lambda (x) (list "--and" "-e" x)) re)) opts)
+ 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'
+The initial input is given by the INITIAL argument. See `consult-grep'
for more details."
(interactive "P")
(consult--grep "Git-grep" #'consult--git-grep-builder dir initial))
;;;;; Command: consult-ripgrep
-(defvar consult--ripgrep-regexp-type nil)
-
-(defun consult--ripgrep-builder (input)
- "Build command line given INPUT."
- (pcase-let* ((cmd (consult--build-args consult-ripgrep-args))
- (`(,arg . ,opts) (consult--command-split input))
- (flags (append cmd opts))
- (ignore-case (if (or (member "-S" flags) (member "--smart-case" flags))
- (let (case-fold-search)
- ;; Case insensitive if there are no uppercase letters
- (not (string-match-p "[[:upper:]]" arg)))
- (or (member "-i" flags) (member "--ignore-case" flags)))))
- (if (or (member "-F" flags) (member "--fixed-strings" flags))
- `(:command (,@cmd "-e" ,arg ,@opts) :highlight
- ,(apply-partially #'consult--highlight-regexps
- (list (regexp-quote arg)) ignore-case))
- (pcase-let* ((type (or consult--ripgrep-regexp-type
- (setq consult--ripgrep-regexp-type
- (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended))))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg type ignore-case)))
- (when re
- `(:command
- (,@cmd ,@(and (eq type 'pcre) '("-P"))
- "-e" ,(consult--join-regexps re type)
- ,@opts)
- :highlight ,hl))))))
+(defun consult--ripgrep-make-builder ()
+ "Create ripgrep command line builder."
+ (let* ((cmd (consult--build-args consult-ripgrep-args))
+ (type (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended)))
+ (lambda (input)
+ (pcase-let* ((`(,arg . ,opts) (consult--command-split input))
+ (flags (append cmd opts))
+ (ignore-case (if (or (member "-S" flags) (member "--smart-case" flags))
+ (let (case-fold-search)
+ ;; Case insensitive if there are no uppercase letters
+ (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)
+ (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)
+ 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'
+The initial input is given by the INITIAL argument. See `consult-grep'
for more details."
(interactive "P")
- (consult--grep "Ripgrep" #'consult--ripgrep-builder dir initial))
+ (consult--grep "Ripgrep" (consult--ripgrep-make-builder) dir initial))
;;;;; Command: consult-find
@@ -4654,7 +4840,7 @@ for more details."
The function returns the selected file.
The filename at point is added to the future history.
-BUILDER is the command builder.
+BUILDER is the command line builder function.
PROMPT is the prompt.
INITIAL is inital input."
(consult--read
@@ -4670,33 +4856,29 @@ INITIAL is inital input."
:category 'file
:history '(:input consult--find-history)))
-(defvar consult--find-regexp-type nil)
-
-(defun consult--find-builder (input)
- "Build command line given INPUT."
- (pcase-let* ((cmd (consult--build-args consult-find-args))
- (type (or consult--find-regexp-type
- (setq consult--find-regexp-type
- (if (eq 0 (call-process-shell-command
- (concat (car cmd) " -regextype emacs -version")))
- 'emacs 'basic))))
- (`(,arg . ,opts) (consult--command-split input))
- ;; ignore-case=t since -iregex is used below
- (`(,re . ,hl) (funcall consult--regexp-compiler arg type t)))
- (when re
- (list :command
- (append cmd
- (cdr (mapcan
- (lambda (x)
- `("-and" "-iregex"
- ,(format ".*%s.*"
- ;; HACK Replace non-capturing groups with capturing groups.
- ;; GNU find does not support non-capturing groups.
- (replace-regexp-in-string
- "\\\\(\\?:" "\\(" x 'fixedcase 'literal))))
- re))
- opts)
- :highlight hl))))
+(defun consult--find-make-builder ()
+ "Create find command line builder."
+ (let* ((cmd (consult--build-args consult-find-args))
+ (type (if (eq 0 (call-process-shell-command
+ (concat (car cmd) " -regextype emacs -version")))
+ 'emacs 'basic)))
+ (lambda (input)
+ (pcase-let* ((`(,arg . ,opts) (consult--command-split input))
+ ;; ignore-case=t since -iregex is used below
+ (`(,re . ,hl) (funcall consult--regexp-compiler arg type t)))
+ (when re
+ (cons (append cmd
+ (cdr (mapcan
+ (lambda (x)
+ `("-and" "-iregex"
+ ,(format ".*%s.*"
+ ;; HACK Replace non-capturing groups with capturing groups.
+ ;; GNU find does not support non-capturing groups.
+ (replace-regexp-in-string
+ "\\\\(\\?:" "\\(" x 'fixedcase 'literal))))
+ re))
+ opts)
+ hl))))))
;;;###autoload
(defun consult-find (&optional dir initial)
@@ -4707,7 +4889,7 @@ See `consult-grep' for more details regarding the asynchronous search."
(interactive "P")
(let* ((prompt-dir (consult--directory-prompt "Find" dir))
(default-directory (cdr prompt-dir)))
- (find-file (consult--find (car prompt-dir) #'consult--find-builder initial))))
+ (find-file (consult--find (car prompt-dir) (consult--find-make-builder) initial))))
;;;;; Command: consult-locate
@@ -4715,18 +4897,18 @@ See `consult-grep' for more details regarding the asynchronous search."
"Build command line given CONFIG and INPUT."
(pcase-let ((`(,arg . ,opts) (consult--command-split input)))
(unless (string-blank-p arg)
- (list :command (append (consult--build-args consult-locate-args)
- (list arg) opts)
- :highlight (cdr (consult--default-regexp-compiler input 'basic t))))))
+ (cons (append (consult--build-args consult-locate-args)
+ (list arg) opts)
+ (cdr (consult--default-regexp-compiler input 'basic t))))))
;;;###autoload
(defun consult-locate (&optional initial)
"Search with `locate' for files which match input given INITIAL input.
The input is treated literally such that locate can take advantage of
-the locate database index. Regular expressions would often force a slow
-linear search through the entire database. The locate process is started
-asynchronously, similar to `consult-grep'. See `consult-grep' for more
+the locate database index. Regular expressions would often force a slow
+linear search through the entire database. The locate process is started
+asynchronously, similar to `consult-grep'. See `consult-grep' for more
details regarding the asynchronous search."
(interactive)
(find-file (consult--find "Locate: " #'consult--locate-builder initial)))
@@ -4735,11 +4917,13 @@ details regarding the asynchronous search."
(defun consult--man-builder (input)
"Build command line given CONFIG and INPUT."
- (pcase-let ((`(,arg . ,opts) (consult--command-split input)))
- (unless (string-blank-p arg)
- (list :command (append (consult--build-args consult-man-args)
- (list arg) opts)
- :highlight (cdr (consult--default-regexp-compiler input 'basic t))))))
+ (pcase-let* ((`(,arg . ,opts) (consult--command-split input))
+ (`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t)))
+ (when re
+ (cons (append (consult--build-args consult-man-args)
+ (list (consult--join-regexps re 'basic))
+ opts)
+ hl))))
(defun consult--man-format (lines)
"Format man candidates from LINES."
@@ -4747,15 +4931,16 @@ details regarding the asynchronous search."
(save-match-data
(dolist (str lines)
(when (string-match "\\`\\(.*?\\([^ ]+\\) *(\\([^,)]+\\)[^)]*).*?\\) +- +\\(.*\\)\\'" str)
- (let ((names (match-string 1 str))
- (name (match-string 2 str))
- (section (match-string 3 str))
- (desc (match-string 4 str)))
- (add-face-text-property 0 (length names) 'consult-file nil names)
- (push (cons
- (format "%s - %s" names desc)
- (concat section " " name))
- candidates)))))
+ (let* ((names (match-string 1 str))
+ (name (match-string 2 str))
+ (section (match-string 3 str))
+ (desc (match-string 4 str))
+ (cand (format "%s - %s" names desc)))
+ (add-text-properties 0 (length names)
+ (list 'face 'consult-file
+ 'consult-man (concat section " " name))
+ cand)
+ (push cand candidates)))))
(nreverse candidates)))
;;;###autoload
@@ -4763,8 +4948,8 @@ details regarding the asynchronous search."
"Search for man page given INITIAL input.
The input string is not preprocessed and passed literally to the
-underlying man commands. The man process is started asynchronously,
-similar to `consult-grep'. See `consult-grep' for more details regarding
+underlying man commands. The man process is started asynchronously,
+similar to `consult-grep'. See `consult-grep' for more details regarding
the asynchronous search."
(interactive)
(man (consult--read
@@ -4773,7 +4958,8 @@ the asynchronous search."
(consult--async-highlight #'consult--man-builder))
:prompt "Manual entry: "
:require-match t
- :lookup #'consult--lookup-cdr
+ :category 'consult-man
+ :lookup (apply-partially #'consult--lookup-prop 'consult-man)
:initial (consult--async-split-initial initial)
:add-history (consult--async-split-thingatpt 'symbol)
:history '(:input consult--man-history))))
@@ -4792,9 +4978,9 @@ automatically previewed."
(defun consult-preview-at-point ()
"Preview candidate at point in *Completions* buffer."
(interactive)
- (when-let* ((win (active-minibuffer-window))
- (buf (window-buffer win))
- (fun (buffer-local-value 'consult--preview-function buf)))
+ (when-let ((win (active-minibuffer-window))
+ (buf (window-buffer win))
+ (fun (buffer-local-value 'consult--preview-function buf)))
(funcall fun)))
;;;; Integration with the default completion system
@@ -4838,9 +5024,10 @@ automatically previewed."
;;;; Integration with other completion systems
(with-eval-after-load 'icomplete (require 'consult-icomplete))
-(with-eval-after-load 'selectrum (require 'consult-selectrum))
(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)))
;;; consult.el ends here
diff --git a/debian/changelog b/debian/changelog
index db643f6..085bbe5 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,16 @@
+consult-el (0.32-1) unstable; urgency=medium
+
+ [ Aymeric Agon-Rambosson ]
+ * New upstream release.
+ * Refresh patches.
+ * d/control: Bump Standards-Version to 4.6.2 (no changes required).
+
+ [ Lev Lamberov ]
+ * Team upload.
+ * Add gbp.conf to handle upstream version tags and pristine-tar.
+
+ -- Lev Lamberov <dogsleg@debian.org> Tue, 07 Feb 2023 09:58:38 +0500
+
consult-el (0.20-1) unstable; urgency=medium
* New upstream release.
diff --git a/debian/control b/debian/control
index 2ec3688..043fcfb 100644
--- a/debian/control
+++ b/debian/control
@@ -8,7 +8,7 @@ Build-Depends: debhelper-compat (= 13),
dh-exec,
texinfo,
elpa-htmlize,
-Standards-Version: 4.5.1
+Standards-Version: 4.6.2
Homepage: https://github.com/minad/consult
Rules-Requires-Root: no
Vcs-Browser: https://salsa.debian.org/emacsen-team/consult-el
diff --git a/debian/gbp.conf b/debian/gbp.conf
new file mode 100644
index 0000000..f29c043
--- /dev/null
+++ b/debian/gbp.conf
@@ -0,0 +1,3 @@
+[DEFAULT]
+upstream-tag = %(version)s
+pristine-tar = False
diff --git a/debian/patches/remove-external-images.patch b/debian/patches/remove-external-images.patch
index f087f59..8e5e963 100644
--- a/debian/patches/remove-external-images.patch
+++ b/debian/patches/remove-external-images.patch
@@ -15,6 +15,6 @@ Forwarded: not-needed
-#+html: <a href="https://melpa.org/#/consult"><img alt="MELPA" src="https://melpa.org/packages/consult-badge.svg"/></a>
-#+html: <a href="https://stable.melpa.org/#/consult"><img alt="MELPA Stable" src="https://stable.melpa.org/packages/consult-badge.svg"/></a>
-
- Consult provides practical commands based on the Emacs completion function
- [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Minibuffer-Completion.html][completing-read]]. Completion allows you to quickly select an item from a list of
- candidates. Consult offers in particular an advanced buffer switching command
+ Consult provides search and navigation commands based on the Emacs completion
+ function [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Minibuffer-Completion.html][completing-read]]. Completion allows you to quickly select an item from a
+ list of candidates. Consult offers asynchronous and interactive =consult-grep= and
diff --git a/debian/patches/replace-external-references-when-possible.patch b/debian/patches/replace-external-references-when-possible.patch
index 07f70dc..9d6136c 100644
--- a/debian/patches/replace-external-references-when-possible.patch
+++ b/debian/patches/replace-external-references-when-possible.patch
@@ -8,14 +8,14 @@ Forwarded: not-needed
@@ -7,7 +7,7 @@
#+texinfo_dir_desc: Useful commands built on completing-read.
- Consult provides practical commands based on the Emacs completion function
--[[https://www.gnu.org/software/emacs/manual/html_node/elisp/Minibuffer-Completion.html][completing-read]]. Completion allows you to quickly select an item from a list of
-+[[info:elisp#Minibuffer Completion][completing-read]]. Completion allows you to quickly select an item from a list of
- candidates. Consult offers in particular an advanced buffer switching command
- =consult-buffer= to switch between buffers and recently opened files. Furthermore
- Consult provides multiple search commands, an asynchronous =consult-grep= and
-@@ -17,8 +17,8 @@ the command =consult-imenu= presents a f
- [[#narrowing-and-grouping][grouping and narrowing]]. Please take a look at the [[#available-commands][full list of commands]].
+ Consult provides search and navigation commands based on the Emacs completion
+-function [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Minibuffer-Completion.html][completing-read]]. Completion allows you to quickly select an item from a
++function [[info:elisp#Minibuffer Completion][completing-read]]. Completion allows you to quickly select an item from a
+ list of candidates. Consult offers asynchronous and interactive =consult-grep= and
+ =consult-ripgrep= commands, and the line-based search command =consult-line=.
+ Furthermore Consult provides an advanced buffer switching command =consult-buffer=
+@@ -18,8 +18,8 @@ presents a flat list of the Imenu with [
+ Please take a look at the [[#available-commands][full list of commands]].
Consult is fully compatible with completion systems centered around the standard
-Emacs =completing-read= API, notably the default completion system, [[https://github.com/minad/vertico][Vertico]], [[https://github.com/protesilaos/mct][Mct]],
@@ -25,7 +25,7 @@ Forwarded: not-needed
This package keeps the completion system specifics to a minimum. The ability of
the Consult commands to work well with arbitrary completion systems is one of
-@@ -26,7 +26,7 @@ the main advantages of the package. Cons
+@@ -27,7 +27,7 @@ the main advantages of the package. Cons
it helps you to create a full completion environment out of small and
independent components.
@@ -34,7 +34,7 @@ Forwarded: not-needed
Consult. Marginalia enriches the completion display with annotations, e.g.,
documentation strings or file information. The versatile Embark package provides
local actions, comparable to a context menu. These actions operate on the
-@@ -65,7 +65,7 @@ Many commands implement a little known b
+@@ -66,7 +66,7 @@ Many commands implement a little known b
type =M-n= and typically Consult will insert the symbol or thing at point into
the input.
@@ -43,7 +43,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.
-@@ -369,7 +369,7 @@ their descriptions.
+@@ -389,7 +389,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 +52,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
-@@ -487,7 +487,7 @@ pressing =C-h=. When pressing =C-h= afte
+@@ -507,7 +507,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 +61,7 @@ Forwarded: not-needed
shown in the which-key window after pressing the =consult-narrow-key=.
** Asynchronous search
-@@ -681,11 +681,11 @@ since some details may still change.
+@@ -702,11 +702,11 @@ since some details may still change.
:end:
#+cindex: embark
@@ -76,7 +76,7 @@ Forwarded: not-needed
capabilities.
Actions are commands which can operate on the currently selected candidate (or
-@@ -705,7 +705,7 @@ the matching lines from =consult-line=,
+@@ -726,7 +726,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 +85,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.
-@@ -716,14 +716,12 @@ if the [[https://github.com/mhayashi1120
+@@ -737,14 +737,12 @@ if the [[https://github.com/mhayashi1120
:description: Example configuration and customization variables
:end:
@@ -102,7 +102,7 @@ Forwarded: not-needed
configuration. Consult relies on lambdas and lexical closures. For this reason
many Consult-related snippets require lexical binding.
-@@ -739,8 +737,8 @@ modes. Therefore the package is non-intr
+@@ -760,8 +758,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 +113,7 @@ Forwarded: not-needed
*NOTE:* There is the [[https://github.com/minad/consult/wiki][Consult wiki]], where you can contribute additional
configuration examples.
-@@ -870,7 +868,7 @@ configuration examples.
+@@ -893,7 +891,7 @@ configuration examples.
:end:
#+cindex: customization
@@ -122,7 +122,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.
-@@ -992,10 +990,12 @@ following techniques:
+@@ -1016,10 +1014,12 @@ following techniques:
I use and recommend this combination of packages:
- consult: This package
@@ -139,20 +139,24 @@ 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
-@@ -1010,36 +1010,36 @@ You can integrated Consult with special
+@@ -1047,39 +1047,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.
-- [[https://github.com/yadex205/consult-ag][consult-ag]]: Support for the [[https://github.com/ggreer/the_silver_searcher][Silver Searcher]] in the style of =consult-grep=.
+-- [[https://github.com/mohkale/consult-company][consult-company]]: Completion at point using the [[https://github.com/company-mode/company-mode][Company]] backends.
+- [[https://github.com/yadex205/consult-ag][consult-ag]]: Support for the Silver Searcher (~apt install silversearcher-ag~) in the style of =consult-grep=.
- - [[https://github.com/mohkale/consult-company][consult-company]]: Completion at point using the [[https://github.com/company-mode/company-mode][Company]] backends.
++- [[https://github.com/mohkale/consult-company][consult-company]]: Completion at point using the Company (~apt install elpa-company~) backends.
+ - [[https://github.com/youngker/consult-codesearch.el][consult-codesearch]]: Integration with [[https://github.com/google/codesearch][Code Search]].
- [[https://github.com/karthink/consult-dir][consult-dir]]: Directory jumper using Consult multi sources.
- [[https://codeberg.org/ravi/consult-dash][consult-dash]]: Consult interface to [[https://github.com/dash-docs-el/dash-docs][Dash documentation]]
-- [[https://github.com/mohkale/consult-eglot][consult-eglot]]: Integration with Eglot (LSP client).
-- [[https://github.com/minad/consult-flycheck][consult-flycheck]]: Additional Flycheck integration.
+- [[https://github.com/mohkale/consult-eglot][consult-eglot]]: Integration with Eglot (LSP client, ~apt install elpa-eglot~).
-+- [[https://github.com/minad/consult-flycheck][consult-flycheck]]: Additional Flycheck (~apt install elpa-flycheck~)integration.
++- [[https://github.com/minad/consult-flycheck][consult-flycheck]]: Additional Flycheck (~apt install elpa-flycheck~) integration.
- [[https://gitlab.com/OlMon/consult-flyspell][consult-flyspell]]: Additional Flyspell integration.
+ - [[https://github.com/ghosty141/consult-git-log-grep][consult-git-log-grep]]: Consult interface to git log.
+ - [[https://github.com/Nyoho/consult-hatena-bookmark][consult-hatena-bookmark]]: Access Hatena bookmarks.
- [[https://github.com/rcj/consult-ls-git][consult-ls-git]]: List files from git via Consult.
-- [[https://github.com/gagbo/consult-lsp][consult-lsp]]: Integration with Lsp-mode (LSP client).
-- [[https://codeberg.org/jao/consult-notmuch][consult-notmuch]]: Access the [[https://notmuchmail.org/][Notmuch]] email system using Consult.
@@ -165,7 +169,7 @@ Forwarded: not-needed
-- [[https://gitlab.com/OlMon/consult-projectile/][consult-projectile]]: Additional [[https://github.com/bbatsov/projectile][Projectile]] integration and buffer sources.
-- [[https://codeberg.org/jao/consult-recoll][consult-recoll]]: Access the [[https://www.lesbonscomptes.com/recoll/][Recoll]] desktop full-text search using Consult.
+- [[https://gitlab.com/OlMon/consult-projectile/][consult-projectile]]: Additional Projectile (~apt install elpa-projectile~) integration and buffer sources.
-+- [[https://codeberg.org/jao/consult-recoll][consult-recoll]]: Access the Recoll (~apt install recoll~) desktop full-text search using Consult.
++- [[https://codeberg.org/jao/consult-recoll][consult-recoll]]: Access the Recoll (~apt install elpa-recoll~) desktop full-text search using Consult.
- [[https://codeberg.org/jao/espotify][consult-spotify]]: Access the Spotify API and control your local music player.
-- [[https://github.com/mohkale/consult-yasnippet][consult-yasnippet]]: Integration with Yasnippet.
+- [[https://github.com/mohkale/consult-yasnippet][consult-yasnippet]]: Integration with Yasnippet (~apt install elpa-yasnippet elpa-yasnippet-snippets~).
@@ -187,8 +191,8 @@ Forwarded: not-needed
+- wgrep (~apt install elpa-wgrep~): Editing of grep buffers, use together with =consult-grep= via =embark-export=.
- [[https://github.com/iyefrat/all-the-icons-completion][all-the-icons-completion]]: Icons for the completion UI.
- Note that all packages are independent and can be exchanged with alternative
-@@ -1103,7 +1103,7 @@ Please provide the necessary important i
+ * Bug reports
+@@ -1137,7 +1137,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]].
@@ -197,7 +201,7 @@ Forwarded: not-needed
Consult often relies on lambdas and lexical closures.
* Contributions
-@@ -1127,7 +1127,7 @@ small configuration or command snippets.
+@@ -1161,7 +1161,7 @@ small configuration or command snippets.
:description: Contributors and Sources of Inspiration
:end:
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-02 15:07:48 +0000