Home
Consult is documented in the README, see in particular the configuration section. On this wiki page auxiliary configuration and small utility commands are documented. Feel free to contribute your own useful configuration snippets, candidate multi sources or Consult-related commands!
The snippets on this page REQUIRE lexical binding. Lexical binding is usually specified as a file-local variable. To activate lexical binding, add
;; -*- lexical-binding: t -*-to the top of your source file. If you use a literate org file, adding this block to the very top of it should do the trick:
#+begin_src emacs-lisp :comments no :tangle yes ;; -*- lexical-binding: t -*- #+end_src
(define-key minibuffer-local-map (kbd "M-.") #'my-embark-preview)
(defun my-embark-preview ()
"Previews candidate in vertico buffer, unless it's a consult command"
(interactive)
(unless (bound-and-true-p consult--preview-function)
(save-selected-window
(let ((embark-quit-after-action nil))
(embark-dwim)))))
It is possible to enable/disable preview during an active completing-read
session, by writing a small command. See #233.
(defvar-local consult-toggle-preview-orig nil)
(defun consult-toggle-preview ()
"Command to enable/disable preview."
(interactive)
(if consult-toggle-preview-orig
(setq consult--preview-function consult-toggle-preview-orig
consult-toggle-preview-orig nil)
(setq consult-toggle-preview-orig consult--preview-function
consult--preview-function #'ignore)))
(define-key vertico-map (kbd "M-P") #'consult-toggle-preview)It is possible to configure multiple preview keys, for example S-up/S-down, such that one can scroll over the list of candidates while doing preview. For Vertico the following configuration can be used.
(define-key vertico-map [S-up] #'vertico-previous)
(define-key vertico-map [S-down] #'vertico-next)
(consult-customize consult-recent-file :preview-key '([S-up] [S-down]))For example if consult-line is bound to C-s, you may
want to load the latest search term when pressing C-s C-s.
This can be achieved by binding C-s in the consult-line local keymap.
(defvar my-consult-line-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-s" #'previous-history-element)
map))
(consult-customize consult-line :keymap my-consult-line-map)As a less fine-grained alternative to the above method, the following function creates minibuffer keybindings that take effect only for specific categories of items.
(defun define-minibuffer-key (key &rest defs)
"Define KEY conditionally in the minibuffer.
DEFS is a plist associating completion categories to commands."
(define-key minibuffer-local-map key
(list 'menu-item nil defs :filter
(lambda (d)
(plist-get d (completion-metadata-get
(completion-metadata (minibuffer-contents)
minibuffer-completion-table
minibuffer-completion-predicate)
'category))))))For instance, the following binds C-s to previous-history-element
not only in consult-line, but also in consult-oultine,
consult-mark, etc; moreover, it binds C-s to consult-find-for-minibuffer
(defined below in this wiki) whenever the
minibuffer is reading a file name.
(define-minibuffer-key "\C-s"
'consult-location #'previous-history-element
'file #'consult-find-for-minibuffer)In order to support quick jumping to prompts in eshell via consult-outline we
can set the outline-regexp appropriately in the eshell-mode (#130).
(add-hook 'eshell-mode-hook (lambda () (setq outline-regexp eshell-prompt-regexp)))Makes only the open buffers list visible when calling consult-buffer command
by hiding the other sources, but still allowing the narrowing to recent files
(by typing f SPC), bookmarks (m SPC) and project buffer and/or files (p
SPC).
See issue #203 for more context and use case example.
(dolist (src consult-buffer-sources)
(unless (eq src 'consult--source-buffer)
(set src (plist-put (symbol-value src) :hidden t))))Start with initial narrowing (#203). Note that there is also the possibility to
mark sources as initially :hidden. This is an alternative to initial
narrowing.
;; Configure initial narrowing per command
(defvar consult-initial-narrow-config
'((consult-buffer . ?b)))
;; Add initial narrowing hook
(defun consult-initial-narrow ()
(when-let (key (alist-get this-command consult-initial-narrow-config))
(setq unread-command-events (append unread-command-events (list key 32)))))
(add-hook 'minibuffer-setup-hook #'consult-initial-narrow)Or to provide different rules based on the major-mode:
(defvar consult-initial-narrow-per-mode-config
'((rcirc-mode . ((consult-buffer . ?c)))))
(defun consult-initial-narrow ()
"Narrow consult buffers differently for different major modes.
Allows consult to have initial narrowing for configurable buffer types
and consult command types, contained in
`consult-initial-narrow-per-mode-config'."
(when minibuffer--original-buffer
(when-let* ((original-mode (with-current-buffer minibuffer--original-buffer major-mode))
(mode-config (alist-get original-mode consult-initial-narrow-per-mode-config))
(command-prefix (alist-get this-command mode-config)))
(setq-local unread-command-events (append unread-command-events (list command-prefix 32))))))
(add-hook 'minibuffer-setup-hook #'consult-initial-narrow)You may want to cycle through all the narrowing keys with convenient left and
right key bindings. See issue #337 for more context. Note that Vertico
provides the commands vertico-next-group and vertico-previous-group which
allows to cycle through the groups. The Vertico group cycling is an
alternative to the commands described here.
(define-key consult-narrow-map [C-left] #'consult-narrow-cycle-backward)
(define-key consult-narrow-map [C-right] #'consult-narrow-cycle-forward)
(defun consult-narrow-cycle-backward ()
"Cycle backward through the narrowing keys."
(interactive)
(when consult--narrow-keys
(consult-narrow
(if consult--narrow
(let ((idx (seq-position consult--narrow-keys
(assq consult--narrow consult--narrow-keys))))
(unless (eq idx 0)
(car (nth (1- idx) consult--narrow-keys))))
(caar (last consult--narrow-keys))))))
(defun consult-narrow-cycle-forward ()
"Cycle forward through the narrowing keys."
(interactive)
(when consult--narrow-keys
(consult-narrow
(if consult--narrow
(let ((idx (seq-position consult--narrow-keys
(assq consult--narrow consult--narrow-keys))))
(unless (eq idx (1- (length consult--narrow-keys)))
(car (nth (1+ idx) consult--narrow-keys))))
(caar consult--narrow-keys)))))We can enable preview in find-file by providing a custom
read-file-name-function. A similar approach could work for read-buffer-function
such that all commands reading a buffer name would preview the buffer.
(setq read-file-name-function #'consult-find-file-with-preview)
(defun consult-find-file-with-preview (prompt &optional dir default mustmatch initial pred)
(interactive)
(let ((default-directory (or dir default-directory))
(minibuffer-completing-file-name t))
(consult--read #'read-file-name-internal :state (consult--file-preview)
:prompt prompt
:initial initial
:require-match mustmatch
:predicate pred)))Unfortunately $ does not work out of the box with consult-buffer and
consult-line since these commands add disambiguation suffixes to the candidate
strings. The problem can be fixed by adjusting the filter regular expressions
accordingly. See this reddit post for more context.
(defun fix-dollar (args)
(if (string-suffix-p "$" (car args))
(list (format "%s[%c-%c]*$"
(substring (car args) 0 -1)
consult--tofu-char
(+ consult--tofu-char consult--tofu-range -1)))
args))
(advice-add #'orderless-regexp :filter-args #'fix-dollar)
(advice-add #'prescient-regexp-regexp :filter-args #'fix-dollar)or
(defun +orderless-fix-dollar (word &optional _index _total)
(let ((consult-suffix
(if (and (boundp 'consult--tofu-char) (boundp 'consult--tofu-range))
(format "[%c-%c]*$"
consult--tofu-char
(+ consult--tofu-char consult--tofu-range -1))
"$")))
(concat word consult-suffix)))
(add-to-list 'orderless-affix-dispatch-alist '(?$ . +orderless-fix-dollar)))
I recommend to use the Orderless style dispatchers for a more robust solution. See the next section for a sophisticated Orderless configuration.
(use-package orderless
:demand t
:config
(defun +orderless--consult-suffix ()
"Regexp which matches the end of string with Consult tofu support."
(if (and (boundp 'consult--tofu-char) (boundp 'consult--tofu-range))
(format "[%c-%c]*$"
consult--tofu-char
(+ consult--tofu-char consult--tofu-range -1))
"$"))
;; Recognizes the following patterns:
;; * .ext (file extension)
;; * regexp$ (regexp matching at end)
(defun +orderless-consult-dispatch (word _index _total)
(cond
;; Ensure that $ works with Consult commands, which add disambiguation suffixes
((string-suffix-p "$" word)
`(orderless-regexp . ,(concat (substring word 0 -1) (+orderless--consult-suffix))))
;; File extensions
((and (or minibuffer-completing-file-name
(derived-mode-p 'eshell-mode))
(string-match-p "\\`\\.." word))
`(orderless-regexp . ,(concat "\\." (substring word 1) (+orderless--consult-suffix))))))
;; Define orderless style with initialism by default
(orderless-define-completion-style +orderless-with-initialism
(orderless-matching-styles '(orderless-initialism orderless-literal orderless-regexp)))
;; Certain dynamic completion tables (completion-table-dynamic) do not work
;; properly with orderless. One can add basic as a fallback. Basic will only
;; be used when orderless fails, which happens only for these special
;; tables. Also note that you may want to configure special styles for special
;; completion categories, e.g., partial-completion for files.
(setq completion-styles '(orderless basic)
completion-category-defaults nil
;;; Enable partial-completion for files.
;;; Either give orderless precedence or partial-completion.
;;; Note that completion-category-overrides is not really an override,
;;; but rather prepended to the default completion-styles.
;; completion-category-overrides '((file (styles orderless partial-completion))) ;; orderless is tried first
completion-category-overrides '((file (styles partial-completion)) ;; partial-completion is tried first
;; enable initialism by default for symbols
(command (styles +orderless-with-initialism))
(variable (styles +orderless-with-initialism))
(symbol (styles +orderless-with-initialism)))
orderless-component-separator #'orderless-escapable-split-on-space ;; allow escaping space with backslash!
orderless-style-dispatchers (list #'+orderless-consult-dispatch
#'orderless-affix-dispatch)))consult-ripgrep and the other commands use Emacs regular expressions by
default, which are translated to the PCRE/ERE regular expression syntax. It
is possible to plug-in Orderless as pattern compiler. See issue #380 and #381
for more information.
(defun consult--orderless-regexp-compiler (input type &rest _config)
(setq input (cdr (orderless-compile input)))
(cons
(mapcar (lambda (r) (consult--convert-regexp r type)) input)
(lambda (str) (orderless--highlight input t str))))
;; OPTION 1: Activate globally for all consult-grep/ripgrep/find/...
;; (setq consult--regexp-compiler #'consult--orderless-regexp-compiler)
;; OPTION 2: Activate only for some commands, e.g., consult-ripgrep!
(defun consult--with-orderless (&rest args)
(minibuffer-with-setup-hook
(lambda ()
(setq-local consult--regexp-compiler #'consult--orderless-regexp-compiler))
(apply args)))
(advice-add #'consult-ripgrep :around #'consult--with-orderless)If you find consult-find slow and would like to skip some directories, consider
specifying the directories to skip using consult-find-args:
(setq consult-find-args "find . -not ( -wholename */.* -prune -o -name node_modules -prune )")Default consult-find-args:
(setq consult-find-args "find . -not ( -wholename */.* -prune )")By default, project-find-regexp uses grep and also it does not offer the convenient and beloved interface of Consult. You might want to use consult-ripgrep in place of it, when using project.el.
(require 'keymap) ;; keymap-substitute requires emacs version 29.1?
(require 'cl-seq)
(keymap-substitute project-prefix-map #'project-find-regexp #'consult-ripgrep)
(cl-nsubstitute-if
'(consult-ripgrep "Find regexp")
(pcase-lambda (`(,cmd _)) (eq cmd #'project-find-regexp))
project-switch-commands)consult-imenu moves the top-most imenu names to the group title via the
group-function and adds narrowing if configured in consult-imenu-config. This
grouping only makes sense for certain major modes, e.g., elisp where the topmost
menu name corresponds to fixed imenu item categories, e.g., “Functions”,
“Variables”, etc. In contrast, for org-mode using the top menu names as group
titles does not make sense, since they depend on the buffer content.
The top most menu name is only moved visually to the group title, but the title
is still included with the candidate text, and remains searchable. This means
that searching for, e.g., ion in an emacs-lisp buffer will by default match all
functions and not just function names containing those letters.
If you don’t want the group titles for modes configured in consult-imenu-config
to be searchable, it is possible to advise orderless, such that it ignores the
top most menu names/group titles when searching candidates. The following
implements this, while also allowing embark collect to visit a single imenu
entry from the collect buffer.
(defun my/consult-imenu-around-advice (ci-orig &rest r)
"Patch orderless to inhibit matching group categories in consult-imenu."
(if-let* ((config (cdr (seq-find (lambda (x) (derived-mode-p (car x)))
consult-imenu-config)))
(types (plist-get config :types))
(types-regex (rx-to-string
`(and line-start (or ,@(mapcar #'cadr types)) ? ))))
(cl-letf* ((of-orig (symbol-function 'orderless-filter))
((symbol-function 'orderless-filter) ;patch pattern compiler within filter
(lambda (&rest r)
(cl-letf* ((opc-orig (symbol-function 'orderless-pattern-compiler))
((symbol-function 'orderless-pattern-compiler)
(lambda (&rest r)
(if (and (eq (length r) 1) ;single match string starts
(string-match-p types-regex (car r)))
(apply opc-orig r)
(mapcar (lambda (x) ;replace beginning-of-string
(if (string-match (regexp-quote "\\`" ) x)
(concat types-regex
(replace-match "\\b" nil t x))
(concat types-regex ".*?" x)))
(apply opc-orig r))))))
(apply of-orig r))))
(oh-orig (symbol-function 'orderless--highlight))
((symbol-function 'orderless--highlight) ; patch highlighter to skip type
(lambda (regexps string)
(if-let* ((pref
(next-single-property-change 0 'consult--type string)))
(cl-letf* ((sm-orig (symbol-function 'string-match))
((symbol-function 'string-match)
(lambda (re str)
(funcall sm-orig re str (1+ pref)))))
(funcall oh-orig regexps string))
(funcall oh-orig regexps string)))))
(apply ci-orig r))
(apply ci-orig r)))
(advice-add #'consult-imenu :around #'my/consult-imenu-around-advice))When looking at an outline of the current buffer, it can be nice to see the current and surrounding headings for context and to jump to nearby headings. These pieces of code will make the nearest heading or imenu item be automatically selected when those minibuffer commands are run.
First, using advice, save the current location in the buffer.
(defvar consult--previous-point nil
"Location of point before entering minibuffer.
Used to preselect nearest headings and imenu items.")
(defun consult--set-previous-point (&optional arg1 arg2)
"Save location of point. Used before entering the minibuffer."
(setq consult--previous-point (point)))
(advice-add #'consult-org-heading :before #'consult--set-previous-point)
(advice-add #'consult-outline :before #'consult--set-previous-point)Advise vertico--update to select the nearest candidate if applicable.
(advice-add #'vertico--update :after #'consult-vertico--update-choose)
(defun consult-vertico--update-choose (&rest _)
"Pick the nearest candidate rather than the first after updating candidates."
(when (and consult--previous-point
(memq current-minibuffer-command
'(consult-org-heading consult-outline)))
(setq vertico--index
(max 0 ; if none above, choose the first below
(1- (or (seq-position
vertico--candidates
consult--previous-point
(lambda (cand point-pos) ; counts on candidate list being sorted
(> (cl-case current-minibuffer-command
(consult-outline
(car (consult--get-location cand)))
(consult-org-heading
(get-text-property 0 'consult--candidate cand)))
point-pos)))
(length vertico--candidates))))))
(setq consult--previous-point nil))I am really not sure about the reason, maybe because the builder is called
asynchronously, but to temporarily override consult-ripgrep-args, you may need
to wrap the entire consult--ripgrep-builder. Here is an example that temporarily
adds --no-ignore-vcs flag to the builder. Using advice-add and advice-remove to
override consult--ripgrep-builder seems also OK, but I haven’t tried it.
(defun consult--ripgrep-noignore-builder (input)
"consult--ripgrep-builder with INPUT, but ignores .gitignore."
(let ((consult-ripgrep-args
(if (string-match-p "--no-ignore-vcs" consult-ripgrep-args)
consult-ripgrep-args
(concat consult-ripgrep-args "--no-ignore-vcs ."))))
(consult--make-ripgrep-builder input)))
(defun consult-ripgrep-noignore (&optional dir initial)
"Do consult-ripgrep with DIR and INITIAL, but without ignoring."
(interactive "P")
(consult--grep "Ripgrep"
#'consult--ripgrep-noignore-builder
(if dir dir t) ;; Here the directory prompt is called by default to avoid searching from the project root
initial))After pressing consult-narrow-key, the which-key menu should appear
immediately (#191).
(defun immediate-which-key-for-narrow (fun &rest args)
(let* ((refresh t)
(timer (and consult-narrow-key
(memq :narrow args)
(run-at-time 0.05 0.05
(lambda ()
(if (eq last-input-event (elt consult-narrow-key 0))
(when refresh
(setq refresh nil)
(which-key--update))
(setq refresh t)))))))
(unwind-protect
(apply fun args)
(when timer
(cancel-timer timer)))))
(advice-add #'consult--read :around #'immediate-which-key-for-narrow)NOTE: The vertico-truncate package provides this functionality in a more robust way. Using a package is recommended over copying large snippets to your Emacs configuration.
The recent files list which comprise one of the sources of consult-buffer are
presented with full (abbreviated) path for completion by default. While this
grants us a simple source and precise matching of the candidates, it comes
with some drawbacks: i) candidates may get long enough so that the candidate
gets truncated out of the window width; ii) even if truncation does not occur,
marginalia annotations tend to get pushed away; iii) the full paths may match
more than we’d like (depending on the use case). So one might prefer
shortening the candidates from this source. See discussion at #713.
One first approach to that would be to simply use the file name of the candidate (disregarding the path). This makes for a simple and cheap shortening, with the disadvantage that some candidates may occur in duplicity, in which case the duplicates get shadowed in the completion. But, depending on the use case and preferences, it may be a valid option.
(defun my-consult--source-recentf-items ()
(let ((ht (consult--buffer-file-hash))
file-name-handler-alist ;; No Tramp slowdown please.
items)
(dolist (file 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 (propertize
(file-name-nondirectory file)
'multi-category `(file . ,file))
items)))))
(plist-put consult--source-recent-file
:items #'my-consult--source-recentf-items)A more polished approach, albeit more expensive, is to uniquify the candidates with non-common path parts.
(defun my-consult--source-recentf-items-uniq ()
(let ((ht (consult--buffer-file-hash))
file-name-handler-alist ;; No Tramp slowdown please.
items)
(dolist (file (my-recentf-list-uniq) (nreverse items))
;; Emacs 29 abbreviates file paths by default, see
;; `recentf-filename-handlers'.
(unless (eq (aref (cdr file) 0) ?/)
(setcdr file (expand-file-name (cdr file))))
(unless (gethash (cdr file) ht)
(push (propertize
(car file)
'multi-category `(file . ,(cdr file)))
items)))))
(plist-put consult--source-recent-file
:items #'my-consult--source-recentf-items-uniq)
(defun my-recentf-list-uniq ()
(let* ((proposed (mapcar (lambda (f)
(cons (file-name-nondirectory f) f))
recentf-list))
(recentf-uniq proposed)
conflicts resol file)
;; collect conflicts
(while proposed
(setq file (pop proposed))
(if (assoc (car file) conflicts)
(push (cdr file) (cdr (assoc (car file) conflicts)))
(if (assoc (car file) proposed)
(push (list (car file) (cdr file)) conflicts))))
;; resolve conflicts
(dolist (name conflicts)
(let* ((files (mapcar (lambda (f)
;; data structure:
;; (file remaining-path curr-propos)
(list f
(file-name-directory f)
(file-name-nondirectory f)))
(cdr name)))
(curr-step (mapcar (lambda (f)
(file-name-nondirectory
(directory-file-name (cadr f))))
files)))
;; Quick check, if there are no duplicates, we are done.
(if (eq (length curr-step) (length (seq-uniq curr-step)))
(setq resol
(append resol
(mapcar (lambda (f)
(cons (car f)
(file-name-concat
(file-name-nondirectory
(directory-file-name (cadr f)))
(file-name-nondirectory (car f)))))
files)))
(while files
(let (files-remain)
(dolist (file files)
(let ((curr-propos (caddr file))
(curr-part (file-name-nondirectory
(directory-file-name (cadr file))))
(rest-path (file-name-directory
(directory-file-name (cadr file))))
(curr-step
(mapcar (lambda (f)
(file-name-nondirectory
(directory-file-name (cadr f))))
files)))
(cond ((length= (seq-uniq curr-step) 1)
;; If all elements of curr-step are equal, we skip
;; this path part.
(push (list (car file)
rest-path
curr-propos)
files-remain))
((member curr-part (cdr (member curr-part curr-step)))
;; There is more than one curr-part in curr-step
;; for this candidate.
(push (list (car file)
rest-path
(file-name-concat curr-part curr-propos))
files-remain))
(t
;; There is no repetition of curr-part in curr-step
;; for this candidate.
(push (cons (car file)
(file-name-concat curr-part curr-propos))
resol)))))
(setq files files-remain))))))
;; apply resolved conflicts
(let (items)
(dolist (file recentf-uniq (nreverse items))
(let ((curr-resol (assoc (cdr file) resol)))
(if curr-resol
(push (cons (cdr curr-resol) (cdr file)) items)
(push file items)))))))NOTE: This section relates to the issues #178, #186, and #204.
Consult’s buffer preview functionality causes issues when used with EXWM. Because EXWM can only display an X buffer in one window at a time, previewing the buffer removes it from the original window. If the buffer is shown in another frame, it will also fail to restore the X buffer after finishing buffer selection.
In order to solve this, you can use a custom EXWM-specific buffer source.
Alternatively we can configure the predicate variable
consult-preview-excluded-buffers to exclude EXWM buffers from preview.
(setq consult-preview-excluded-buffers '(major-mode . exwm-mode))Similarly one can exclude Tramp buffers from preview by configuring an
appropriate predicate, which checks if the default-directory of the buffer is a
file-remote-p. This helps if one uses Tramp over an unstable connections where
Tramp buffer switching can be slow or can hang (#224).
Alternatively, if you wish to keep using previews with EXWM then add the following workaround to keep the minibuffer focused. But be aware that adding advices to your configuration can lead to upgrade issues, since the advice relies on internal Consult functionality.
(defun consult-exwm-preview-fix (&rest _args)
"Kludge to stop EXWM buffers from stealing focus during Consult previews."
(when (derived-mode-p 'exwm-mode)
(when-let ((mini (active-minibuffer-window)))
(select-window (active-minibuffer-window)))))
(advice-add
#'consult--buffer-preview :after #'consult-exwm-preview-fix)We can add a register source to consult-buffer. It will show registers
containing markers to specific places in buffers.
(defun consult--point-register-p (reg)
"Return non-nil if REG is a point register."
(markerp (cdr reg)))
(defvar-keymap consult-source-point-register
`(:name "Point Register"
:narrow (?r . "Register")
:category consult-location
:state
,(lambda ()
(let ((state (consult--jump-state)))
(lambda (action cand)
(funcall state action (and cand (car (consult--get-location cand)))))))
:enabled
,(lambda () (seq-some #'consult--point-register-p register-alist))
:items
,(lambda () (consult-register--candidates #'consult--point-register-p)))
"Point register source.")
(add-to-list 'consult-buffer-sources 'consult-source-point-register 'append)(defvar +consult-source-neighbor-file
`(:name "File in current directory"
:narrow ?.
:category file
:face consult-file
:history file-name-history
:state ,#'consult--file-state
:new ,#'consult--file-action
:items
,(lambda ()
(let ((ht (consult--buffer-file-hash)) items)
(dolist (file (completion-pcm--filename-try-filter
(directory-files "." 'full "\\`[^.]" nil 100))
(nreverse items))
(unless (or (gethash file ht) (not (file-regular-p file)))
(push (file-name-nondirectory file) items))))))
"Neighboring file source for `consult-buffer'.")
(unless (memq '+consult-source-neighbor-file consult-buffer-sources)
(let ((p (member 'consult--source-buffer consult-buffer-sources)))
(setcdr p (cons '+consult-source-neighbor-file (cdr p)))))ERC is an IRC client. You can define a source containing only ERC buffers (#290).
(autoload 'erc-buffer-list "erc")
(defvar erc-buffer-source
`(:name "ERC"
:hidden t
:narrow ?e
:category buffer
:state ,#'consult--buffer-state
:items ,(lambda () (mapcar #'buffer-name (erc-buffer-list)))))
(add-to-list 'consult-buffer-sources 'erc-buffer-source 'append)If like me you have a dedicated tab for ERC using the built-in tab-bar-mode (starting 27.1), you can use this function to have initial narrowing under the “ERC” tab solely, so as to display the ERC related candidates (#290).
(defun consult-initial-narrow ()
(when (and (eq this-command #'consult-buffer)
(string-equal "ERC" (alist-get 'name (alist-get 'current-tab (tab-bar-tabs)))))
(setq unread-command-events (append unread-command-events (list ?e 32)))))
(add-hook 'minibuffer-setup-hook #'consult-initial-narrow)rcirc is an alternative IRC client. Since rcirc doesn’t provide a way of retrieving its buffers, we need to create one:
(defun consult-rcirc--buffer-list ()
"Return the list of current rcirc buffers."
(let ((rcirc-buffers
(cl-remove-if-not
(lambda (buffer)
(with-current-buffer buffer
(eq major-mode 'rcirc-mode)))
(buffer-list))))
(cl-remove-duplicates
rcirc-buffers
:test #'equal)))
(defvar rcirc-buffer-source
`(:name "rcirc"
:hidden t
:narrow ?r
:category buffer
:state ,#'consult--buffer-state
:items ,(lambda () (mapcar #'buffer-name (consult-rcirc--buffer-list)))))
(add-to-list 'consult-buffer-sources 'rcirc-buffer-source 'append)Circe is an alternative IRC client. Similar to ERC, Consult buffer sources
can be defined. Because of the way that circe separates chat and server
buffers, the :items function is a bit more involved:
(require 'cl-lib)
(autoload 'circe-server-buffers "circe")
(autoload 'circe-server-chat-buffers "circe")
(defun circe-all-buffers ()
(cl-loop with servers = (circe-server-buffers)
for server in servers
collect server
nconc
(with-current-buffer server
(cl-loop for buf in (circe-server-chat-buffers)
collect buf))))
(defvar circe-buffer-source
`(:name "circe"
:hidden t
:narrow ?c
:category buffer
:state ,#'consult--buffer-state
:items ,(lambda () (mapcar #'buffer-name (circe-all-buffers)))))
(add-to-list 'consult-buffer-sources 'circe-buffer-source 'append)Since Emacs 28, Eww makes use of the standard Emacs bookmark infrastructure. The old-style Eww bookmarks can be integrated with Consult as follows. See discussion in #347.
(require 'eww)
(defvar consult--source-eww
(list
:name "Eww"
:narrow ?e
:action (lambda (bm)
(eww-browse-url (get-text-property 0 'url bm)))
:items (lambda ()
(eww-read-bookmarks)
(mapcar (lambda (bm)
(propertize
(format "%s (%s)"
(plist-get bm :url)
(plist-get bm :title))
'url (plist-get bm :url)))
eww-bookmarks))))
(add-to-list 'consult-buffer-sources 'consult--source-eww 'append)To group all EXWM windows together, we can create an +consult-source-exwm and
add it to the list of buffer sources. Preview is disabled for the EXWM buffers
here since X11 buffers cannot be duplicated. We also hide EXWM buffers from the
other buffer sources.
(defvar +consult-exwm-filter "\\`\\*EXWM")
(add-to-list 'consult-buffer-filter +consult-exwm-filter)
(defvar +consult-source-exwm
`(:name "EXWM"
:narrow ?x
;; :hidden t
:category buffer
:face consult-buffer
:history buffer-name-history
;; Specify either :action or :state
:action ,#'consult--buffer-action ;; No preview
;; :state ,#'consult--buffer-state ;; Preview
:items
,(lambda () (consult--buffer-query
:sort 'visibility
:as #'buffer-name
:exclude (remq +consult-exwm-filter consult-buffer-filter)
:mode 'exwm-mode)))
"EXWM buffer source.")Add a consult-buffer source to group buffers from the current bufler workspace.
(defvar consult--bufler-workspace+
`(:name "Workspace"
:narrow ?w
:category buffer
:face consult-buffer
:history buffer-name-history
:state ,#'consult--buffer-state
:enabled ,(lambda () (frame-parameter nil 'bufler-workspace-path))
:items
,(lambda ()
(let ((bufler-vc-state nil))
(mapcar #'buffer-name
(mapcar #'cdr
(bufler-buffer-alist-at
(frame-parameter nil 'bufler-workspace-path)
:filter-fns bufler-filter-buffer-fns))))))
"Bufler workspace buffers source for `consult-buffer'.")
(with-eval-after-load 'consult
(push #'consult--bufler-workspace+ consult-buffer-sources))Dogears source for Consult. See #430.
(defvar consult--source-dogears
(list :name "Dogears"
:narrow ?d
:category 'dogears
:items (lambda ()
(mapcar
(lambda (place)
(propertize (dogears--format-record place)
'consult--candidate place))
dogears-list))
:action (lambda (cand)
(dogears-go (get-text-property 0 'consult--candidate cand)))))
(defun consult-dogears ()
(interactive)
(consult--multi '(consult--source-dogears)))Use consult-buffer with perspective-el. This would hide the default
consult--source-buffer, and show the list of perspective buffers on the top
(consult-customize consult--source-buffer :hidden t :default nil)
(defvar consult--source-perspective
(list :name "Perspective"
:narrow ?s
:category 'buffer
:state #'consult--buffer-state
:default t
:items #'persp-get-buffer-names))
(push consult--source-perspective consult-buffer-sources)Sources can be added directly to the consult-buffer-source list for convenience.
For example views/perspectives can be added to the list of virtual buffers from
a library like bookmark-view.
;; Configure new bookmark-view source
(add-to-list 'consult-buffer-sources
(list :name "View"
:narrow ?v
:category 'bookmark
:face 'font-lock-keyword-face
:history 'bookmark-view-history
:action #'consult--bookmark-action
:items #'bookmark-view-names)
'append)
;; Modify bookmark source, such that views are hidden
(setq consult--source-bookmark
(plist-put
consult--source-bookmark :items
(lambda ()
(bookmark-maybe-load-default-file)
(mapcar #'car
(seq-remove (lambda (x)
(eq #'bookmark-view-handler
(alist-get 'handler (cdr x))))
bookmark-alist)))))consult-line uses the completion-styles for matching. One can write a wrapper
around consult-line which adjusts the completion styles to the desired
configuration.
;; Use the `substring` completion style
(defun consult-line-literal ()
(interactive)
(let ((completion-styles '(substring))
(completion-category-defaults nil)
(completion-category-overrides nil))
(consult-line)))
;; Use the `orderless` completion style, restricted to `orderless-literal`
(defun consult-line-literal ()
(interactive)
(let ((completion-styles '(orderless))
(orderless-matching-styles '(orderless-literal))
(completion-category-defaults nil)
(completion-category-overrides nil))
(consult-line)))The symbol at point can be passed as initial argument to consult-line.
(defun consult-line-symbol-at-point ()
(interactive)
(consult-line (thing-at-point 'symbol)))Conditionally use the active region as the initial parameter value for
consult-ripgrep.
(defun wrapper/consult-ripgrep (&optional dir given-initial)
"Pass the region to consult-ripgrep if available.
DIR and GIVEN-INITIAL match the method signature of `consult-wrapper'."
(interactive "P")
(let ((initial
(or given-initial
(when (use-region-p)
(buffer-substring-no-properties (region-beginning) (region-end))))))
(consult-ripgrep dir initial)))We can define a command to restart the current consult-ripgrep search in the
parent directory. See issue 596 for the background.
(defun consult-ripgrep-up-directory ()
(interactive)
(let ((parent-dir (file-name-directory (directory-file-name default-directory))))
(when parent-dir
(run-at-time 0 nil
#'consult-ripgrep
parent-dir
(ignore-errors
(buffer-substring-no-properties
(1+ (minibuffer-prompt-end)) (point-max))))))
(minibuffer-quit-recursive-edit))
(consult-customize
consult-ripgrep
:keymap (let ((map (make-sparse-keymap)))
(define-key map (kbd "M-l") #'consult-ripgrep-up-directory)
map))Everything is a useful locate-like program on MS Windows. If you install
Everything and its command line program,
you can define a new Consult command to operate Everything from Emacs.
(defcustom consult-everything-args
"es -r"
"Command line arguments for everything, see `consult-everything'.
The default value is \"es -r\", which only works if you place the command line version of Everything (es.exe) in your PATH."
:type 'string)
(defun consult--everything-builder (input)
"Build command line from INPUT."
(pcase-let ((`(,arg . ,opts) (consult--command-split input)))
(unless (string-blank-p arg)
(cons (append (consult--build-args consult-everything-args)
(consult--split-escaped arg) opts)
(cdr (consult--default-regexp-compiler input 'basic t))))))
(defun consult-everything (&optional initial)
"Search with `everything' for files matching input regexp given INITIAL input."
(interactive)
(find-file (consult--find "Everything: " #'consult--everything-builder initial)))If consult-line is slow in large buffers, this may be useful. Without
native compilation, I can increase the limit significantly. With native
compilation, consult-line is near instant in my largest org file already.
(defcustom my/consult-ripgrep-or-line-limit 300000
"Buffer size threshold for `my/consult-ripgrep-or-line'.
When the number of characters in a buffer exceeds this threshold,
`consult-ripgrep' will be used instead of `consult-line'."
:type 'integer)
(defun my/consult-ripgrep-or-line ()
"Call `consult-line' for small buffers or `consult-ripgrep' for large files."
(interactive)
(if (or (not buffer-file-name)
(buffer-narrowed-p)
(ignore-errors
(file-remote-p buffer-file-name))
(jka-compr-get-compression-info buffer-file-name)
(<= (buffer-size)
(/ my/consult-ripgrep-or-line-limit
(if (eq major-mode 'org-mode) 4 1))))
(consult-line)
(when (file-writable-p buffer-file-name)
(save-buffer))
(let ((consult-ripgrep-args
(concat consult-ripgrep-args
;; filter to desired filename
" -g "
(shell-quote-argument (file-name-nondirectory buffer-file-name))
" ")))
(consult-ripgrep))))hrm-notes is a command to access text file notes from several directories
easily. It uses consult-multi and includes embark integration. It’s a
simple deft-like command.
The following command, meant to be called in the minibuffer when it is
reading a file name, switches from the usual hierarchical browsing of
the file system to a consult-find session.
(defun consult-find-for-minibuffer ()
"Search file with find, enter the result in the minibuffer."
(interactive)
(let* ((enable-recursive-minibuffers t)
(default-directory (file-name-directory (minibuffer-contents)))
(file (consult--find
(replace-regexp-in-string
"\\s-*[:([].*"
(format " (via find in %s): " default-directory)
(minibuffer-prompt))
(consult--find-make-builder)
(file-name-nondirectory (minibuffer-contents)))))
(delete-minibuffer-contents)
(insert (expand-file-name file default-directory))
(exit-minibuffer)))It is convenient to add a category-specific keybinding to this command.
If you find yourself using other programs with Emacs, it can be helpful to
include files used by other programs in the candidate lists of commands like
consult-recent-file and consult-buffer. That way, you never have any mental
hiccups when trying to open files in Emacs that you recently opened in a
different program. Instead, you simply use the same interface with which you are
already familiar.
I put this code into consult-xdg-recent-files, which should be installable with straight. Maybe this saves someone the maintenance.
The way to access this information is generally specific to each system. Please update this section for other systems, if you find this feature useful.
In Linux (or, more specifically, on systems that comply with the XDG
specification), these files are listed in the file recently-used.xbel,
which is found in the directory ~/.local/share or the location described by
the environment variable XDG_DATA_HOME.
We can access the data in this file using libraries built-in with Emacs, namely
url-util.el, dom.el, and one of xml.c or xml.el.
(require 'dom)
(require 'url-util)
(require 'xml)
(defun consult--xdg-recent-file-list ()
"Get a list of recently used files on XDG-compliant systems.
This function extracts a list of files from the file
`recently-used.xbel' in the folder `xdg-data-home'.
For more information on this specification, see
https://www.freedesktop.org/wiki/Specifications/desktop-bookmark-spec/"
(let ((data-file (expand-file-name "recently-used.xbel" (xdg-data-home)))
(xml-parsing-func (if (libxml-available-p)
#'libxml-parse-xml-region
#'xml-parse-region)))
(if (file-readable-p data-file)
(delq nil
(mapcar (lambda (bookmark-node)
(when-let ((local-path (string-remove-prefix
"file://"
(dom-attr bookmark-node 'href))))
(let ((full-file-name (decode-coding-string
(url-unhex-string local-path)
'utf-8)))
(when (file-exists-p full-file-name)
full-file-name))))
(nreverse (dom-by-tag (with-temp-buffer
(insert-file-contents data-file)
(funcall xml-parsing-func
(point-min)
(point-max)))
'bookmark))))
(message "consult: List of XDG recent files not found")
'())))If using multiple systems, then it is good to wrap such a feature in a dispatching function.
(require 'cl-lib)
(defun consult--recent-system-files ()
"Return a list of files recently used by the system."
(cl-case system-type
(gnu/linux
(consult--xdg-recent-file-list))
(t
(message "consult-recent-file: \"%s\" currently unsupported"
system-type)
'())))Generally, one would want to sort these files from most recently used to least recently used. A file’s modification time works well for this, and isn’t disturbed when Emacs accesses the file.
(defun consult--recent-files-sort (file-list)
"Sort the FILE-LIST by modification time, from most recent to least recent."
(thread-last
file-list
;; Use modification time, since getting file access time seems to count as
;; accessing the file, ruining future uses.
(mapcar (lambda (f)
(cons f (file-attribute-modification-time (file-attributes f)))))
(seq-sort (pcase-lambda (`(,f1 . ,t1) `(,f2 . ,t2))
;; Want existing, most recent, local files first.
(cond ((or (not (file-exists-p f1))
(file-remote-p f1))
nil)
((or (not (file-exists-p f2))
(file-remote-p f2))
t)
(t (time-less-p t2 t1)))))
(mapcar #'car)))To mix these candidates with those found in the variable recentf-list, we only
need to filter according the function recentf-include-p.
(defun consult--recent-files-mixed-candidates ()
"Return a list of files recently used by Emacs and the system.
These files are sorted by modification time, from most recent to least."
(thread-last
(consult--recent-system-files)
(seq-filter #'recentf-include-p)
(append (mapcar #'substring-no-properties recentf-list))
delete-dups
(consult--recent-files-sort)))To include the mixed candidates in consult-recent-file, we can slightly modify
its definition.
(defcustom consult-include-system-recent-files nil
"Whether to include files used by other programs in `consult-recent-file'."
:type 'boolean
:group 'consult)
;;;###autoload
(defun consult-recent-file ()
"Find recent using `completing-read'."
(interactive)
(find-file
(consult--read
(or (mapcar #'abbreviate-file-name
(if consult-include-system-recent-files
(consult--recent-files-mixed-candidates)
recentf-list))
(user-error "No recent files"))
:prompt "Find recent file: "
:sort nil
:require-match t
:category 'file
:state (consult--file-preview)
:history 'file-name-history)))To include these candidates in consult-buffer, we can add a source to the
variable consult-buffer-sources.
(defvar consult--source-system-file
`(:name "System file"
:narrow ?F
:category file
:face consult-file
:history file-name-history
:action ,#'consult--file-action
:items
,(lambda ()
(let ((ht (consult--buffer-file-hash)))
(mapcar #'abbreviate-file-name
(seq-remove (lambda (x) (gethash x ht))
(consult--recent-system-files))))))
"Recent system file candidate source for `consult-buffer'.")
(defvar consult--source-mixed-file
`(:name "File"
:narrow ?f
:category file
:face consult-file
:history file-name-history
:action ,#'consult--file-action
:items
,(lambda ()
(let ((ht (consult--buffer-file-hash)))
(mapcar #'abbreviate-file-name
(seq-remove (lambda (x) (gethash x ht))
(consult--recent-files-mixed-candidates))))))
"File candidate source for `consult-buffer', including system files.
This is meant as a replacement for `consult--source-file'.")
;; Example: using the "mixed" source in `consult-buffer':
(setq consult-buffer-sources
'( consult--source-hidden-buffer
consult--source-buffer
consult--source-mixed-file
consult--source-bookmark
consult--source-project-buffer
consult--source-project-file))The following configuration uses the consult--multi API to present
both the user’s agenda files, and the headings in those files.
;; Tested with consult commit e222aacb656161233931c4ff27d7625f31f3aaf9
;; `consult-org--headings' adds different text properties before this
;; commit, so you'd have to tweak this code
(defun my/consult-org-agenda-multi ()
"Jump to an Org agenda heading or file."
(interactive)
(require 'consult-org)
(consult--multi
(list
(my/consult--file-relative-source (org-agenda-files) org-directory)
(my/consult-org--heading-source '(nil nil agenda)))
:require-match t
:sort t))
(defun my/consult--file-relative-source (filenames dir)
"File candidate source; FILENAMES are presented relative to DIR."
`(:name "Agenda File"
:category file
:narrow ?f ; type '< f' to narrow to filenames
:history file-name-history
:state ,#'consult--file-state
:items
,(mapcar (lambda (f)
(propertize (file-relative-name f dir)
'multi-category (cons 'file f)))
filenames)))
(defun my/consult-org--heading-source
(items-args)
"Generate Org heading candidate source.
ITEMS-ARGS is a list of arguments passed to `consult--org-headings' to generate
the list of candidates."
`(:name "Agenda Heading"
:category org-heading
:items ,(apply #'consult-org--headings items-args)
:history consult-org--history
:narrow ,(consult-org--narrow)
:state ,#'my/consult-org--heading-state
:annotate ,(my/consult-org--annotate)))
(defun my/consult-org--heading-state ()
"State function for Org headings with preview."
(consult--state-with-return
(my/consult-org--heading-preview)
#'my/consult-org--heading-jump))
(defun my/consult-org--heading-preview ()
"The preview function used if selecting from a list of Org headings.
Simply wraps `consult--jump-preview'."
;; the closure that `consult--jump-preview' returns must be retained for the
;; duration of completion, since it stores the list of overlays to remove
;; ('restore' variable)
(let ((preview-fn (consult--jump-preview)))
(lambda (action cand)
(funcall preview-fn action
(when cand (get-text-property 0 'org-marker cand))))))
(defun my/consult-org--heading-jump (heading)
"Jump to Org HEADING.
Simply wraps `consult--jump'."
(consult--jump (get-text-property 0 'org-marker heading)))
(defun my/consult-org--annotate ()
"Generate annotation function for Org headings.
Also adds the filename relative to `org-directory' as an annotation."
(let ((ann-maxlens (list 0 0 0))) ; 1 elt per annotation type supported
(lambda (cand)
(let* ((props (get-text-property 0 'consult-org--heading cand))
(kwd (or (cadr props) ""))
(prio (if-let ((prio (caddr props)))
(format #("[#%c]" 0 5 (face org-priority)) prio)
""))
(buf (cdddr props))
(file (file-relative-name (buffer-file-name (get-buffer buf))
(file-truename org-directory)))
(anns (list kwd prio file)))
;; pad annotations so they're aligned into columns
(dotimes (i (length anns))
(when-let ((str (nth i anns)))
(let ((len (length str))
(prevlen (nth i ann-maxlens))
maxlen)
(if (>= prevlen len)
(setq maxlen prevlen)
(setq maxlen len)
(setcar (nthcdr i ann-maxlens) maxlen))
(setcar (nthcdr i anns) (string-pad str maxlen)))))
(consult--annotate-align cand (mapconcat #'identity anns " "))))))The following is a simple command to select and clock into an agenda entry.
(defun consult-clock-in ()
"Clock into an Org agenda heading."
(interactive)
(save-window-excursion
(consult-org-agenda)
(org-clock-in)))
(consult-customize consult-clock-in
:prompt "Clock in: "
:preview-key "M-.")Below is a fancier version with the following perks, which you may pick and choose:
- Instead of offering agenda entries, offer headings from all files that have a recent clock entry.
- Sort recent clock entries separately under a
*Recent*group. - With a prefix argument, resolve dangling clocks and ask for a time to clock into the selected task.
(setq org-clock-persist t)
(with-eval-after-load 'org
(org-clock-persistence-insinuate))
(defun consult-clock-in (&optional match scope resolve)
"Clock into an Org heading."
(interactive (list nil nil current-prefix-arg))
(require 'org-clock)
(org-clock-load)
(save-window-excursion
(consult-org-heading
match
(or scope
(thread-last org-clock-history
(mapcar 'marker-buffer)
(mapcar 'buffer-file-name)
(delete-dups)
(delq nil))
(user-error "No recent clocked tasks")))
(org-clock-in nil (when resolve
(org-resolve-clocks)
(org-read-date t t)))))
(consult-customize consult-clock-in
:prompt "Clock in: "
:preview-key "M-."
:group
(lambda (cand transform)
(let* ((marker (get-text-property 0 'consult--candidate cand))
(name (if (member marker org-clock-history)
"*Recent*"
(buffer-name (marker-buffer marker)))))
(if transform (substring cand (1+ (length name))) name))))Note that these commands can also be used as an Embark action.
Normally, an Org capture target specifies a fixed file or heading within a file
as its target. The following example shows how to define a capture target that
first queries an agenda entry using consult-org-headline, and then places the
capture directly beneath it.
(defun consult-org-capture-target (scope)
"Choose a capture target interactively.
This function returns a value suitable for use as the `target'
entry of `org-capture-templates'. SCOPE is as in `org-map-entries'."
(list 'function
(lambda ()
(let ((consult--read-config `((,this-command
:prompt "Capture target: "
:preview-key "M-."))))
(set-buffer (save-window-excursion
(consult-org-heading nil scope)
(current-buffer)))))))
(add-to-list 'org-capture-templates
`(("c" "Consult..." entry ,(consult-org-capture-target 'agenda)
"* TODO %?\n %i" :prepend t)))You may also wish to have a direct keybinding to this capture type, instead of
going though the M-x org-capture menu. In this case, use the following:
(defun consult-org-capture ()
(interactive)
(org-capture nil "c"))Type C-s to search forward and C-r to search backward. Requires the vertico-reverse extension to be enabled.
(defun my/consult-line-forward ()
"Search for a matching line forward."
(interactive)
(consult-line))
(defun my/consult-line-backward ()
"Search for a matching line backward."
(interactive)
(advice-add 'consult--line-candidates :filter-return 'reverse)
(vertico-reverse-mode +1)
(unwind-protect (consult-line)
(vertico-reverse-mode -1)
(advice-remove 'consult--line-candidates 'reverse)))
(with-eval-after-load 'consult
(consult-customize my/consult-line-backward
:prompt "Go to line backward: ")
(consult-customize my/consult-line-forward
:prompt "Go to line forward: "))
(global-set-key (kbd "C-s") 'my/consult-line-forward)
(global-set-key (kbd "C-r") 'my/consult-line-backward)This is based on the command selectrum-outline, minimally modified to use
consult--read.
(defvar my-consult-outline-path-history nil
"History of chosen headings for ‘my-consult-outline-path’.")
(defcustom my-consult-outline-path-formats
;; Groups: (1) level determinant, (2) heading text.
;; The top level is 0, for a zero-length determinant.
`((emacs-lisp-mode
. "^;;;\\(?1:;*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(diff-mode
;; We just need a zero-length thing to match the file line
;; and a one-length thing to match the section line.
;; This works even with `diff-font-lock-prettify' enabled.
. ,(rx (or (seq line-start (group-n 1 "")
"diff " (0+ nonl) "b/" (group-n 2 (+? nonl))
string-end)
(seq line-start "@" (group-n 1 "@")
" " (group-n 2 (0+ nonl)) string-end))))
(lisp-mode
. "^;;;\\(?1:;*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(lua-mode
. "^---\\(?1:-*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(gfm-mode ; Github Flavored Markdown
. "^#\\(?1:#*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(markdown-mode
. "^#\\(?1:#*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(outline-mode
. "^\\*\\(?1:\\**\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
;; For Org, see also ‘org-goto’.
(org-mode
. "^\\*\\(?1:\\**\\)[[:blank:]]+\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(python-mode
. "^##\\(?1:\\**\\|#*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(shortdoc-mode
. "^\\(?1:\\)\\(?2:[A-Z].*$\\)"))
"Alist of regexps used for identifying outline headings in each major mode.
The ‘car’ of an item in the list should be a symbol of the major mode.
The ‘cdr’ should be a regular expression with two required match groups:
1. Match group 1, whose length determines the outline level of that heading.
For best formatting, the top level should be level 0 for zero length.
2. Match group 2, which is the actual heading text.
A heading is assumed to be on only one line."
:group 'consult
:type '(alist
:key-type (symbol :tag "Major mode symbol")
:value-type (string :tag "Regexp")))
;;;###autoload
(defun my-consult-outline-path ()
"Jump to a heading. Regexps are pre-defined. Obeys narrowing."
(interactive)
(if-let ((heading-regexp (alist-get major-mode my-consult-outline-path-formats)))
(let ((candidates)
(default-heading)
(initial-line-number (line-number-at-pos (point))))
(save-excursion
(goto-char (point-min))
(let* ((line-number (line-number-at-pos (point)))
(point-max (point-max))
(beg (point))
(end (line-end-position))
(backwards-prefix-list)
(prev-heading-text)
(prev-heading-level)
(heading-text)
(heading-level)
(formatted-heading))
(save-match-data
(while (< end point-max)
(let ((text-line (buffer-substring beg end)))
(when (string-match heading-regexp text-line)
(setq prev-heading-text heading-text
prev-heading-level heading-level
heading-text (match-string-no-properties 2 text-line)
heading-level (- (match-end 1) (match-beginning 1)))
;; Decide whether to update the prefix list and the previous
;; heading level.
(let ((prev-heading-level (or prev-heading-level heading-level)))
(cond
;; If we've moved to a greater level (further down the tree),
;; add the previous heading to the heading prefix list so
;; that we can prepend it to the current heading when
;; formatting.
((> heading-level prev-heading-level)
(push prev-heading-text backwards-prefix-list))
((< heading-level prev-heading-level)
;; Otherwise, if we've moved to a lower level (higher up the
;; tree), and need to remove the most recently added prefix
;; from the list (i.e., go from '(c b a) back to '(b a)).
(cl-callf2 nthcdr (- prev-heading-level heading-level)
backwards-prefix-list))))
;; If needed, set default candidate.
(when (and (null default-heading)
(> line-number initial-line-number))
(setq default-heading formatted-heading))
(setq formatted-heading
(propertize
(concat (string-join (reverse backwards-prefix-list) "/")
(and backwards-prefix-list "/")
heading-text)
'line-number line-number))
(push formatted-heading candidates)))
(cl-incf line-number)
(forward-line 1)
(setq beg (point)
end (line-end-position))))
(unless default-heading
(setq default-heading formatted-heading))))
(cl-flet ((ln (str) (get-text-property 0 'line-number str)))
(let* ((line-number-format
(format "L%%0%dd: "
(length (number-to-string (ln (car candidates))))))
(affixate-func
(lambda (cand)
(list cand (propertize (format line-number-format (ln cand))
'face 'completions-annotations)
"")))
(lookup-fn (lambda (selected candidates &rest _)
(consult--lookup-prop 'line-number
selected candidates)))
(chosen-line (consult--read (nreverse candidates)
:prompt "Jump to heading: "
:require-match t
:history 'my-consult-outline-path-history
;; TODO: Want to select default
;; without moving it to the
;; top of the list.
;; :default default-heading
:annotate affixate-func
:lookup lookup-fn
:sort nil)))
;; Push mark, in case we want to return to current location. This
;; needs to happen /after/ the user has made it clear that they
;; want to go somewhere.
(push-mark (point) t)
;; Move to beginning of chosen line.
(forward-line (- chosen-line initial-line-number))
(beginning-of-line-text 1)
;; Return non-nil for advice combinator `after-while'.
t)))
(call-interactively #'consult-outline)))This can be useful if you want to set tab-bar-show to nil
(defun +tab-bar--make-completion-list (tab-list)
"Return completion list of strings formatted from TAB-LIST."
(mapcar (lambda (tab)
(let ((index (1+ (tab-bar--tab-index tab)))
(name (alist-get 'name tab)))
(format "%d %s" index name)))
tab-list))
(defun +tab-bar--completion-list-recent ()
"Return completion list of recent tabs (current not included)."
(+tab-bar--make-completion-list (tab-bar--tabs-recent)))
(defun +tab-bar--index-from-candidate (cand)
"Return prefix index of CAND."
(let ((match (string-match "^[[:digit:]]+" cand)))
(when match
(string-to-number (match-string match cand)))))
(defun +tab-bar--tab-from-index (index)
"Return tab from `(tab-bar-tabs)' by index of CAND."
(when index
(nth (1- index) (tab-bar-tabs))))
(defun +consult--tab-preview ()
"Preview function for tabs."
(let ((orig-wc (current-window-configuration)))
(lambda (action cand)
(if (eq action 'exit)
(set-window-configuration orig-wc nil t)
(when cand
(let* ((index (+tab-bar--index-from-candidate cand))
(tab (+tab-bar--tab-from-index index)))
(when tab
(if (eq (car tab) 'current-tab)
(set-window-configuration orig-wc nil t)
(set-window-configuration (alist-get 'wc tab) nil t)))))))))
(defun +consult--tab-annotate (cand)
"Annotate current tab."
(when (equal (car (+tab-bar--tab-from-index (+tab-bar--index-from-candidate cand))) 'current-tab)
"Current"))
(defun +consult--tab-action-select (cand)
"Select tab from CAND."
(tab-bar-select-tab (+tab-bar--index-from-candidate cand)))
(defvar +consult--tab-history
"History of tab completion selections.")
(defvar +consult--source-tab-recent
(list :name "Tab"
:category 'tab
:narrow ?t
:default t
:history '+consult--tab-history
:items #'+tab-bar--completion-list-recent
:annotate #'+consult--tab-annotate
:action #'+consult--tab-action-select
:state #'+consult--tab-preview))
(defun +consult-tab ()
"Select tab with completion and preview."
(interactive)
(consult--multi '(+consult--source-tab-recent) :prompt "Select tab: "))
(defun +consult-tab-close ()
"Select tab to close it."
(interactive)
(tab-bar-close-tab (+tab-bar--index-from-candidate (car (consult--multi '(+consult--source-tab-recent) :prompt "Close tab: ")))))
Due to the fact that it is almost impossible to properly complete tabs from a tab bar by their name if their names are not unique, the only thing left is to complete their indexes. This approach is an improvement on the code from the previous section. Only now we use marginalia to display the name.
Here is the result
;; -*- lexical-binding: t; -*-
(require 'consult)
(require 'marginalia)
(defvar +consult--tab-index-current-tab-name nil
"The name of the current tab. Needed for marginalia annotations when previewing tabs.
Because we are changing the current window configuration when previewing tabs, we are
also changing the name of the current tab unless it's not an explicit name. To prevent
this, we can store the name of the current tab before calling consult command and use
this saved name in marginalia annotations of the current tab.")
(defvar +consult--tab-index-current-tab-bufs nil
"List of current tab buffer names. Needed for marginalia annotations when previewing tabs.
Because we are changing the current window configuration when previewing tabs, we need to
save the current list of buffers displayed in windows before calling consult command and
use this saved list in marginalia annotations of the current tab.")
(defun +marginalia-annotate-tab-index (cand)
"Modified version of `marginalia-annotate-tab' suited for tab-index completion."
(let* ((tab (nth (1- (string-to-number cand)) (tab-bar-tabs)))
(current-p (memq 'current-tab tab))
(ws (alist-get 'ws tab))
(bufs (if current-p
+consult--tab-index-current-tab-bufs
(window-state-buffers ws))))
;; NOTE: When the buffer key is present in the window state
;; it is added in front of the window buffer list and gets duplicated.
(unless current-p
(when (cadr (assq 'buffer ws)) (pop bufs)))
(marginalia--fields
;; Tab name
((if current-p
+consult--tab-index-current-tab-name
(alist-get 'name tab))
:face (if current-p 'marginalia-on 'marginalia-key)
:width 15
:truncate 15)
;; Window count
((if (cdr bufs)
(format "%d windows" (length bufs))
"1 window ")
:face 'marginalia-size
:width 15)
;; List of buffers
((string-join bufs " \t ")
:face 'marginalia-documentation))))
(add-to-list 'marginalia-annotator-registry '(tab-index +marginalia-annotate-tab-index))
(defun +consult--tab-index-preview ()
"Preview function for tab-index."
(let ((orig-wc (current-window-configuration)))
(lambda (action cand)
(if (eq action 'exit)
(set-window-configuration orig-wc nil t)
(when cand
(set-window-configuration
(alist-get 'wc (nth (1- (string-to-number cand))
(tab-bar-tabs))
;; default to original wc if
;; there is no tab wc (usually current tab)
orig-wc)
nil t))))))
(defvar +consult--source-tab-index
(list :name "Tab"
:category 'tab-index
:default t
:narrow ?t
:state #'+consult--tab-index-preview
:items (lambda ()
(mapcar #'number-to-string
(number-sequence 1 (length (tab-bar-tabs))))))
"Source of all tab indexes starting from 1.")
(defun +consult--tab-index (&optional prompt)
"Prompt for tab selection and return selected candidate as number.
Replace prompt with PROMPT if specified."
;; Marginalia integration
(let (;; Align annotations as close to index as possible
(marginalia-align-offset -18)
;; Save curret tab name
(+consult--tab-index-current-tab-name (alist-get 'name (tab-bar--current-tab)))
;; Save current window buffer list
(+consult--tab-index-current-tab-bufs (mapcar #'buffer-name
(mapcar #'window-buffer
(window-list)))))
(string-to-number (car (consult--multi '(+consult--source-tab-index)
;; disable sorting
:sort nil
:require-match t
:prompt (or prompt "Select tab: "))))))
;;;###autoload
(defun +consult-tab ()
"Select tab and switch to it."
(interactive)
(tab-bar-select-tab (+consult--tab-index)))This approach is very extensible, here are some examples
(defvar +consult--tab-index-commands '(+tab-bar-dwim
+consult-tab
+consult-tab-close*)
"List of commands that will trigger `+consult--tab-index-preselect' and `+consult--tab-index-refresh'")
(defun +consult--tab-index-preselect ()
"Preselect recent tab if `this-command' in `+consult--tab-index-commands'."
(when (memq this-command +consult--tab-index-commands)
(vertico--goto (or (tab-bar--tab-index-recent 1)
(tab-bar--current-tab-index)))))
(add-hook 'minibuffer-setup-hook #'+consult--tab-index-preselect)
(defun +consult--tab-index-refresh ()
"Run `consult-vertico--refresh' if `this-command' in `+consult--tab-index-commands'."
(when (memq this-command +consult--tab-index-commands)
(consult--vertico-refresh)))
(advice-add #'vertico--setup :after #'+consult--tab-index-refresh);;;###autoload
(defun +tab-bar-dwim (&optional arg)
"Do-What-I-Mean function for tabs.
If optional prefix argument is specified, then switch to `ARG'th tab.
If no other tab exists, create one and switch to it.
If there is one other tab (two in total), switch to it.
If there are more than two tabs, select tab with `+consult-tab'."
(interactive "P")
(if arg
(tab-bar-select-tab arg)
(pcase (length (tab-bar-tabs))
(1 (tab-bar-new-tab))
(2 (tab-bar-switch-to-next-tab))
(_ (+consult-tab)))));;;###autoload
(defun +consult-tab-close* ()
"Close multiple tabs."
(interactive)
(let (index)
(while (setq index (+consult--tab-index "Close tab: "))
(tab-bar-close-tab index))))(require 'embark)
(defun +embark-tab-close (tab-index)
"Close tab."
(tab-bar-close-tab (1- (string-to-number tab-index))))
(defun +embark-tab-rename (tab-index)
"Rename tab."
(setq current-prefix-arg (string-to-number tab-index))
(call-interactively #'tab-bar-rename-tab))
(defvar-keymap +embark-tab-index-map
:doc "Keymap for tab-index."
"k" #'+embark-tab-close
"r" #'+embark-tab-rename)
(add-to-list 'embark-keymap-alist '(tab-index . +embark-tab-index-map))Functions similar to counsel-colors-emacs and counsel-colors-web. Insert color
name from the list of supported colors or, via embark actions, insert RGB or HEX
values.
(defvar consult-colors-history nil
"History for `consult-colors-emacs' and `consult-colors-web'.")
;; No longer preloaded in Emacs 28.
(autoload 'list-colors-duplicates "facemenu")
;; No preloaded in consult.el
(autoload 'consult--read "consult")
(defun consult-colors-emacs (color)
"Show a list of all supported colors for a particular frame.\
You can insert the name (default), or insert or kill the hexadecimal or RGB value of the
selected color."
(interactive
(list (consult--read (list-colors-duplicates (defined-colors))
:prompt "Emacs color: "
:require-match t
:category 'color
:history '(:input consult-colors-history)
)))
(insert color))
;; Adapted from counsel.el to get web colors.
(defun counsel-colors--web-list nil
"Return list of CSS colors for `counsult-colors-web'."
(require 'shr-color)
(sort (mapcar #'downcase (mapcar #'car shr-color-html-colors-alist)) #'string-lessp))
(defun consult-colors-web (color)
"Show a list of all CSS colors.\
You can insert the name (default), or insert or kill the hexadecimal or RGB value of the
selected color."
(interactive
(list (consult--read (counsel-colors--web-list)
:prompt "Color: "
:require-match t
:category 'color
:history '(:input consult-colors-history)
)))
(insert color))(defun rounding-numbers (list-of-num decimal-points)
"Return (as a float) the list of nearest integers to each number of list-of-num."
(let ((rounding (expt 10 decimal-points)))
(mapcar (lambda (x) (/ (fround (* rounding x)) rounding)) list-of-num)))
(defun numbers-to-string (list-of-num SEPARATOR)
"Converts a list of numbers to a string \"num1,num2,num3,...\"."
(mapconcat #'number-to-string list-of-num SEPARATOR))
;; Colors RGB number as string
(defvar color-rgb-round-decimal-points 2 "Number of decimal points to round RGB colors.")
(defvar color-rgb-string-separator "," "SEPARATOR between numbers for RGB strings.")
(defun color-name-to-rgb-string (NAME)
"Return the RGB value of color NAME as string \"num1,num2,num3\", with num between 0 and 1.
Return nil if NAME does not designate a valid color."
(when-let ((rgb (color-name-to-rgb NAME)))
(numbers-to-string rgb color-rgb-string-separator)))
(defun color-name-to-round-rgb-string (NAME)
"Returns the rounded RGB value of color as string \"num1,num2,num3\", with num between 0 and 1.
Return nil if NAME does not designate a valid color."
(when-let ((rgb (color-name-to-rgb NAME)))
(numbers-to-string (rounding-numbers rgb color-rgb-round-decimal-points)
color-rgb-string-separator)))
;; Adapted from counsel.el to conver color name to hex.
(defun counsel-colors--hex (NAME)
"Return hexadecimal value of color with NAME.
Return nil if NAME does not designate a valid color."
(when-let* ((rgb (color-name-to-rgb NAME))
;; Sets 2 digits per component.
(hex (apply #'color-rgb-to-hex (append rgb '(2)))))
hex))Config using Doom emacs. For doomed users not using Doom, evaluate code in
(after! embark ... ) using define-key instead of map!.
(after! embark
(defvar-keymap embark-consult-color-action-map
:doc "Keymap for embark actions in the `color' category of marginalia.")
;; Kill and insert versions
(defvar embark-consult-color-functions-alist
'(((color-name-to-round-rgb-string . "rRGB") . ("r" . "k"))
((color-name-to-rgb-string . "RGB") . ("R" . "K"))
((counsel-colors--hex . "hex") . ("h" . "H")))
"Cons list of ((fun . desc) . (bind_insert . bind_kill)) of functions converting a color name to some value.
Used to define their `insert' and `kill-new' versions for embark actions.")
;; Define `insert' versions
(cl-loop for fun in embark-consult-color-functions-alist do
;; (message "dir %s, name %s" (car dirname) (cdr dirname))
(let* ((sym (caar fun))
(bind (cadr fun))
(desc (format "Insert %s" (cdar fun)))
(newname (intern (format "%s-insert" (symbol-name sym)))))
;; `(lambda (color) (insert (apply ',fun (list color))))
(fset newname `(lambda (color)
(insert (,sym color))
(pushnew! consult-colors-history color)))
;; (define-key embark-consult-color-action-map (kbd bind) (cons desc newname))
(map! :map embark-consult-color-action-map
:desc desc bind newname)))
;; Define `kill-new' versions
(cl-loop for fun in embark-consult-color-functions-alist do
(let* ((sym (caar fun))
(bind (cddr fun))
(desc (format "Insert %s" (cdar fun)))
(newname (intern (format "%s-kill" (symbol-name sym)))))
;; `(lambda (color) (kill-new (apply ',fun (list color))))
(fset newname `(lambda (color)
(kill-new (,sym color))
(pushnew! consult-colors-history color)))
;; (define-key embark-consult-color-action-map (kbd bind) (cons desc newname))
(map! :map embark-consult-color-action-map
:desc desc bind newname)))
(add-to-list 'embark-keymap-alist '(color . embark-consult-color-action-map)))Compatibility with Marginalized comes for free, since it already defines the
category color, for which uses marginalia-annotate-color.