dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

commit 0753ac9ab496a86373a1a1dfc3df9f870f845084
parent 027b8ee690d89f3c8dac0c0984448e6d6c5c68b7
Author: Lukas Henkel <lh@entf.net>
Date:   Sat,  8 Oct 2022 10:58:42 +0200

Update consult

Diffstat:
Aelpa/compat-28.1.2.2.signed | 2++
Aelpa/compat-28.1.2.2/.dir-locals.el | 7+++++++
Aelpa/compat-28.1.2.2/NEWS.org | 108+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-24.el | 495+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-25.el | 322+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-26.el | 675+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-27.el | 764+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-28.el | 882+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-autoloads.el | 38++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-font-lock.el | 48++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-help.el | 57+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-macs.el | 316+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat-pkg.el | 2++
Aelpa/compat-28.1.2.2/compat.el | 58++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/compat.info | 2070+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/compat-28.1.2.2/dir | 18++++++++++++++++++
Delpa/consult-0.17/consult-autoloads.el | 522-------------------------------------------------------------------------------
Delpa/consult-0.17/consult-compile.el | 128-------------------------------------------------------------------------------
Delpa/consult-0.17/consult-flymake.el | 100-------------------------------------------------------------------------------
Delpa/consult-0.17/consult-imenu.el | 234-------------------------------------------------------------------------------
Delpa/consult-0.17/consult-org.el | 124-------------------------------------------------------------------------------
Delpa/consult-0.17/consult-pkg.el | 10----------
Delpa/consult-0.17/consult-register.el | 315-------------------------------------------------------------------------------
Delpa/consult-0.17/consult-selectrum.el | 105-------------------------------------------------------------------------------
Delpa/consult-0.17/consult-xref.el | 119-------------------------------------------------------------------------------
Delpa/consult-0.17/consult.el | 4878-------------------------------------------------------------------------------
Aelpa/consult-0.19.signed | 2++
Aelpa/consult-0.19/CHANGELOG.org | 224+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/LICENSE | 674+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/README-elpa | 1540+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/README.org | 1211+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/consult-autoloads.el | 451+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/consult-compile.el | 127+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/consult-flymake.el | 114+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Relpa/consult-0.17/consult-icomplete.el -> elpa/consult-0.19/consult-icomplete.el | 0
Aelpa/consult-0.19/consult-imenu.el | 242+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/consult-org.el | 126+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/consult-pkg.el | 2++
Aelpa/consult-0.19/consult-register.el | 313+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/consult-selectrum.el | 96+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Relpa/consult-0.17/consult-vertico.el -> elpa/consult-0.19/consult-vertico.el | 0
Aelpa/consult-0.19/consult-xref.el | 122+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/consult.el | 4749+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/consult.info | 1491+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/consult-0.19/dir | 18++++++++++++++++++
Minit.el | 3---
46 files changed, 17364 insertions(+), 6538 deletions(-)

diff --git a/elpa/compat-28.1.2.2.signed b/elpa/compat-28.1.2.2.signed @@ -0,0 +1 @@ +Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-08-25T23:05:04+0200 using RSA +\ No newline at end of file diff --git a/elpa/compat-28.1.2.2/.dir-locals.el b/elpa/compat-28.1.2.2/.dir-locals.el @@ -0,0 +1,7 @@ +;;; Directory Local Variables +;;; For more information see (info "(emacs) Directory Variables") + +((emacs-lisp-mode + (byte-compile-docstring-max-column . 100) + (show-trailing-whitespace . t) + (indent-tabs-mode . nil))) diff --git a/elpa/compat-28.1.2.2/NEWS.org b/elpa/compat-28.1.2.2/NEWS.org @@ -0,0 +1,108 @@ +#+options: toc:nil num:nil +#+link: compat https://todo.sr.ht/~pkal/compat/ + +* Release of "Compat" Version 28.1.2.2 + +This is a minor release that hopes to address [[compat:7]]. + +(Release <2022-08-25 Thu>) + +* Release of "Compat" Version 28.1.2.1 + +This is a minor release adding the following changes: + +- Add =derived-mode-p= defined in Emacs 27 +- Add =provided-mode-derived-p= defined in Emacs 27 +- Add =read-multiple-choice= defined in Emacs 26 +- Add =file-name-absolute-p= defined in Emacs 28 + +The only other notable change is that the manual has been rewritten to +include much more documentation that had been the case previously. + +(Release <2022-08-24 Wed>) + +* Release of "Compat" Version 28.1.2.0 + +The main change of this release has been the major simplification of +Compat's initialisation system, improving the situation around issues +people had been reporting ([[compat:4]], once again) with unconventional +or unpopular packaging systems. + +In addition to this, the following functional changes have been made: + +- Fix =format-prompt= of an empty string as "default" argument +- Add =decoded-time-period= defined in Emacs 28 +- Add =subr-primitive-p= defined in Emacs 28 + +Minor improvements to manual are also part of this release. + +(Release <2022-07-18 Mon>) + +* Release of "Compat" Version 28.1.1.3 + +This release just contains a hot-fix for an issue introduced in the +last version, where compat.el raises an error during byte compilation. +See [[compat:4]]. + +(Release <2022-06-19 Sun>) + +* Release of "Compat" Version 28.1.1.2 + +Two main changes have necessitated a new patch release: + +1. Fix issues related to the loading of compat when uncompiled. See + [[https://lists.sr.ht/~pkal/compat-devel/%3C20220530191000.2183047-1-jonas%40bernoul.li%3E][this thread]] for more details on the problem. +2. Fix issues related to the loading of compat on old pre-releases + (think of 28.0.50). See [[https://lists.sr.ht/~pkal/compat-devel/%3Cf8635d7d-e233-448f-b325-9e850363241c%40www.fastmail.com%3E][this thread]] for more details on the + problem. + +(Released <2022-06-22 Wed>) + +* Release of "Compat" Version 28.1.1.1 + +This is a minor release fixing a bug in =json-serialize=, that could +cause unintended side-effects, not related to packages using Compat +directly (see [[compat:2]]). + +(Released <2022-05-05 Thu>) + +* Release of "Compat" Version 28.1.1.0 + +This release mostly fixes a number of smaller bugs that were not +identified as of 28.1.0.0. Nevertheless these warrent a version bump, +as some of these changes a functional. These include: + +- The addition of the =file-attribute-*= accessor functions. +- The addition of =file-attribute-collect=. +- Improvements to the Texinfo manual (via Jonas Bernoulli's recent + work on =ox-texinfo=). For the time being, the Texinfo file is + maintained in the repository itself, next to the =MANUAL= file. + This might change in the future. +- Adding a prefix to =string-trim=, =string-trim-left= and + =string-trim-right= (i.e. now =compat-string-trim=, + =compat-string-trim-left= and =compat-string-trim-right=) +- Improving the version inference used in the =compat-*= macros. + This improves the compile-time optimisation that strips away + functions that are known to be defined for a specific version. +- The addition of generalised variable (=setf=) support for + =compat-alist-get=. +- The addition of =image-property= and generalised variable support + for =image-property=. +- The addition of the function =compat-executable-find=. +- The addition of the function =compat-dired-get-marked-files=. +- The addition of the function =exec-path=. +- The addition of the function =make-lock-file-name=. +- The addition of the function =null-device=. +- The addition of the function =time-equal-p=. +- The addition of the function =date-days-in-month=. +- Handling out-of-directory byte compilation better. +- Fixing the usage and edge-cases of =and-let*=. + +Furthermore a bug tracker was added: https://todo.sr.ht/~pkal/compat, +which is the preferred way to report issues or feature requests. +General problems, questions, etc. are still better discussed on the +development mailing list: https://lists.sr.ht/~pkal/compat-devel. + +(Released <2022-04-22 Fri>) + + diff --git a/elpa/compat-28.1.2.2/compat-24.el b/elpa/compat-28.1.2.2/compat-24.el @@ -0,0 +1,495 @@ +;;; compat-24.el --- Compatibility Layer for Emacs 24.4 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> +;; URL: https://git.sr.ht/~pkal/compat/ +;; Keywords: lisp + +;; 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: + +;; Find here the functionality added in Emacs 24.4, needed by older +;; versions. +;; +;; Only load this library if you need to use one of the following +;; functions: +;; +;; - `compat-=' +;; - `compat-<' +;; - `compat->' +;; - `compat-<=' +;; - `compat->=' +;; - `split-string'. + +;;; Code: + +(require 'compat-macs "compat-macs.el") + +(compat-declare-version "24.4") + +;;;; Defined in data.c + +(compat-defun = (number-or-marker &rest numbers-or-markers) + "Handle multiple arguments." + :prefix t + (catch 'fail + (while numbers-or-markers + (unless (= number-or-marker (car numbers-or-markers)) + (throw 'fail nil)) + (setq number-or-marker (pop numbers-or-markers))) + t)) + +(compat-defun < (number-or-marker &rest numbers-or-markers) + "Handle multiple arguments." + :prefix t + (catch 'fail + (while numbers-or-markers + (unless (< number-or-marker (car numbers-or-markers)) + (throw 'fail nil)) + (setq number-or-marker (pop numbers-or-markers))) + t)) + +(compat-defun > (number-or-marker &rest numbers-or-markers) + "Handle multiple arguments." + :prefix t + (catch 'fail + (while numbers-or-markers + (unless (> number-or-marker (car numbers-or-markers)) + (throw 'fail nil)) + (setq number-or-marker (pop numbers-or-markers))) + t)) + +(compat-defun <= (number-or-marker &rest numbers-or-markers) + "Handle multiple arguments." + :prefix t + (catch 'fail + (while numbers-or-markers + (unless (<= number-or-marker (car numbers-or-markers)) + (throw 'fail nil)) + (setq number-or-marker (pop numbers-or-markers))) + t)) + +(compat-defun >= (number-or-marker &rest numbers-or-markers) + "Handle multiple arguments." + :prefix t + (catch 'fail + (while numbers-or-markers + (unless (>= number-or-marker (pop numbers-or-markers)) + (throw 'fail nil))) + t)) + +(compat-defun bool-vector-exclusive-or (a b &optional c) + "Return A ^ B, bitwise exclusive or. +If optional third argument C is given, store result into C. +A, B, and C must be bool vectors of the same length. +Return the destination vector if it changed or nil otherwise." + (unless (bool-vector-p a) + (signal 'wrong-type-argument (list 'bool-vector-p a))) + (unless (bool-vector-p b) + (signal 'wrong-type-argument (list 'bool-vector-p b))) + (unless (or (null c) (bool-vector-p c)) + (signal 'wrong-type-argument (list 'bool-vector-p c))) + (when (/= (length a) (length b)) + (signal 'wrong-length-argument (list (length a) (length b)))) + (let ((dest (or c (make-bool-vector (length a) nil))) changed) + (when (/= (length a) (length dest)) + (signal 'wrong-length-argument (list (length a) (length dest)))) + (dotimes (i (length dest)) + (let ((val (not (eq (aref a i) (aref b i))))) + (unless (eq val (aref dest i)) + (setq changed t)) + (aset dest i val))) + (if c (and changed c) dest))) + +(compat-defun bool-vector-union (a b &optional c) + "Return A | B, bitwise or. +If optional third argument C is given, store result into C. +A, B, and C must be bool vectors of the same length. +Return the destination vector if it changed or nil otherwise." + (unless (bool-vector-p a) + (signal 'wrong-type-argument (list 'bool-vector-p a))) + (unless (bool-vector-p b) + (signal 'wrong-type-argument (list 'bool-vector-p b))) + (unless (or (null c) (bool-vector-p c)) + (signal 'wrong-type-argument (list 'bool-vector-p c))) + (when (/= (length a) (length b)) + (signal 'wrong-length-argument (list (length a) (length b)))) + (let ((dest (or c (make-bool-vector (length a) nil))) changed) + (when (/= (length a) (length dest)) + (signal 'wrong-length-argument (list (length a) (length dest)))) + (dotimes (i (length dest)) + (let ((val (or (aref a i) (aref b i)))) + (unless (eq val (aref dest i)) + (setq changed t)) + (aset dest i val))) + (if c (and changed c) dest))) + +(compat-defun bool-vector-intersection (a b &optional c) + "Return A & B, bitwise and. +If optional third argument C is given, store result into C. +A, B, and C must be bool vectors of the same length. +Return the destination vector if it changed or nil otherwise." + (unless (bool-vector-p a) + (signal 'wrong-type-argument (list 'bool-vector-p a))) + (unless (bool-vector-p b) + (signal 'wrong-type-argument (list 'bool-vector-p b))) + (unless (or (null c) (bool-vector-p c)) + (signal 'wrong-type-argument (list 'bool-vector-p c))) + (when (/= (length a) (length b)) + (signal 'wrong-length-argument (list (length a) (length b)))) + (let ((dest (or c (make-bool-vector (length a) nil))) changed) + (when (/= (length a) (length dest)) + (signal 'wrong-length-argument (list (length a) (length dest)))) + (dotimes (i (length dest)) + (let ((val (and (aref a i) (aref b i)))) + (unless (eq val (aref dest i)) + (setq changed t)) + (aset dest i val))) + (if c (and changed c) dest))) + +(compat-defun bool-vector-set-difference (a b &optional c) + "Return A &~ B, set difference. +If optional third argument C is given, store result into C. +A, B, and C must be bool vectors of the same length. +Return the destination vector if it changed or nil otherwise." + (unless (bool-vector-p a) + (signal 'wrong-type-argument (list 'bool-vector-p a))) + (unless (bool-vector-p b) + (signal 'wrong-type-argument (list 'bool-vector-p b))) + (unless (or (null c) (bool-vector-p c)) + (signal 'wrong-type-argument (list 'bool-vector-p c))) + (when (/= (length a) (length b)) + (signal 'wrong-length-argument (list (length a) (length b)))) + (let ((dest (or c (make-bool-vector (length a) nil))) changed) + (when (/= (length a) (length dest)) + (signal 'wrong-length-argument (list (length a) (length dest)))) + (dotimes (i (length dest)) + (let ((val (and (aref a i) (not (aref b i))))) + (unless (eq val (aref dest i)) + (setq changed t)) + (aset dest i val))) + (if c (and changed c) dest))) + +(compat-defun bool-vector-not (a &optional b) + "Compute ~A, set complement. +If optional second argument B is given, store result into B. +A and B must be bool vectors of the same length. +Return the destination vector." + (unless (bool-vector-p a) + (signal 'wrong-type-argument (list 'bool-vector-p a))) + (unless (or (null b) (bool-vector-p b)) + (signal 'wrong-type-argument (list 'bool-vector-p b))) + (let ((dest (or b (make-bool-vector (length a) nil)))) + (when (/= (length a) (length dest)) + (signal 'wrong-length-argument (list (length a) (length dest)))) + (dotimes (i (length dest)) + (aset dest i (not (aref a i)))) + dest)) + +(compat-defun bool-vector-subsetp (a b) + "Return t if every t value in A is also t in B, nil otherwise. +A and B must be bool vectors of the same length." + (unless (bool-vector-p a) + (signal 'wrong-type-argument (list 'bool-vector-p a))) + (unless (bool-vector-p b) + (signal 'wrong-type-argument (list 'bool-vector-p b))) + (when (/= (length a) (length b)) + (signal 'wrong-length-argument (list (length a) (length b)))) + (catch 'not-subset + (dotimes (i (length a)) + (when (if (aref a i) (not (aref b i)) nil) + (throw 'not-subset nil))) + t)) + +(compat-defun bool-vector-count-consecutive (a b i) + "Count how many consecutive elements in A equal B starting at I. +A is a bool vector, B is t or nil, and I is an index into A." + (unless (bool-vector-p a) + (signal 'wrong-type-argument (list 'bool-vector-p a))) + (setq b (and b t)) ;normalise to nil or t + (unless (< i (length a)) + (signal 'args-out-of-range (list a i))) + (let ((len (length a)) (n i)) + (while (and (< i len) (eq (aref a i) b)) + (setq i (1+ i))) + (- i n))) + +(compat-defun bool-vector-count-population (a) + "Count how many elements in A are t. +A is a bool vector. To count A's nil elements, subtract the +return value from A's length." + (unless (bool-vector-p a) + (signal 'wrong-type-argument (list 'bool-vector-p a))) + (let ((n 0)) + (dotimes (i (length a)) + (when (aref a i) + (setq n (1+ n)))) + n)) + +;;;; Defined in subr.el + +;;* UNTESTED +(compat-defmacro with-eval-after-load (file &rest body) + "Execute BODY after FILE is loaded. +FILE is normally a feature name, but it can also be a file name, +in case that file does not provide any feature. See `eval-after-load' +for more details about the different forms of FILE and their semantics." + (declare (indent 1) (debug (form def-body))) + ;; See https://nullprogram.com/blog/2018/02/22/ on how + ;; `eval-after-load' is used to preserve compatibility with 24.3. + `(eval-after-load ,file `(funcall ',,`(lambda () ,@body)))) + +(compat-defun special-form-p (object) + "Non-nil if and only if OBJECT is a special form." + (if (and (symbolp object) (fboundp object)) + (setq object (condition-case nil + (indirect-function object) + (void-function nil)))) + (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled))) + +(compat-defun macrop (object) + "Non-nil if and only if OBJECT is a macro." + (let ((def (condition-case nil + (indirect-function object) + (void-function nil)))) + (when (consp def) + (or (eq 'macro (car def)) + (and (autoloadp def) (memq (nth 4 def) '(macro t))))))) + +(compat-defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case))))) + +(compat-defun split-string (string &optional separators omit-nulls trim) + "Extend `split-string' by a TRIM argument. +The remaining arguments STRING, SEPARATORS and OMIT-NULLS are +handled just as with `split-string'." + :prefix t + (let* ((token (split-string string separators omit-nulls)) + (trimmed (if trim + (mapcar + (lambda (token) + (when (string-match (concat "\\`" trim) token) + (setq token (substring token (match-end 0)))) + (when (string-match (concat trim "\\'") token) + (setq token (substring token 0 (match-beginning 0)))) + token) + token) + token))) + (if omit-nulls (delete "" trimmed) trimmed))) + +(compat-defun delete-consecutive-dups (list &optional circular) + "Destructively remove `equal' consecutive duplicates from LIST. +First and last elements are considered consecutive if CIRCULAR is +non-nil." + (let ((tail list) last) + (while (cdr tail) + (if (equal (car tail) (cadr tail)) + (setcdr tail (cddr tail)) + (setq last tail + tail (cdr tail)))) + (if (and circular + last + (equal (car tail) (car list))) + (setcdr last nil))) + list) + +;;* UNTESTED +(compat-defun define-error (name message &optional parent) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such an error +is signaled without being caught by a `condition-case'. +PARENT is either a signal or a list of signals from which it inherits. +Defaults to `error'." + (unless parent (setq parent 'error)) + (let ((conditions + (if (consp parent) + (apply #'append + (mapcar (lambda (parent) + (cons parent + (or (get parent 'error-conditions) + (error "Unknown signal `%s'" parent)))) + parent)) + (cons parent (get parent 'error-conditions))))) + (put name 'error-conditions + (delete-dups (copy-sequence (cons name conditions)))) + (when message (put name 'error-message message)))) + +;;;; Defined in minibuffer.el + +;;* UNTESTED +(compat-defun completion-table-with-cache (fun &optional ignore-case) + "Create dynamic completion table from function FUN, with cache. +This is a wrapper for `completion-table-dynamic' that saves the last +argument-result pair from FUN, so that several lookups with the +same argument (or with an argument that starts with the first one) +only need to call FUN once. This can be useful when FUN performs a +relatively slow operation, such as calling an external process. + +When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive." + (let* (last-arg last-result + (new-fun + (lambda (arg) + (if (and last-arg (string-prefix-p last-arg arg ignore-case)) + last-result + (prog1 + (setq last-result (funcall fun arg)) + (setq last-arg arg)))))) + (completion-table-dynamic new-fun))) + +;;* UNTESTED +(compat-defun completion-table-merge (&rest tables) + "Create a completion table that collects completions from all TABLES." + (lambda (string pred action) + (cond + ((null action) + (let ((retvals (mapcar (lambda (table) + (try-completion string table pred)) + tables))) + (if (member string retvals) + string + (try-completion string + (mapcar (lambda (value) + (if (eq value t) string value)) + (delq nil retvals)) + pred)))) + ((eq action t) + (apply #'append (mapcar (lambda (table) + (all-completions string table pred)) + tables))) + (t + (completion--some (lambda (table) + (complete-with-action action table string pred)) + tables))))) + +;;;; Defined in subr-x.el + +;;* UNTESTED +(compat-advise require (feature &rest args) + "Allow for Emacs 24.x to require the inexistent FEATURE subr-x." + ;; As the compatibility advise around `require` is more a hack than + ;; of of actual value, the highlighting is suppressed. + :no-highlight t + (if (eq feature 'subr-x) + (let ((entry (assq feature after-load-alist))) + (let ((load-file-name nil)) + (dolist (form (cdr entry)) + (funcall (eval form t))))) + (apply oldfun feature args))) + +(compat-defun hash-table-keys (hash-table) + "Return a list of keys in HASH-TABLE." + (let (values) + (maphash + (lambda (k _v) (push k values)) + hash-table) + values)) + +(compat-defun hash-table-values (hash-table) + "Return a list of values in HASH-TABLE." + (let (values) + (maphash + (lambda (_k v) (push v values)) + hash-table) + values)) + +(compat-defun string-empty-p (string) + "Check whether STRING is empty." + (string= string "")) + +(compat-defun string-join (strings &optional separator) + "Join all STRINGS using SEPARATOR. +Optional argument SEPARATOR must be a string, a vector, or a list of +characters; nil stands for the empty string." + (mapconcat #'identity strings separator)) + +(compat-defun string-blank-p (string) + "Check whether STRING is either empty or only whitespace. +The following characters count as whitespace here: space, tab, newline and +carriage return." + (string-match-p "\\`[ \t\n\r]*\\'" string)) + +(compat-defun string-remove-prefix (prefix string) + "Remove PREFIX from STRING if present." + (if (string-prefix-p prefix string) + (substring string (length prefix)) + string)) + +(compat-defun string-remove-suffix (suffix string) + "Remove SUFFIX from STRING if present." + (if (string-suffix-p suffix string) + (substring string 0 (- (length string) (length suffix))) + string)) + +;;;; Defined in faces.el + +;;* UNTESTED +(compat-defun face-spec-set (face spec &optional spec-type) + "Set the FACE's spec SPEC, define FACE, and recalculate its attributes. +See `defface' for the format of SPEC. + +The appearance of each face is controlled by its specs (set via +this function), and by the internal frame-specific face +attributes (set via `set-face-attribute'). + +This function also defines FACE as a valid face name if it is not +already one, and (re)calculates its attributes on existing +frames. + +The optional argument SPEC-TYPE determines which spec to set: + nil, omitted or `face-override-spec' means the override spec, + which overrides all the other types of spec mentioned below + (this is usually what you want if calling this function + outside of Custom code); + `customized-face' or `saved-face' means the customized spec or + the saved custom spec; + `face-defface-spec' means the default spec + (usually set only via `defface'); + `reset' means to ignore SPEC, but clear the `customized-face' + and `face-override-spec' specs; +Any other value means not to set any spec, but to run the +function for defining FACE and recalculating its attributes." + (if (get face 'face-alias) + (setq face (get face 'face-alias))) + ;; Save SPEC to the relevant symbol property. + (unless spec-type + (setq spec-type 'face-override-spec)) + (if (memq spec-type '(face-defface-spec face-override-spec + customized-face saved-face)) + (put face spec-type spec)) + (if (memq spec-type '(reset saved-face)) + (put face 'customized-face nil)) + ;; Setting the face spec via Custom empties out any override spec, + ;; similar to how setting a variable via Custom changes its values. + (if (memq spec-type '(customized-face saved-face reset)) + (put face 'face-override-spec nil)) + ;; If we reset the face based on its custom spec, it is unmodified + ;; as far as Custom is concerned. + (unless (eq face 'face-override-spec) + (put face 'face-modified nil)) + ;; Initialize the face if it does not exist, then recalculate. + (make-empty-face face) + (dolist (frame (frame-list)) + (face-spec-recalc face frame))) + +(compat--inhibit-prefixed (provide 'compat-24)) +;;; compat-24.el ends here diff --git a/elpa/compat-28.1.2.2/compat-25.el b/elpa/compat-28.1.2.2/compat-25.el @@ -0,0 +1,322 @@ +;;; compat-25.el --- Compatibility Layer for Emacs 25.1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> +;; URL: https://git.sr.ht/~pkal/compat/ +;; Keywords: lisp + +;; 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: + +;; Find here the functionality added in Emacs 25.1, needed by older +;; versions. +;; +;; Only load this library if you need to use one of the following +;; functions: +;; +;; - `compat-sort' + +;;; Code: + +(require 'compat-macs "compat-macs.el") + +(compat-declare-version "25.1") + +;;;; Defined in alloc.c + +(compat-defun bool-vector (&rest objects) + "Return a new bool-vector with specified arguments as elements. +Allows any number of arguments, including zero. +usage: (bool-vector &rest OBJECTS)" + (let ((vec (make-bool-vector (length objects) nil)) + (i 0)) + (while objects + (when (car objects) + (aset vec i t)) + (setq objects (cdr objects) + i (1+ i))) + vec)) + +;;;; Defined in fns.c + +(compat-defun sort (seq predicate) + "Extend `sort' to sort SEQ as a vector." + :prefix t + (cond + ((listp seq) + (sort seq predicate)) + ((vectorp seq) + (let ((cseq (sort (append seq nil) predicate))) + (dotimes (i (length cseq)) + (setf (aref seq i) (nth i cseq))) + (apply #'vector cseq))) + ((signal 'wrong-type-argument 'list-or-vector-p)))) + +;;;; Defined in editfns.c + +(compat-defun format-message (string &rest objects) + "Format a string out of a format-string and arguments. +The first argument is a format control string. +The other arguments are substituted into it to make the result, a string. + +This implementation is equivalent to `format'." + (apply #'format string objects)) + +;;;; Defined in minibuf.c + +;; TODO advise read-buffer to handle 4th argument + +;;;; Defined in fileio.c + +(compat-defun directory-name-p (name) + "Return non-nil if NAME ends with a directory separator character." + :realname compat--directory-name-p + (eq (eval-when-compile + (if (memq system-type '(cygwin windows-nt ms-dos)) + ?\\ ?/)) + (aref name (1- (length name))))) + +;;;; Defined in subr.el + +(compat-defun string-greaterp (string1 string2) + "Return non-nil if STRING1 is greater than STRING2 in lexicographic order. +Case is significant. +Symbols are also allowed; their print names are used instead." + (string-lessp string2 string1)) + +;;* UNTESTED +(compat-defmacro with-file-modes (modes &rest body) + "Execute BODY with default file permissions temporarily set to MODES. +MODES is as for `set-default-file-modes'." + (declare (indent 1) (debug t)) + (let ((umask (make-symbol "umask"))) + `(let ((,umask (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes ,modes) + ,@body) + (set-default-file-modes ,umask))))) + +(compat-defun alist-get (key alist &optional default remove testfn) + "Find the first element of ALIST whose `car' equals KEY and return its `cdr'. +If KEY is not found in ALIST, return DEFAULT. +Equality with KEY is tested by TESTFN, defaulting to `eq'." + :realname compat--alist-get-full-elisp + (ignore remove) + (let (entry) + (cond + ((or (null testfn) (eq testfn 'eq)) + (setq entry (assq key alist))) + ((eq testfn 'equal) + (setq entry (assoc key alist))) + ((catch 'found + (dolist (ent alist) + (when (and (consp ent) (funcall testfn (car ent) key)) + (throw 'found (setq entry ent)))) + default))) + (if entry (cdr entry) default))) + +;;;; Defined in subr-x.el + +(compat-defmacro if-let (spec then &rest else) + "Bind variables according to SPEC and evaluate THEN or ELSE. +Evaluate each binding in turn, as in `let*', stopping if a +binding value is nil. If all are non-nil return the value of +THEN, otherwise the last form in ELSE. + +Each element of SPEC is a list (SYMBOL VALUEFORM) that binds +SYMBOL to the value of VALUEFORM. An element can additionally be +of the form (VALUEFORM), which is evaluated and checked for nil; +i.e. SYMBOL can be omitted if only the test result is of +interest. It can also be of the form SYMBOL, then the binding of +SYMBOL is checked for nil. + +As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) +like \((SYMBOL SOMETHING)). This exists for backward compatibility +with an old syntax that accepted only one binding." + :realname compat--if-let + :feature 'subr-x + (declare (indent 2) + (debug ([&or (symbolp form) + (&rest [&or symbolp (symbolp form) (form)])] + body))) + (when (and (<= (length spec) 2) + (not (listp (car spec)))) + ;; Adjust the single binding case + (setq spec (list spec))) + `(compat--if-let* ,spec ,then ,(macroexp-progn else))) + +(compat-defmacro when-let (spec &rest body) + "Bind variables according to SPEC and conditionally evaluate BODY. +Evaluate each binding in turn, stopping if a binding value is nil. +If all are non-nil, return the value of the last form in BODY. + +The variable list SPEC is the same as in `if-let'." + :feature 'subr-x + (declare (indent 1) (debug if-let)) + `(compat--if-let ,spec ,(macroexp-progn body))) + +(compat-defmacro thread-first (&rest forms) + "Thread FORMS elements as the first argument of their successor. +Example: + (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) +Is equivalent to: + (+ (- (/ (+ 5 20) 25)) 40) +Note how the single `-' got converted into a list before +threading." + :feature 'subr-x + (declare (indent 1) + (debug (form &rest [&or symbolp (sexp &rest form)]))) + (let ((body (car forms))) + (dolist (form (cdr forms)) + (when (symbolp form) + (setq form (list form))) + (setq body (append (list (car form)) + (list body) + (cdr form)))) + body)) + +(compat-defmacro thread-last (&rest forms) + "Thread FORMS elements as the last argument of their successor. +Example: + (thread-last + 5 + (+ 20) + (/ 25) + - + (+ 40)) +Is equivalent to: + (+ 40 (- (/ 25 (+ 20 5)))) +Note how the single `-' got converted into a list before +threading." + :feature 'subr-x + (declare (indent 1) (debug thread-first)) + (let ((body (car forms))) + (dolist (form (cdr forms)) + (when (symbolp form) + (setq form (list form))) + (setq body (append form (list body)))) + body)) + +;;;; Defined in macroexp.el + +(declare-function macrop nil (object)) +(compat-defun macroexpand-1 (form &optional environment) + "Perform (at most) one step of macro expansion." + :feature 'macroexp + (cond + ((consp form) + (let* ((head (car form)) + (env-expander (assq head environment))) + (if env-expander + (if (cdr env-expander) + (apply (cdr env-expander) (cdr form)) + form) + (if (not (and (symbolp head) (fboundp head))) + form + (let ((def (autoload-do-load (symbol-function head) head 'macro))) + (cond + ;; Follow alias, but only for macros, otherwise we may end up + ;; skipping an important compiler-macro (e.g. cl--block-wrapper). + ((and (symbolp def) (macrop def)) (cons def (cdr form))) + ((not (consp def)) form) + (t + (if (eq 'macro (car def)) + (apply (cdr def) (cdr form)) + form)))))))) + (t form))) + +;;;; Defined in byte-run.el + +;;* UNTESTED +(compat-defun function-put (func prop value) + "Set FUNCTION's property PROP to VALUE. +The namespace for PROP is shared with symbols. +So far, FUNCTION can only be a symbol, not a lambda expression." + :version "24.4" + (put func prop value)) + +;;;; Defined in files.el + +;;* UNTESTED +(compat-defun directory-files-recursively + (dir regexp &optional include-directories predicate follow-symlinks) + "Return list of all files under directory DIR whose names match REGEXP. +This function works recursively. Files are returned in \"depth +first\" order, and files from each directory are sorted in +alphabetical order. Each file name appears in the returned list +in its absolute form. + +By default, the returned list excludes directories, but if +optional argument INCLUDE-DIRECTORIES is non-nil, they are +included. + +PREDICATE can be either nil (which means that all subdirectories +of DIR are descended into), t (which means that subdirectories that +can't be read are ignored), or a function (which is called with +the name of each subdirectory, and should return non-nil if the +subdirectory is to be descended into). + +If FOLLOW-SYMLINKS is non-nil, symbolic links that point to +directories are followed. Note that this can lead to infinite +recursion." + :realname compat--directory-files-recursively + (let* ((result nil) + (files nil) + (dir (directory-file-name dir)) + ;; When DIR is "/", remote file names like "/method:" could + ;; also be offered. We shall suppress them. + (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir))))) + (dolist (file (sort (file-name-all-completions "" dir) + 'string<)) + (unless (member file '("./" "../")) + (if (directory-name-p file) + (let* ((leaf (substring file 0 (1- (length file)))) + (full-file (concat dir "/" leaf))) + ;; Don't follow symlinks to other directories. + (when (and (or (not (file-symlink-p full-file)) + (and (file-symlink-p full-file) + follow-symlinks)) + ;; Allow filtering subdirectories. + (or (eq predicate nil) + (eq predicate t) + (funcall predicate full-file))) + (let ((sub-files + (if (eq predicate t) + (condition-case nil + (compat--directory-files-recursively + full-file regexp include-directories + predicate follow-symlinks) + (file-error nil)) + (compat--directory-files-recursively + full-file regexp include-directories + predicate follow-symlinks)))) + (setq result (nconc result sub-files)))) + (when (and include-directories + (string-match regexp leaf)) + (setq result (nconc result (list full-file))))) + (when (string-match regexp file) + (push (concat dir "/" file) files))))) + (nconc result (nreverse files)))) + +(compat--inhibit-prefixed (provide 'compat-25)) +;;; compat-25.el ends here diff --git a/elpa/compat-28.1.2.2/compat-26.el b/elpa/compat-28.1.2.2/compat-26.el @@ -0,0 +1,675 @@ +;;; compat-26.el --- Compatibility Layer for Emacs 26.1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> +;; URL: https://git.sr.ht/~pkal/compat/ +;; Keywords: lisp + +;; 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: + +;; Find here the functionality added in Emacs 26.1, needed by older +;; versions. +;; +;; Only load this library if you need to use one of the following +;; functions: +;; +;; - `compat-sort' +;; - `line-number-at-pos' +;; - `compat-alist-get' +;; - `string-trim-left' +;; - `string-trim-right' +;; - `string-trim' + +;;; Code: + +(require 'compat-macs "compat-macs.el") + +(compat-declare-version "26.1") + +;;;; Defined in eval.c + +(compat-defun func-arity (func) + "Return minimum and maximum number of args allowed for FUNC. +FUNC must be a function of some kind. +The returned value is a cons cell (MIN . MAX). MIN is the minimum number +of args. MAX is the maximum number, or the symbol `many', for a +function with `&rest' args, or `unevalled' for a special form." + :realname compat--func-arity + (cond + ((or (null func) (and (symbolp func) (not (fboundp func)))) + (signal 'void-function func)) + ((and (symbolp func) (not (null func))) + (compat--func-arity (symbol-function func))) + ((eq (car-safe func) 'macro) + (compat--func-arity (cdr func))) + ((subrp func) + (subr-arity func)) + ((memq (car-safe func) '(closure lambda)) + ;; See lambda_arity from eval.c + (when (eq (car func) 'closure) + (setq func (cdr func))) + (let ((syms-left (if (consp func) + (car func) + (signal 'invalid-function func))) + (min-args 0) (max-args 0) optional) + (catch 'many + (dolist (next syms-left) + (cond + ((not (symbolp next)) + (signal 'invalid-function func)) + ((eq next '&rest) + (throw 'many (cons min-args 'many))) + ((eq next '&optional) + (setq optional t)) + (t (unless optional + (setq min-args (1+ min-args))) + (setq max-args (1+ max-args))))) + (cons min-args max-args)))) + ((and (byte-code-function-p func) (numberp (aref func 0))) + ;; See get_byte_code_arity from bytecode.c + (let ((at (aref func 0))) + (cons (logand at 127) + (if (= (logand at 128) 0) + (ash at -8) + 'many)))) + ((and (byte-code-function-p func) (numberp (aref func 0))) + ;; See get_byte_code_arity from bytecode.c + (let ((at (aref func 0))) + (cons (logand at 127) + (if (= (logand at 128) 0) + (ash at -8) + 'many)))) + ((and (byte-code-function-p func) (listp (aref func 0))) + ;; Based on `byte-compile-make-args-desc', this is required for + ;; old versions of Emacs that don't use a integer for the argument + ;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6. + (let ((arglist (aref func 0)) (mandatory 0) nonrest) + (while (and arglist (not (memq (car arglist) '(&optional &rest)))) + (setq mandatory (1+ mandatory)) + (setq arglist (cdr arglist))) + (setq nonrest mandatory) + (when (eq (car arglist) '&optional) + (setq arglist (cdr arglist)) + (while (and arglist (not (eq (car arglist) '&rest))) + (setq nonrest (1+ nonrest)) + (setq arglist (cdr arglist)))) + (cons mandatory (if arglist 'many nonrest)))) + ((autoloadp func) + (autoload-do-load func) + (compat--func-arity func)) + ((signal 'invalid-function func)))) + +;;;; Defined in fns.c + +(compat-defun assoc (key alist &optional testfn) + "Handle the optional argument TESTFN. +Equality is defined by the function TESTFN, defaulting to +`equal'. TESTFN is called with 2 arguments: a car of an alist +element and KEY. With no optional argument, the function behaves +just like `assoc'." + :prefix t + (if testfn + (catch 'found + (dolist (ent alist) + (when (funcall testfn (car ent) key) + (throw 'found ent)))) + (assoc key alist))) + +(compat-defun mapcan (func sequence) + "Apply FUNC to each element of SEQUENCE. +Concatenate the results by altering them (using `nconc'). +SEQUENCE may be a list, a vector, a boolean vector, or a string." + (apply #'nconc (mapcar func sequence))) + +;;* UNTESTED +(compat-defun line-number-at-pos (&optional position absolute) + "Handle optional argument ABSOLUTE: + +If the buffer is narrowed, the return value by default counts the lines +from the beginning of the accessible portion of the buffer. But if the +second optional argument ABSOLUTE is non-nil, the value counts the lines +from the absolute start of the buffer, disregarding the narrowing." + :prefix t + (if absolute + (save-restriction + (widen) + (line-number-at-pos position)) + (line-number-at-pos position))) + +;;;; Defined in subr.el + +(declare-function compat--alist-get-full-elisp "compat-25" + (key alist &optional default remove testfn)) +(compat-defun alist-get (key alist &optional default remove testfn) + "Handle TESTFN manually." + :realname compat--alist-get-handle-testfn + :prefix t + (if testfn + (compat--alist-get-full-elisp key alist default remove testfn) + (alist-get key alist default remove))) + +(gv-define-expander compat-alist-get + (lambda (do key alist &optional default remove testfn) + (macroexp-let2 macroexp-copyable-p k key + (gv-letplace (getter setter) alist + (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq))) + (compat-assoc ,k ,getter ,testfn) + (assq ,k ,getter)) + (funcall do (if (null default) `(cdr ,p) + `(if ,p (cdr ,p) ,default)) + (lambda (v) + (macroexp-let2 nil v v + (let ((set-exp + `(if ,p (setcdr ,p ,v) + ,(funcall setter + `(cons (setq ,p (cons ,k ,v)) + ,getter))))) + `(progn + ,(cond + ((null remove) set-exp) + ((or (eql v default) + (and (eq (car-safe v) 'quote) + (eq (car-safe default) 'quote) + (eql (cadr v) (cadr default)))) + `(if ,p ,(funcall setter `(delq ,p ,getter)))) + (t + `(cond + ((not (eql ,default ,v)) ,set-exp) + (,p ,(funcall setter + `(delq ,p ,getter)))))) + ,v)))))))))) + +(compat-defun string-trim-left (string &optional regexp) + "Trim STRING of leading string matching REGEXP. + +REGEXP defaults to \"[ \\t\\n\\r]+\"." + :realname compat--string-trim-left + :prefix t + (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string) + (substring string (match-end 0)) + string)) + +(compat-defun string-trim-right (string &optional regexp) + "Trim STRING of trailing string matching REGEXP. + +REGEXP defaults to \"[ \\t\\n\\r]+\"." + :realname compat--string-trim-right + :prefix t + (let ((i (string-match-p + (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") + string))) + (if i (substring string 0 i) string))) + +(compat-defun string-trim (string &optional trim-left trim-right) + "Trim STRING of leading with and trailing matching TRIM-LEFT and TRIM-RIGHT. + +TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"." + :prefix t + ;; `string-trim-left' and `string-trim-right' were moved from subr-x + ;; to subr in Emacs 27, so to avoid loading subr-x we use the + ;; compatibility function here: + (compat--string-trim-left + (compat--string-trim-right + string + trim-right) + trim-left)) + +(compat-defun caaar (x) + "Return the `car' of the `car' of the `car' of X." + (declare (pure t)) + (car (car (car x)))) + +(compat-defun caadr (x) + "Return the `car' of the `car' of the `cdr' of X." + (declare (pure t)) + (car (car (cdr x)))) + +(compat-defun cadar (x) + "Return the `car' of the `cdr' of the `car' of X." + (declare (pure t)) + (car (cdr (car x)))) + +(compat-defun caddr (x) + "Return the `car' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (car (cdr (cdr x)))) + +(compat-defun cdaar (x) + "Return the `cdr' of the `car' of the `car' of X." + (declare (pure t)) + (cdr (car (car x)))) + +(compat-defun cdadr (x) + "Return the `cdr' of the `car' of the `cdr' of X." + (declare (pure t)) + (cdr (car (cdr x)))) + +(compat-defun cddar (x) + "Return the `cdr' of the `cdr' of the `car' of X." + (declare (pure t)) + (cdr (cdr (car x)))) + +(compat-defun cdddr (x) + "Return the `cdr' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (cdr (cdr (cdr x)))) + +(compat-defun caaaar (x) + "Return the `car' of the `car' of the `car' of the `car' of X." + (declare (pure t)) + (car (car (car (car x))))) + +(compat-defun caaadr (x) + "Return the `car' of the `car' of the `car' of the `cdr' of X." + (declare (pure t)) + (car (car (car (cdr x))))) + +(compat-defun caadar (x) + "Return the `car' of the `car' of the `cdr' of the `car' of X." + (declare (pure t)) + (car (car (cdr (car x))))) + +(compat-defun caaddr (x) + "Return the `car' of the `car' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (car (car (cdr (cdr x))))) + +(compat-defun cadaar (x) + "Return the `car' of the `cdr' of the `car' of the `car' of X." + (declare (pure t)) + (car (cdr (car (car x))))) + +(compat-defun cadadr (x) + "Return the `car' of the `cdr' of the `car' of the `cdr' of X." + (declare (pure t)) + (car (cdr (car (cdr x))))) + +(compat-defun caddar (x) + "Return the `car' of the `cdr' of the `cdr' of the `car' of X." + (declare (pure t)) + (car (cdr (cdr (car x))))) + +(compat-defun cadddr (x) + "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (car (cdr (cdr (cdr x))))) + +(compat-defun cdaaar (x) + "Return the `cdr' of the `car' of the `car' of the `car' of X." + (declare (pure t)) + (cdr (car (car (car x))))) + +(compat-defun cdaadr (x) + "Return the `cdr' of the `car' of the `car' of the `cdr' of X." + (declare (pure t)) + (cdr (car (car (cdr x))))) + +(compat-defun cdadar (x) + "Return the `cdr' of the `car' of the `cdr' of the `car' of X." + (declare (pure t)) + (cdr (car (cdr (car x))))) + +(compat-defun cdaddr (x) + "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (cdr (car (cdr (cdr x))))) + +(compat-defun cddaar (x) + "Return the `cdr' of the `cdr' of the `car' of the `car' of X." + (declare (pure t)) + (cdr (cdr (car (car x))))) + +(compat-defun cddadr (x) + "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." + (declare (pure t)) + (cdr (cdr (car (cdr x))))) + +(compat-defun cdddar (x) + "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." + (declare (pure t)) + (cdr (cdr (cdr (car x))))) + +(compat-defun cddddr (x) + "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (cdr (cdr (cdr (cdr x))))) + +(compat-defvar gensym-counter 0 + "Number used to construct the name of the next symbol created by `gensym'.") + +(compat-defun gensym (&optional prefix) + "Return a new uninterned symbol. +The name is made by appending `gensym-counter' to PREFIX. +PREFIX is a string, and defaults to \"g\"." + (let ((num (prog1 gensym-counter + (setq gensym-counter + (1+ gensym-counter))))) + (make-symbol (format "%s%d" (or prefix "g") num)))) + +;;;; Defined in files.el + +(declare-function temporary-file-directory nil) + +;;* UNTESTED +(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix) + "Create a temporary file as close as possible to `default-directory'. +If PREFIX is a relative file name, and `default-directory' is a +remote file name or located on a mounted file systems, the +temporary file is created in the directory returned by the +function `temporary-file-directory'. Otherwise, the function +`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the +same meaning as in `make-temp-file'." + (let ((handler (find-file-name-handler + default-directory 'make-nearby-temp-file))) + (if (and handler (not (file-name-absolute-p default-directory))) + (funcall handler 'make-nearby-temp-file prefix dir-flag suffix) + (let ((temporary-file-directory (temporary-file-directory))) + (make-temp-file prefix dir-flag suffix))))) + +(compat-defvar mounted-file-systems + (eval-when-compile + (if (memq system-type '(windows-nt cygwin)) + "^//[^/]+/" + (concat + "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))) + "File systems that ought to be mounted.") + +(compat-defun file-local-name (file) + "Return the local name component of FILE. +This function removes from FILE the specification of the remote host +and the method of accessing the host, leaving only the part that +identifies FILE locally on the remote system. +The returned file name can be used directly as argument of +`process-file', `start-file-process', or `shell-command'." + :realname compat--file-local-name + (or (file-remote-p file 'localname) file)) + +(compat-defun file-name-quoted-p (name &optional top) + "Whether NAME is quoted with prefix \"/:\". +If NAME is a remote file name and TOP is nil, check the local part of NAME." + :realname compat--file-name-quoted-p + (let ((file-name-handler-alist (unless top file-name-handler-alist))) + (string-prefix-p "/:" (compat--file-local-name name)))) + +(compat-defun file-name-quote (name &optional top) + "Add the quotation prefix \"/:\" to file NAME. +If NAME is a remote file name and TOP is nil, the local part of +NAME is quoted. If NAME is already a quoted file name, NAME is +returned unchanged." + (let ((file-name-handler-alist (unless top file-name-handler-alist))) + (if (compat--file-name-quoted-p name top) + name + (concat (file-remote-p name) "/:" (compat--file-local-name name))))) + +;;* UNTESTED +(compat-defun temporary-file-directory () + "The directory for writing temporary files. +In case of a remote `default-directory', this is a directory for +temporary files on that remote host. If such a directory does +not exist, or `default-directory' ought to be located on a +mounted file system (see `mounted-file-systems'), the function +returns `default-directory'. +For a non-remote and non-mounted `default-directory', the value of +the variable `temporary-file-directory' is returned." + (let ((handler (find-file-name-handler + default-directory 'temporary-file-directory))) + (if handler + (funcall handler 'temporary-file-directory) + (if (string-match mounted-file-systems default-directory) + default-directory + temporary-file-directory)))) + +;;* UNTESTED +(compat-defun file-attribute-type (attributes) + "The type field in ATTRIBUTES returned by `file-attributes'. +The value is either t for directory, string (name linked to) for +symbolic link, or nil." + (nth 0 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-link-number (attributes) + "Return the number of links in ATTRIBUTES returned by `file-attributes'." + (nth 1 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-user-id (attributes) + "The UID field in ATTRIBUTES returned by `file-attributes'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 2 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-group-id (attributes) + "The GID field in ATTRIBUTES returned by `file-attributes'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 3 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-access-time (attributes) + "The last access time in ATTRIBUTES returned by `file-attributes'. +This a Lisp timestamp in the style of `current-time'." + (nth 4 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-modification-time (attributes) + "The modification time in ATTRIBUTES returned by `file-attributes'. +This is the time of the last change to the file's contents, and +is a Lisp timestamp in the style of `current-time'." + (nth 5 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-status-change-time (attributes) + "The status modification time in ATTRIBUTES returned by `file-attributes'. +This is the time of last change to the file's attributes: owner +and group, access mode bits, etc., and is a Lisp timestamp in the +style of `current-time'." + (nth 6 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-size (attributes) + "The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'." + (nth 7 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-modes (attributes) + "The file modes in ATTRIBUTES returned by `file-attributes'. +This is a string of ten letters or dashes as in ls -l." + (nth 8 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-inode-number (attributes) + "The inode number in ATTRIBUTES returned by `file-attributes'. +It is a nonnegative integer." + (nth 10 attributes)) + +;;* UNTESTED +(compat-defun file-attribute-device-number (attributes) + "The file system device number in ATTRIBUTES returned by `file-attributes'. +It is an integer." + (nth 11 attributes)) + +(compat-defun file-attribute-collect (attributes &rest attr-names) + "Return a sublist of ATTRIBUTES returned by `file-attributes'. +ATTR-NAMES are symbols with the selected attribute names. + +Valid attribute names are: type, link-number, user-id, group-id, +access-time, modification-time, status-change-time, size, modes, +inode-number and device-number." + (let ((idx '((type . 0) + (link-number . 1) + (user-id . 2) + (group-id . 3) + (access-time . 4) + (modification-time . 5) + (status-change-time . 6) + (size . 7) + (modes . 8) + (inode-number . 10) + (device-number . 11))) + result) + (while attr-names + (let ((attr (pop attr-names))) + (if (assq attr idx) + (push (nth (cdr (assq attr idx)) + attributes) + result) + (error "Wrong attribute name '%S'" attr)))) + (nreverse result))) + +;;;; Defined in subr-x.el + +(compat-defmacro if-let* (varlist then &rest else) + "Bind variables according to VARLIST and evaluate THEN or ELSE. +This is like `if-let' but doesn't handle a VARLIST of the form +\(SYMBOL SOMETHING) specially." + :realname compat--if-let* + :feature 'subr-x + (declare (indent 2) + (debug ((&rest [&or symbolp (symbolp form) (form)]) + body))) + (let ((empty (make-symbol "s")) + (last t) list) + (dolist (var varlist) + (push `(,(if (cdr var) (car var) empty) + (and ,last ,(or (cadr var) (car var)))) + list) + (when (or (cdr var) (consp (car var))) + (setq last (caar list)))) + `(let* ,(nreverse list) + (if ,(caar list) ,then ,@else)))) + +(compat-defmacro when-let* (varlist &rest body) + "Bind variables according to VARLIST and conditionally evaluate BODY. +This is like `when-let' but doesn't handle a VARLIST of the form +\(SYMBOL SOMETHING) specially." + ;; :feature 'subr-x + (declare (indent 1) (debug if-let*)) + (let ((empty (make-symbol "s")) + (last t) list) + (dolist (var varlist) + (push `(,(if (cdr var) (car var) empty) + (and ,last ,(or (cadr var) (car var)))) + list) + (when (or (cdr var) (consp (car var))) + (setq last (caar list)))) + `(let* ,(nreverse list) + (when ,(caar list) ,@body)))) + +(compat-defmacro and-let* (varlist &rest body) + "Bind variables according to VARLIST and conditionally evaluate BODY. +Like `when-let*', except if BODY is empty and all the bindings +are non-nil, then the result is non-nil." + :feature 'subr-x + (declare (indent 1) (debug if-let*)) + (let ((empty (make-symbol "s")) + (last t) list) + (dolist (var varlist) + (push `(,(if (cdr var) (car var) empty) + (and ,last ,(or (cadr var) (car var)))) + list) + (when (or (cdr var) (consp (car var))) + (setq last (caar list)))) + `(let* ,(nreverse list) + (if ,(caar list) ,(macroexp-progn (or body '(t))))))) + +;;;; Defined in image.el + +;;* UNTESTED +(compat-defun image-property (image property) + "Return the value of PROPERTY in IMAGE. +Properties can be set with + + (setf (image-property IMAGE PROPERTY) VALUE) + +If VALUE is nil, PROPERTY is removed from IMAGE." + (plist-get (cdr image) property)) + +;;* UNTESTED +(unless (get 'image-property 'gv-expander) + (gv-define-setter image-property (image property value) + (let ((image* (make-symbol "image")) + (property* (make-symbol "property")) + (value* (make-symbol "value"))) + `(let ((,image* ,image) + (,property* ,property) + (,value* ,value)) + (if + (null ,value*) + (while + (cdr ,image*) + (if + (eq + (cadr ,image*) + ,property*) + (setcdr ,image* + (cdddr ,image*)) + (setq ,image* + (cddr ,image*)))) + (setcdr ,image* + (plist-put + (cdr ,image*) + ,property* ,value*))))))) + +;;;; Defined in rmc.el + +;;*UNTESTED +(compat-defun read-multiple-choice + (prompt choices &optional _help-string _show-help long-form) + "Ask user to select an entry from CHOICES, promting with PROMPT. +This function allows to ask the user a multiple-choice question. + +CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). +KEY is a character the user should type to select the entry. +NAME is a short name for the entry to be displayed while prompting +\(if there's no room, it might be shortened). + +If LONG-FORM, do a `completing-read' over the NAME elements in +CHOICES instead." + :note "This is a partial implementation of `read-multiple-choice', that +among other things doesn't offer any help and ignores the +optional DESCRIPTION field." + (if long-form + (let ((options (mapconcat #'cadr choices "/")) + choice) + (setq prompt (concat prompt " (" options "): ")) + (setq choice (completing-read prompt (mapcar #'cadr choices) nil t)) + (catch 'found + (dolist (option choices) + (when (string= choice (cadr option)) + (throw 'found option))) + (error "Invalid choice"))) + (let ((options + (mapconcat + (lambda (opt) + (format + "[%s] %s" + (key-description (string (car opt))) + (cadr opt))) + choices " ")) + choice) + (setq prompt (concat prompt " (" options "): ")) + (while (not (setq choice (assq (read-char prompt) choices))) + (message "Invalid choice") + (sit-for 1)) + choice))) + +(compat--inhibit-prefixed (provide 'compat-26)) +;;; compat-26.el ends here diff --git a/elpa/compat-28.1.2.2/compat-27.el b/elpa/compat-28.1.2.2/compat-27.el @@ -0,0 +1,764 @@ +;;; compat-27.el --- Compatibility Layer for Emacs 27.1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> +;; URL: https://git.sr.ht/~pkal/compat/ +;; Keywords: lisp + +;; 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: + +;; Find here the functionality added in Emacs 27.1, needed by older +;; versions. +;; +;; Only load this library if you need to use one of the following +;; functions or macros: +;; +;; - `compat-recenter' +;; - `compat-lookup-key' +;; - `compat-setq-local' +;; - `compat-assoc-delete-all' +;; - `compat-file-size-human-readable' +;; - `compat-executable-find' +;; - `compat-regexp-opt' +;; - `compat-dired-get-marked-files' + +;;; Code: + +(require 'compat-macs "compat-macs.el") + +(compat-declare-version "27.1") + +;;;; Defined in fns.c + +(compat-defun proper-list-p (object) + "Return OBJECT's length if it is a proper list, nil otherwise. +A proper list is neither circular nor dotted (i.e., its last cdr +is nil)." + :min-version "26.1" + :max-version "26.3" + :realname compat--proper-list-p-length-signal + (condition-case nil + (and (listp object) (length object)) + (wrong-type-argument nil) + (circular-list nil))) + +(compat-defun proper-list-p (object) + "Return OBJECT's length if it is a proper list, nil otherwise. +A proper list is neither circular nor dotted (i.e., its last cdr +is nil)." + :max-version "25.3" + :realname compat--proper-list-p-tortoise-hare + (when (listp object) + (catch 'cycle + (let ((hare object) (tortoise object) + (max 2) (q 2)) + (while (consp hare) + (setq hare (cdr hare)) + (when (and (or (/= 0 (setq q (1- q))) + (ignore + (setq max (ash max 1) + q max + tortoise hare))) + (eq hare tortoise)) + (throw 'cycle nil))) + (and (null hare) (length object)))))) + +(compat-defun string-distance (string1 string2 &optional bytecompare) + "Return Levenshtein distance between STRING1 and STRING2. +The distance is the number of deletions, insertions, and substitutions +required to transform STRING1 into STRING2. +If BYTECOMPARE is nil or omitted, compute distance in terms of characters. +If BYTECOMPARE is non-nil, compute distance in terms of bytes. +Letter-case is significant, but text properties are ignored." + ;; https://en.wikipedia.org/wiki/Levenshtein_distance + (let ((s1 (if bytecompare + (encode-coding-string string1 'raw-text) + (concat string1 ""))) + (s2 (if bytecompare + (encode-coding-string string2 'raw-text) + string2))) + (let* ((len1 (length s1)) + (len2 (length s2)) + (column (make-vector (1+ len1) 0))) + (dotimes (y len1) + (setf (aref column (1+ y)) y)) + (dotimes (x len2) + (setf (aref column 0) (1+ x)) + (let ((lastdiag x) olddiag) + (dotimes (y len1) + (setf olddiag (aref column (1+ y)) + (aref column (1+ y)) + (min (+ (if (= (aref s1 y) (aref s2 x)) 0 1) + lastdiag) + (1+ (aref column (1+ y))) + (1+ (aref column y))) + lastdiag olddiag)))) + (aref column len1)))) + +;;;; Defined in window.c + +(compat-defun recenter (&optional arg redisplay) + "Handle optional argument REDISPLAY." + :prefix t + (recenter arg) + (when (and redisplay recenter-redisplay) + (redisplay))) + +;;;; Defined in keymap.c + +(compat-defun lookup-key (keymap key &optional accept-default) + "Allow for KEYMAP to be a list of keymaps." + :prefix t + (cond + ((keymapp keymap) + (lookup-key keymap key accept-default)) + ((listp keymap) + (catch 'found + (dolist (map keymap) + (let ((fn (lookup-key map key accept-default))) + (when fn (throw 'found fn)))))) + ((signal 'wrong-type-argument (list 'keymapp keymap))))) + +;;;; Defined in json.c + +(declare-function json-parse-string nil (string &rest args)) +(declare-function json-encode "json" (object)) +(declare-function json-read-from-string "json" (string)) +(declare-function json-read "json" ()) +(defvar json-encoding-pretty-print) +(defvar json-object-type) +(defvar json-array-type) +(defvar json-false) +(defvar json-null) + +;; The function is declared to satisfy the byte compiler while testing +;; if native JSON parsing is available.; +(declare-function json-serialize nil (object &rest args)) +(compat-defun json-serialize (object &rest args) + "Return the JSON representation of OBJECT as a string. + +OBJECT must be t, a number, string, vector, hashtable, alist, plist, +or the Lisp equivalents to the JSON null and false values, and its +elements must recursively consist of the same kinds of values. t will +be converted to the JSON true value. Vectors will be converted to +JSON arrays, whereas hashtables, alists and plists are converted to +JSON objects. Hashtable keys must be strings without embedded null +characters and must be unique within each object. Alist and plist +keys must be symbols; if a key is duplicate, the first instance is +used. + +The Lisp equivalents to the JSON null and false values are +configurable in the arguments ARGS, a list of keyword/argument pairs: + +The keyword argument `:null-object' specifies which object to use +to represent a JSON null value. It defaults to `:null'. + +The keyword argument `:false-object' specifies which object to use to +represent a JSON false value. It defaults to `:false'. + +In you specify the same value for `:null-object' and `:false-object', +a potentially ambiguous situation, the JSON output will not contain +any JSON false values." + :cond (not (condition-case nil + (equal (json-serialize '()) "{}") + (:success t) + (void-function nil) + (json-unavailable nil))) + :realname compat--json-serialize + (require 'json) + (letrec ((fix (lambda (obj) + (cond + ((hash-table-p obj) + (let ((ht (copy-hash-table obj))) + (maphash + (lambda (key val) + (unless (stringp key) + (signal + 'wrong-type-argument + (list 'stringp key))) + (puthash key (funcall fix val) ht)) + obj) + ht)) + ((and (listp obj) (consp (car obj))) ;alist + (mapcar + (lambda (ent) + (cons (symbol-name (car ent)) + (funcall fix (cdr ent)))) + obj)) + ((listp obj) ;plist + (let (alist) + (while obj + (push (cons (cond + ((keywordp (car obj)) + (substring + (symbol-name (car obj)) + 1)) + ((symbolp (car obj)) + (symbol-name (car obj))) + ((signal + 'wrong-type-argument + (list 'symbolp (car obj))))) + (funcall fix (cadr obj))) + alist) + (unless (consp (cdr obj)) + (signal 'wrong-type-argument '(consp nil))) + (setq obj (cddr obj))) + (nreverse alist))) + ((vectorp obj) + (let ((vec (make-vector (length obj) nil))) + (dotimes (i (length obj)) + (aset vec i (funcall fix (aref obj i)))) + vec)) + (obj)))) + (json-encoding-pretty-print nil) + (json-false (or (plist-get args :false-object) :false)) + (json-null (or (plist-get args :null-object) :null))) + (json-encode (funcall fix object)))) + +(compat-defun json-insert (object &rest args) + "Insert the JSON representation of OBJECT before point. +This is the same as (insert (json-serialize OBJECT)), but potentially +faster. See the function `json-serialize' for allowed values of +OBJECT." + :cond (not (condition-case nil + (equal (json-serialize '()) "{}") + (:success t) + (void-function nil) + (json-unavailable nil))) + (insert (apply #'compat--json-serialize object args))) + +(compat-defun json-parse-string (string &rest args) + "Parse the JSON STRING into a Lisp object. +This is essentially the reverse operation of `json-serialize', which +see. The returned object will be the JSON null value, the JSON false +value, t, a number, a string, a vector, a list, a hashtable, an alist, +or a plist. Its elements will be further objects of these types. If +there are duplicate keys in an object, all but the last one are +ignored. If STRING doesn't contain a valid JSON object, this function +signals an error of type `json-parse-error'. + +The arguments ARGS are a list of keyword/argument pairs: + +The keyword argument `:object-type' specifies which Lisp type is used +to represent objects; it can be `hash-table', `alist' or `plist'. It +defaults to `hash-table'. + +The keyword argument `:array-type' specifies which Lisp type is used +to represent arrays; it can be `array' (the default) or `list'. + +The keyword argument `:null-object' specifies which object to use +to represent a JSON null value. It defaults to `:null'. + +The keyword argument `:false-object' specifies which object to use to +represent a JSON false value. It defaults to `:false'." + :cond (not (condition-case nil + (equal (json-serialize '()) "{}") + (:success t) + (void-function nil) + (json-unavailable nil))) + (require 'json) + (condition-case err + (let ((json-object-type (or (plist-get args :object-type) 'hash-table)) + (json-array-type (or (plist-get args :array-type) 'vector)) + (json-false (or (plist-get args :false-object) :false)) + (json-null (or (plist-get args :null-object) :null))) + (when (eq json-array-type 'array) + (setq json-array-type 'vector)) + (json-read-from-string string)) + (json-error (signal 'json-parse-error err)))) + +(compat-defun json-parse-buffer (&rest args) + "Read JSON object from current buffer starting at point. +Move point after the end of the object if parsing was successful. +On error, don't move point. + +The returned object will be a vector, list, hashtable, alist, or +plist. Its elements will be the JSON null value, the JSON false +value, t, numbers, strings, or further vectors, lists, hashtables, +alists, or plists. If there are duplicate keys in an object, all +but the last one are ignored. + +If the current buffer doesn't contain a valid JSON object, the +function signals an error of type `json-parse-error'. + +The arguments ARGS are a list of keyword/argument pairs: + +The keyword argument `:object-type' specifies which Lisp type is used +to represent objects; it can be `hash-table', `alist' or `plist'. It +defaults to `hash-table'. + +The keyword argument `:array-type' specifies which Lisp type is used +to represent arrays; it can be `array' (the default) or `list'. + +The keyword argument `:null-object' specifies which object to use +to represent a JSON null value. It defaults to `:null'. + +The keyword argument `:false-object' specifies which object to use to +represent a JSON false value. It defaults to `:false'." + :cond (not (condition-case nil + (equal (json-serialize '()) "{}") + (:success t) + (void-function nil) + (json-unavailable nil))) + (require 'json) + (condition-case err + (let ((json-object-type (or (plist-get args :object-type) 'hash-table)) + (json-array-type (or (plist-get args :array-type) 'vector)) + (json-false (or (plist-get args :false-object) :false)) + (json-null (or (plist-get args :null-object) :null))) + (when (eq json-array-type 'array) + (setq json-array-type 'vector)) + (json-read)) + (json-error (signal 'json-parse-buffer err)))) + +;;;; Defined in timefns.c + +(compat-defun time-equal-p (t1 t2) + "Return non-nil if time value T1 is equal to time value T2. +A nil value for either argument stands for the current time." + :note "This function is not as accurate as the actual `time-equal-p'." + (cond + ((eq t1 t2)) + ((and (consp t1) (consp t2)) + (equal t1 t2)) + ((let ((now (current-time))) + ;; Due to inaccuracies and the relatively slow evaluating of + ;; Emacs Lisp compared to C, we allow for slight inaccuracies + ;; (less than a millisecond) when comparing time values. + (< (abs (- (float-time (or t1 now)) + (float-time (or t2 now)))) + 1e-5))))) + +;;;; Defined in fileio.c + +(compat-defun file-name-absolute-p (filename) + "Return t if FILENAME is an absolute file name. +On Unix, absolute file names start with `/'. In Emacs, an absolute +file name can also start with an initial `~' or `~USER' component, +where USER is a valid login name." + ;; See definitions in filename.h + (let ((seperator + (eval-when-compile + (if (memq system-type '(cygwin windows-nt ms-dos)) + "[\\/]" "/"))) + (drive + (eval-when-compile + (cond + ((memq system-type '(windows-nt ms-dos)) + "\\`[A-Za-z]:[\\/]") + ((eq system-type 'cygwin) + "\\`\\([\\/]\\|[A-Za-z]:\\)") + ("\\`/")))) + (home + (eval-when-compile + (if (memq system-type '(cygwin windows-nt ms-dos)) + "\\`~[\\/]" "\\`~/"))) + (user-home + (eval-when-compile + (format "\\`\\(~.*?\\)\\(%s.*\\)?$" + (if (memq system-type '(cygwin windows-nt ms-dos)) + "[\\/]" "/"))))) + (or (and (string-match-p drive filename) t) + (and (string-match-p home filename) t) + (save-excursion + (when (string-match user-home filename) + (let ((init (match-string 1 filename))) + (not (string= + (file-name-base (expand-file-name init)) + init)))))))) + +;;;; Defined in subr.el + +(compat-defmacro setq-local (&rest pairs) + "Handle multiple assignments." + :prefix t + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + (let (body) + (while pairs + (let* ((sym (pop pairs)) + (val (pop pairs))) + (unless (symbolp sym) + (error "Attempting to set a non-symbol: %s" (car pairs))) + (push `(set (make-local-variable ,sym) ,val) + body))) + (cons 'progn (nreverse body)))) + +(compat-defun provided-mode-derived-p (mode &rest modes) + "Non-nil if MODE is derived from one of MODES. +Uses the `derived-mode-parent' property of the symbol to trace backwards. +If you just want to check `major-mode', use `derived-mode-p'." + :realname compat--provided-mode-derived-p + ;; If MODE is an alias, then look up the real mode function first. + (let ((alias (symbol-function mode))) + (when (and alias (symbolp alias)) + (setq mode alias))) + (while + (and + (not (memq mode modes)) + (let* ((parent (get mode 'derived-mode-parent)) + (parentfn (symbol-function parent))) + (setq mode (if (and parentfn (symbolp parentfn)) parentfn parent))))) + mode) + +;;* UNTESTED +(defun derived-mode-p (&rest modes) + "Non-nil if the current major mode is derived from one of MODES. +Uses the `derived-mode-parent' property of the symbol to trace backwards." + (apply #'compat--provided-mode-derived-p major-mode modes)) + +;;* UNTESTED +(compat-defmacro ignore-error (condition &rest body) + "Execute BODY; if the error CONDITION occurs, return nil. +Otherwise, return result of last form in BODY. + +CONDITION can also be a list of error conditions." + (declare (debug t) (indent 1)) + `(condition-case nil (progn ,@body) (,condition nil))) + +;;* UNTESTED +(compat-defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body) + "Loop over a list and report progress in the echo area. +Evaluate BODY with VAR bound to each car from LIST, in turn. +Then evaluate RESULT to get return value, default nil. + +REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter +case, use this string to create a progress reporter. + +At each iteration, print the reporter message followed by progress +percentage in the echo area. After the loop is finished, +print the reporter message followed by the word \"done\". + +\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)" + (declare (indent 2) (debug ((symbolp form &optional form) form body))) + (let ((prep (make-symbol "--dolist-progress-reporter--")) + (count (make-symbol "--dolist-count--")) + (list (make-symbol "--dolist-list--"))) + `(let ((,prep ,reporter-or-message) + (,count 0) + (,list ,(cadr spec))) + (when (stringp ,prep) + (setq ,prep (make-progress-reporter ,prep 0 (1- (length ,list))))) + (dolist (,(car spec) ,list) + ,@body + (progress-reporter-update ,prep (setq ,count (1+ ,count)))) + (progress-reporter-done ,prep) + (or ,@(cdr (cdr spec)) nil)))) + +(compat-defun flatten-tree (tree) + "Return a \"flattened\" copy of TREE. +In other words, return a list of the non-nil terminal nodes, or +leaves, of the tree of cons cells rooted at TREE. Leaves in the +returned list are in the same order as in TREE. + +\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7)) +=> (1 2 3 4 5 6 7)" + (let (elems) + (while (consp tree) + (let ((elem (pop tree))) + (while (consp elem) + (push (cdr elem) tree) + (setq elem (car elem))) + (if elem (push elem elems)))) + (if tree (push tree elems)) + (nreverse elems))) + +(compat-defun xor (cond1 cond2) + "Return the boolean exclusive-or of COND1 and COND2. +If only one of the arguments is non-nil, return it; otherwise +return nil." + (declare (pure t) (side-effect-free error-free)) + (cond ((not cond1) cond2) + ((not cond2) cond1))) + +(compat-defvar regexp-unmatchable "\\`a\\`" + "Standard regexp guaranteed not to match any string at all." + :constant t) + +(compat-defun assoc-delete-all (key alist &optional test) + "Delete from ALIST all elements whose car is KEY. +Compare keys with TEST. Defaults to `equal'. +Return the modified alist. +Elements of ALIST that are not conses are ignored." + :prefix t + (unless test (setq test #'equal)) + (while (and (consp (car alist)) + (funcall test (caar alist) key)) + (setq alist (cdr alist))) + (let ((tail alist) tail-cdr) + (while (setq tail-cdr (cdr tail)) + (if (and (consp (car tail-cdr)) + (funcall test (caar tail-cdr) key)) + (setcdr tail (cdr tail-cdr)) + (setq tail tail-cdr)))) + alist) + +;;;; Defined in simple.el + +;;* UNTESTED +(compat-defun decoded-time-second (time) + "The seconds in TIME, which is a value returned by `decode-time'. +This is an integer between 0 and 60 (inclusive). (60 is a leap +second, which only some operating systems support.)" + (nth 0 time)) + +;;* UNTESTED +(compat-defun decoded-time-minute (time) + "The minutes in TIME, which is a value returned by `decode-time'. +This is an integer between 0 and 59 (inclusive)." + (nth 1 time)) + +;;* UNTESTED +(compat-defun decoded-time-hour (time) + "The hours in TIME, which is a value returned by `decode-time'. +This is an integer between 0 and 23 (inclusive)." + (nth 2 time)) + +;;* UNTESTED +(compat-defun decoded-time-day (time) + "The day-of-the-month in TIME, which is a value returned by `decode-time'. +This is an integer between 1 and 31 (inclusive)." + (nth 3 time)) + +;;* UNTESTED +(compat-defun decoded-time-month (time) + "The month in TIME, which is a value returned by `decode-time'. +This is an integer between 1 and 12 (inclusive). January is 1." + (nth 4 time)) + +;;* UNTESTED +(compat-defun decoded-time-year (time) + "The year in TIME, which is a value returned by `decode-time'. +This is a four digit integer." + (nth 5 time)) + +;;* UNTESTED +(compat-defun decoded-time-weekday (time) + "The day-of-the-week in TIME, which is a value returned by `decode-time'. +This is a number between 0 and 6, and 0 is Sunday." + (nth 6 time)) + +;;* UNTESTED +(compat-defun decoded-time-dst (time) + "The daylight saving time in TIME, which is a value returned by `decode-time'. +This is t if daylight saving time is in effect, and nil if not." + (nth 7 time)) + +;;* UNTESTED +(compat-defun decoded-time-zone (time) + "The time zone in TIME, which is a value returned by `decode-time'. +This is an integer indicating the UTC offset in seconds, i.e., +the number of seconds east of Greenwich." + (nth 8 time)) + +;; TODO define gv-setters + +;;;; Defined in files.el + +(compat-defun file-size-human-readable (file-size &optional flavor space unit) + "Handle the optional third and forth argument: + +Optional third argument SPACE is a string put between the number and unit. +It defaults to the empty string. We recommend a single space or +non-breaking space, unless other constraints prohibit a space in that +position. + +Optional fourth argument UNIT is the unit to use. It defaults to \"B\" +when FLAVOR is `iec' and the empty string otherwise. We recommend \"B\" +in all cases, since that is the standard symbol for byte." + :prefix t + (let ((power (if (or (null flavor) (eq flavor 'iec)) + 1024.0 + 1000.0)) + (prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y"))) + (while (and (>= file-size power) (cdr prefixes)) + (setq file-size (/ file-size power) + prefixes (cdr prefixes))) + (let* ((prefix (car prefixes)) + (prefixed-unit (if (eq flavor 'iec) + (concat + (if (string= prefix "k") "K" prefix) + (if (string= prefix "") "" "i") + (or unit "B")) + (concat prefix unit)))) + (format (if (and (>= (mod file-size 1.0) 0.05) + (< (mod file-size 1.0) 0.95)) + "%.1f%s%s" + "%.0f%s%s") + file-size + (if (string= prefixed-unit "") "" (or space "")) + prefixed-unit)))) + +(declare-function compat--file-name-quote "compat-26" + (name &optional top)) + +;;*UNTESTED +(compat-defun exec-path () + "Return list of directories to search programs to run in remote subprocesses. +The remote host is identified by `default-directory'. For remote +hosts that do not support subprocesses, this returns nil. +If `default-directory' is a local directory, this function returns +the value of the variable `exec-path'." + :realname compat--exec-path + (cond + ((let ((handler (find-file-name-handler default-directory 'exec-path))) + ;; FIXME: The handler was added in 27.1, and this compatibility + ;; function only applies to versions of Emacs before that. + (when handler + (condition-case nil + (funcall handler 'exec-path) + (error nil))))) + ((file-remote-p default-directory) + ;; TODO: This is not completely portable, even if "sh" and + ;; "getconf" should be provided on every POSIX system, the chance + ;; of this not working are greater than zero. + ;; + ;; FIXME: This invokes a shell process every time exec-path is + ;; called. It should instead be cached on a host-local basis. + (with-temp-buffer + (if (condition-case nil + (zerop (process-file "sh" nil t nil "-c" "getconf PATH")) + (file-missing t)) + (list "/bin" "/usr/bin") + (let (path) + (while (re-search-forward "\\([^:]+?\\)[\n:]" nil t) + (push (match-string 1) path)) + (nreverse path))))) + (exec-path))) + +(declare-function compat--file-local-name "compat-26" + (file)) + +;;*UNTESTED +(compat-defun executable-find (command &optional remote) + "Search for COMMAND in `exec-path' and return the absolute file name. +Return nil if COMMAND is not found anywhere in `exec-path'. If +REMOTE is non-nil, search on the remote host indicated by +`default-directory' instead." + :prefix t + (if (and remote (file-remote-p default-directory)) + (let ((res (locate-file + command + (mapcar + (apply-partially + #'concat (file-remote-p default-directory)) + (compat--exec-path)) + exec-suffixes 'file-executable-p))) + (when (stringp res) (compat--file-local-name res))) + (executable-find command))) + +;; TODO provide advice for directory-files-recursively + +;;;; Defined in format-spec.el + +;; TODO provide advice for format-spec + +;;;; Defined in regexp-opt.el + +(compat-defun regexp-opt (strings &optional paren) + "Handle an empty list of strings." + :prefix t + (if (null strings) + (let ((re "\\`a\\`")) + (cond ((null paren) + (concat "\\(?:" re "\\)")) + ((stringp paren) + (concat paren re "\\)")) + ((eq paren 'words) + (concat "\\<\\(" re "\\)\\>")) + ((eq paren 'symbols) + (concat "\\_\\(<" re "\\)\\_>")) + ((concat "\\(" re "\\)")))) + (regexp-opt strings paren))) + +;;;; Defined in package.el + +(declare-function lm-header "lisp-mnt") + +;;* UNTESTED +(compat-defun package-get-version () + "Return the version number of the package in which this is used. +Assumes it is used from an Elisp file placed inside the top-level directory +of an installed ELPA package. +The return value is a string (or nil in case we can’t find it)." + ;; In a sense, this is a lie, but it does just what we want: precompute + ;; the version at compile time and hardcodes it into the .elc file! + (declare (pure t)) + ;; Hack alert! + (let ((file + (or (and (boundp 'byte-compile-current-file) byte-compile-current-file) + load-file-name + buffer-file-name))) + (cond + ((null file) nil) + ;; Packages are normally installed into directories named "<pkg>-<vers>", + ;; so get the version number from there. + ((string-match + "/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'" + file) + (match-string 1 file)) + ;; For packages run straight from the an elpa.git clone, there's no + ;; "-<vers>" in the directory name, so we have to fetch the version + ;; the hard way. + ((let* ((pkgdir (file-name-directory file)) + (pkgname (file-name-nondirectory (directory-file-name pkgdir))) + (mainfile (expand-file-name (concat pkgname ".el") pkgdir))) + (when (file-readable-p mainfile) + (require 'lisp-mnt) + (with-temp-buffer + (insert-file-contents mainfile) + (or (lm-header "package-version") + (lm-header "version"))))))))) + + +;;;; Defined in dired.el + +(declare-function + dired-get-marked-files "dired.el" + (&optional localp arg filter distinguish-one-marked error)) + +;;* UNTESTED +(compat-defun dired-get-marked-files + (&optional localp arg filter distinguish-one-marked error) + "Return the marked files’ names as list of strings." + :feature 'dired + :prefix t + (let ((result (dired-get-marked-files localp arg filter distinguish-one-marked))) + (if (and (null result) error) + (user-error (if (stringp error) error "No files specified")) + result))) + +;;;; Defined in time-date.el + +(compat-defun date-days-in-month (year month) + "The number of days in MONTH in YEAR." + :feature 'time-date + (unless (and (numberp month) + (<= 1 month) + (<= month 12)) + (error "Month %s is invalid" month)) + (if (= month 2) + (if (date-leap-year-p year) + 29 + 28) + (if (memq month '(1 3 5 7 8 10 12)) + 31 + 30))) + +(compat--inhibit-prefixed (provide 'compat-27)) +;;; compat-27.el ends here diff --git a/elpa/compat-28.1.2.2/compat-28.el b/elpa/compat-28.1.2.2/compat-28.el @@ -0,0 +1,882 @@ +;;; compat-28.el --- Compatibility Layer for Emacs 28.1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> +;; URL: https://git.sr.ht/~pkal/compat/ +;; Keywords: lisp + +;; 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: + +;; Find here the functionality added in Emacs 28.1, needed by older +;; versions. +;; +;; Only load this library if you need to use one of the following +;; functions: +;; +;; - `unlock-buffer' +;; - `string-width' +;; - `directory-files' +;; - `json-serialize' +;; - `json-insert' +;; - `json-parse-string' +;; - `json-parse-buffer' +;; - `count-windows' + +;;; Code: + +(require 'compat-macs "compat-macs.el") + +(compat-declare-version "28.1") + +;;;; Defined in fns.c + +;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions +(compat-defun string-search (needle haystack &optional start-pos) + "Search for the string NEEDLE in the strign HAYSTACK. + +The return value is the position of the first occurrence of +NEEDLE in HAYSTACK, or nil if no match was found. + +The optional START-POS argument says where to start searching in +HAYSTACK and defaults to zero (start at the beginning). +It must be between zero and the length of HAYSTACK, inclusive. + +Case is always significant and text properties are ignored." + :note "Prior to Emacs 27 `string-match' has issues handling +multibyte regular expressions. As the compatibility function +for `string-search' is implemented via `string-match', these +issues are inherited." + (when (and start-pos (or (< (length haystack) start-pos) + (< start-pos 0))) + (signal 'args-out-of-range (list start-pos))) + (save-match-data + (let ((case-fold-search nil)) + (string-match (regexp-quote needle) haystack start-pos)))) + +(compat-defun length= (sequence length) + "Returns non-nil if SEQUENCE has a length equal to LENGTH." + (cond + ((null sequence) (zerop length)) + ((consp sequence) + (and (null (nthcdr length sequence)) + (nthcdr (1- length) sequence) + t)) + ((arrayp sequence) + (= (length sequence) length)) + ((signal 'wrong-type-argument sequence)))) + +(compat-defun length< (sequence length) + "Returns non-nil if SEQUENCE is shorter than LENGTH." + (cond + ((null sequence) (not (zerop length))) + ((listp sequence) + (null (nthcdr (1- length) sequence))) + ((arrayp sequence) + (< (length sequence) length)) + ((signal 'wrong-type-argument sequence)))) + +(compat-defun length> (sequence length) + "Returns non-nil if SEQUENCE is longer than LENGTH." + (cond + ((listp sequence) + (and (nthcdr length sequence) t)) + ((arrayp sequence) + (> (length sequence) length)) + ((signal 'wrong-type-argument sequence)))) + +;;;; Defined in fileio.c + +(compat-defun file-name-concat (directory &rest components) + "Append COMPONENTS to DIRECTORY and return the resulting string. +Elements in COMPONENTS must be a string or nil. +DIRECTORY or the non-final elements in COMPONENTS may or may not end +with a slash -- if they don’t end with a slash, a slash will be +inserted before contatenating." + (let ((seperator (eval-when-compile + (if (memq system-type '(ms-dos windows-nt cygwin)) + "\\" "/"))) + (last (if components (car (last components)) directory))) + (mapconcat (lambda (part) + (if (eq part last) ;the last component is not modified + last + (replace-regexp-in-string + (concat seperator "+\\'") "" part))) + (cons directory components) + seperator))) + +;;;; Defined in alloc.c + +;;* UNTESTED (but also not necessary) +(compat-defun garbage-collect-maybe (_factor) + "Call ‘garbage-collect’ if enough allocation happened. +FACTOR determines what \"enough\" means here: If FACTOR is a +positive number N, it means to run GC if more than 1/Nth of the +allocations needed to trigger automatic allocation took place. +Therefore, as N gets higher, this is more likely to perform a GC. +Returns non-nil if GC happened, and nil otherwise." + :note "For releases of Emacs before version 28, this function will do nothing." + ;; Do nothing + nil) + +;;;; Defined in filelock.c + +(compat-defun unlock-buffer () + "Handle `file-error' conditions: + +Handles file system errors by calling ‘display-warning’ and +continuing as if the error did not occur." + :prefix t + (condition-case error + (unlock-buffer) + (file-error + (display-warning + '(unlock-file) + (message "%s, ignored" (error-message-string error)) + :warning)))) + +;;;; Defined in characters.c + +(compat-defun string-width (string &optional from to) + "Handle optional arguments FROM and TO: + +Optional arguments FROM and TO specify the substring of STRING to +consider, and are interpreted as in `substring'." + :prefix t + (let* ((len (length string)) + (from (or from 0)) + (to (or to len))) + (if (and (= from 0) (= to len)) + (string-width string) + (string-width (substring string from to))))) + +;;;; Defined in dired.c + +;;* UNTESTED +(compat-defun directory-files (directory &optional full match nosort count) + "Handle additional optional argument COUNT: + +If COUNT is non-nil and a natural number, the function will + return COUNT number of file names (if so many are present)." + :prefix t + (let ((files (directory-files directory full match nosort))) + (when (natnump count) + (setf (nthcdr count files) nil)) + files)) + +;;;; Defined in json.c + +(declare-function json-insert nil (object &rest args)) +(declare-function json-serialize nil (object &rest args)) +(declare-function json-parse-string nil (string &rest args)) +(declare-function json-parse-buffer nil (&rest args)) + +(compat-defun json-serialize (object &rest args) + "Handle top-level JSON values." + :prefix t + :min-version "27" + (if (or (listp object) (vectorp object)) + (apply #'json-serialize object args) + (substring (json-serialize (list object)) 1 -1))) + +(compat-defun json-insert (object &rest args) + "Handle top-level JSON values." + :prefix t + :min-version "27" + (if (or (listp object) (vectorp object)) + (apply #'json-insert object args) + ;; `compat-json-serialize' is not sharp-quoted as the byte + ;; compiled doesn't always know that the function has been + ;; defined, but it will only be used in this function if the + ;; prefixed definition of `json-serialize' (see above) has also + ;; been defined. + (insert (apply 'compat-json-serialize object args)))) + +(compat-defun json-parse-string (string &rest args) + "Handle top-level JSON values." + :prefix t + :min-version "27" + (if (string-match-p "\\`[[:space:]]*[[{]" string) + (apply #'json-parse-string string args) + ;; Wrap the string in an array, and extract the value back using + ;; `elt', to ensure that no matter what the value of `:array-type' + ;; is we can access the first element. + (elt (apply #'json-parse-string (concat "[" string "]") args) 0))) + +(compat-defun json-parse-buffer (&rest args) + "Handle top-level JSON values." + :prefix t + :min-version "27" + (if (looking-at-p "[[:space:]]*[[{]") + (apply #'json-parse-buffer args) + (catch 'escape + (atomic-change-group + (with-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\" "\"" st) + (modify-syntax-entry ?. "_" st) + st) + (let ((inhibit-read-only t)) + (save-excursion + (insert "[") + (forward-sexp 1) + (insert "]")))) + (throw 'escape (elt (apply #'json-parse-buffer args) 0)))))) + +;;;; xfaces.c + +(compat-defun color-values-from-color-spec (spec) + "Parse color SPEC as a numeric color and return (RED GREEN BLUE). +This function recognises the following formats for SPEC: + + #RGB, where R, G and B are hex numbers of equal length, 1-4 digits each. + rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each. + rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1]. + +If SPEC is not in one of the above forms, return nil. + +Each of the 3 integer members of the resulting list, RED, GREEN, +and BLUE, is normalized to have its value in [0,65535]." + (let ((case-fold-search nil)) + (save-match-data + (cond + ((string-match + ;; (rx bos "#" + ;; (or (: (group-n 1 (= 1 hex)) (group-n 2 (= 1 hex)) (group-n 3 (= 1 hex))) + ;; (: (group-n 1 (= 2 hex)) (group-n 2 (= 2 hex)) (group-n 3 (= 2 hex))) + ;; (: (group-n 1 (= 3 hex)) (group-n 2 (= 3 hex)) (group-n 3 (= 3 hex))) + ;; (: (group-n 1 (= 4 hex)) (group-n 2 (= 4 hex)) (group-n 3 (= 4 hex)))) + ;; eos) + "\\`#\\(?:\\(?1:[[:xdigit:]]\\{1\\}\\)\\(?2:[[:xdigit:]]\\{1\\}\\)\\(?3:[[:xdigit:]]\\{1\\}\\)\\|\\(?1:[[:xdigit:]]\\{2\\}\\)\\(?2:[[:xdigit:]]\\{2\\}\\)\\(?3:[[:xdigit:]]\\{2\\}\\)\\|\\(?1:[[:xdigit:]]\\{3\\}\\)\\(?2:[[:xdigit:]]\\{3\\}\\)\\(?3:[[:xdigit:]]\\{3\\}\\)\\|\\(?1:[[:xdigit:]]\\{4\\}\\)\\(?2:[[:xdigit:]]\\{4\\}\\)\\(?3:[[:xdigit:]]\\{4\\}\\)\\)\\'" + spec) + (let ((max (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4))))) + (list (/ (* (string-to-number (match-string 1 spec) 16) 65535) max) + (/ (* (string-to-number (match-string 2 spec) 16) 65535) max) + (/ (* (string-to-number (match-string 3 spec) 16) 65535) max)))) + ((string-match + ;; (rx bos "rgb:" + ;; (group (** 1 4 hex)) "/" + ;; (group (** 1 4 hex)) "/" + ;; (group (** 1 4 hex)) + ;; eos) + "\\`rgb:\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)\\'" + spec) + (list (/ (* (string-to-number (match-string 1 spec) 16) 65535) + (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4)))) + (/ (* (string-to-number (match-string 2 spec) 16) 65535) + (1- (ash 1 (* (- (match-end 2) (match-beginning 2)) 4)))) + (/ (* (string-to-number (match-string 3 spec) 16) 65535) + (1- (ash 1 (* (- (match-end 3) (match-beginning 3)) 4)))))) + ;; The "RGBi" (RGB Intensity) specification is defined by + ;; XCMS[0], see [1] for the implementation in Xlib. + ;; + ;; [0] http://www.nic.funet.fi/pub/X11/X11R4/DOCS/color/Xcms.text + ;; [1] https://gitlab.freedesktop.org/xorg/lib/libx11/-/blob/master/src/xcms/LRGB.c#L1392 + ((string-match + ;; (rx bos "rgbi:" (* space) + ;; (group (? (or "-" "+")) + ;; (or (: (+ digit) (? "." (* digit))) + ;; (: "." (+ digit))) + ;; (? "e" (? (or "-" "+")) (+ digit))) + ;; "/" (* space) + ;; (group (? (or "-" "+")) + ;; (or (: (+ digit) (? "." (* digit))) + ;; (: "." (+ digit))) + ;; (? "e" (? (or "-" "+")) (+ digit))) + ;; "/" (* space) + ;; (group (? (or "-" "+")) + ;; (or (: (+ digit) (? "." (* digit))) + ;; (: "." (+ digit))) + ;; (? "e" (? (or "-" "+")) (+ digit))) + ;; eos) + "\\`rgbi:[[:space:]]*\\([+-]?\\(?:[[:digit:]]+\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\)\\(?:e[+-]?[[:digit:]]+\\)?\\)/[[:space:]]*\\([+-]?\\(?:[[:digit:]]+\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\)\\(?:e[+-]?[[:digit:]]+\\)?\\)/[[:space:]]*\\([+-]?\\(?:[[:digit:]]+\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\)\\(?:e[+-]?[[:digit:]]+\\)?\\)\\'" + spec) + (let ((r (round (* (string-to-number (match-string 1 spec)) 65535))) + (g (round (* (string-to-number (match-string 2 spec)) 65535))) + (b (round (* (string-to-number (match-string 3 spec)) 65535)))) + (when (and (<= 0 r) (<= r 65535) + (<= 0 g) (<= g 65535) + (<= 0 b) (<= b 65535)) + (list r g b)))))))) + +;;;; Defined in subr.el + +;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions +(compat-defun string-replace (fromstring tostring instring) + "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs." + (when (equal fromstring "") + (signal 'wrong-length-argument '(0))) + (let ((case-fold-search nil)) + (replace-regexp-in-string + (regexp-quote fromstring) + tostring instring + t t))) + +(compat-defun always (&rest _arguments) + "Do nothing and return t. +This function accepts any number of ARGUMENTS, but ignores them. +Also see `ignore'." + t) + +;;* UNTESTED +(compat-defun insert-into-buffer (buffer &optional start end) + "Insert the contents of the current buffer into BUFFER. +If START/END, only insert that region from the current buffer. +Point in BUFFER will be placed after the inserted text." + (let ((current (current-buffer))) + (with-current-buffer buffer + (insert-buffer-substring current start end)))) + +;;* UNTESTED +(compat-defun replace-string-in-region (string replacement &optional start end) + "Replace STRING with REPLACEMENT in the region from START to END. +The number of replaced occurrences are returned, or nil if STRING +doesn't exist in the region. + +If START is nil, use the current point. If END is nil, use `point-max'. + +Comparisons and replacements are done with fixed case." + (if start + (when (< start (point-min)) + (error "Start before start of buffer")) + (setq start (point))) + (if end + (when (> end (point-max)) + (error "End after end of buffer")) + (setq end (point-max))) + (save-excursion + (let ((matches 0) + (case-fold-search nil)) + (goto-char start) + (while (search-forward string end t) + (delete-region (match-beginning 0) (match-end 0)) + (insert replacement) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches)))) + +;;* UNTESTED +(compat-defun replace-regexp-in-region (regexp replacement &optional start end) + "Replace REGEXP with REPLACEMENT in the region from START to END. +The number of replaced occurrences are returned, or nil if REGEXP +doesn't exist in the region. + +If START is nil, use the current point. If END is nil, use `point-max'. + +Comparisons and replacements are done with fixed case. + +REPLACEMENT can use the following special elements: + + `\\&' in NEWTEXT means substitute original matched text. + `\\N' means substitute what matched the Nth `\\(...\\)'. + If Nth parens didn't match, substitute nothing. + `\\\\' means insert one `\\'. + `\\?' is treated literally." + (if start + (when (< start (point-min)) + (error "Start before start of buffer")) + (setq start (point))) + (if end + (when (> end (point-max)) + (error "End after end of buffer")) + (setq end (point-max))) + (save-excursion + (let ((matches 0) + (case-fold-search nil)) + (goto-char start) + (while (re-search-forward regexp end t) + (replace-match replacement t) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches)))) + +;;* UNTESTED +(compat-defun buffer-local-boundp (symbol buffer) + "Return non-nil if SYMBOL is bound in BUFFER. +Also see `local-variable-p'." + (catch 'fail + (condition-case nil + (buffer-local-value symbol buffer) + (void-variable nil (throw 'fail nil))) + t)) + +;;* UNTESTED +(compat-defmacro with-existing-directory (&rest body) + "Execute BODY with `default-directory' bound to an existing directory. +If `default-directory' is already an existing directory, it's not changed." + (declare (indent 0) (debug t)) + (let ((quit (make-symbol "with-existing-directory-quit"))) + `(catch ',quit + (dolist (dir (list default-directory + (expand-file-name "~/") + (getenv "TMPDIR") + "/tmp/" + ;; XXX: check if "/" works on non-POSIX + ;; system. + "/")) + (when (and dir (file-exists-p dir)) + (throw ',quit (let ((default-directory dir)) + ,@body))))))) + +;;* UNTESTED +(compat-defmacro dlet (binders &rest body) + "Like `let' but using dynamic scoping." + (declare (indent 1) (debug let)) + `(let (_) + ,@(mapcar (lambda (binder) + `(defvar ,(if (consp binder) (car binder) binder))) + binders) + (let ,binders ,@body))) + +(compat-defun ensure-list (object) + "Return OBJECT as a list. +If OBJECT is already a list, return OBJECT itself. If it's +not a list, return a one-element list containing OBJECT." + (if (listp object) + object + (list object))) + +(compat-defun subr-primitive-p (object) + "Return t if OBJECT is a built-in primitive function." + (subrp object)) + +;;;; Defined in subr-x.el + +(compat-defun string-clean-whitespace (string) + "Clean up whitespace in STRING. +All sequences of whitespaces in STRING are collapsed into a +single space character, and leading/trailing whitespace is +removed." + :feature 'subr-x + (let ((blank "[[:blank:]\r\n]+")) + (replace-regexp-in-string + "^[[:blank:]\r\n]+\\|[[:blank:]\r\n]+$" + "" + (replace-regexp-in-string + blank " " string)))) + +(compat-defun string-fill (string length) + "Clean up whitespace in STRING. +All sequences of whitespaces in STRING are collapsed into a +single space character, and leading/trailing whitespace is +removed." + :feature 'subr-x + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (let ((fill-column length) + (adaptive-fill-mode nil)) + (fill-region (point-min) (point-max))) + (buffer-string))) + +(compat-defun string-lines (string &optional omit-nulls) + "Split STRING into a list of lines. +If OMIT-NULLS, empty lines will be removed from the results." + :feature 'subr-x + (split-string string "\n" omit-nulls)) + +(compat-defun string-pad (string length &optional padding start) + "Pad STRING to LENGTH using PADDING. +If PADDING is nil, the space character is used. If not nil, it +should be a character. + +If STRING is longer than the absolute value of LENGTH, no padding +is done. + +If START is nil (or not present), the padding is done to the end +of the string, and if non-nil, padding is done to the start of +the string." + :feature 'subr-x + (unless (natnump length) + (signal 'wrong-type-argument (list 'natnump length))) + (let ((pad-length (- length (length string)))) + (if (< pad-length 0) + string + (concat (and start + (make-string pad-length (or padding ?\s))) + string + (and (not start) + (make-string pad-length (or padding ?\s))))))) + +(compat-defun string-chop-newline (string) + "Remove the final newline (if any) from STRING." + :feature 'subr-x + (if (and (>= (length string) 1) (= (aref string (1- (length string))) ?\n)) + (substring string 0 -1) + string)) + +(compat-defmacro named-let (name bindings &rest body) + "Looping construct taken from Scheme. +Like `let', bind variables in BINDINGS and then evaluate BODY, +but with the twist that BODY can evaluate itself recursively by +calling NAME, where the arguments passed to NAME are used +as the new values of the bound variables in the recursive invocation." + :feature 'subr-x + (declare (indent 2) (debug (symbolp (&rest (symbolp form)) body))) + (let ((fargs (mapcar (lambda (b) + (let ((var (if (consp b) (car b) b))) + (make-symbol (symbol-name var)))) + bindings)) + (aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings)) + rargs) + (dotimes (i (length bindings)) + (let ((b (nth i bindings))) + (push (list (if (consp b) (car b) b) (nth i fargs)) + rargs) + (setf (if (consp b) (car b) b) + (nth i fargs)))) + (letrec + ((quit (make-symbol "quit")) (self (make-symbol "self")) + (total-tco t) + (macro (lambda (&rest args) + (setq total-tco nil) + `(funcall ,self . ,args))) + ;; Based on `cl--self-tco': + (tco-progn (lambda (exprs) + (append + (butlast exprs) + (list (funcall tco (car (last exprs))))))) + (tco (lambda (expr) + (cond + ((eq (car-safe expr) 'if) + (append (list 'if + (cadr expr) + (funcall tco (nth 2 expr))) + (funcall tco-progn (nthcdr 3 expr)))) + ((eq (car-safe expr) 'cond) + (let ((conds (cdr expr)) body) + (while conds + (let ((branch (pop conds))) + (push (cond + ((cdr branch) ;has tail + (funcall tco-progn branch)) + ((null conds) ;last element + (list t (funcall tco (car branch)))) + ((progn + branch))) + body))) + (cons 'cond (nreverse body)))) + ((eq (car-safe expr) 'or) + (if (cddr expr) + (let ((var (make-symbol "var"))) + `(let ((,var ,(cadr expr))) + (if ,var ,(funcall tco var) + ,(funcall tco (cons 'or (cddr expr)))))) + (funcall tco (cadr expr)))) + ((eq (car-safe expr) 'condition-case) + (append (list 'condition-case (cadr expr) (nth 2 expr)) + (mapcar + (lambda (handler) + (cons (car handler) + (funcall tco-progn (cdr handler)))) + (nthcdr 3 expr)))) + ((memq (car-safe expr) '(and progn)) + (cons (car expr) (funcall tco-progn (cdr expr)))) + ((memq (car-safe expr) '(let let*)) + (append (list (car expr) (cadr expr)) + (funcall tco-progn (cddr expr)))) + ((eq (car-safe expr) name) + (let (sets (args (cdr expr))) + (dolist (farg fargs) + (push (list farg (pop args)) + sets)) + (cons 'setq (apply #'nconc (nreverse sets))))) + (`(throw ',quit ,expr)))))) + (let ((tco-body (funcall tco (macroexpand-all (macroexp-progn body))))) + (when tco-body + (setq body `((catch ',quit + (while t (let ,rargs ,@(macroexp-unprogn tco-body)))))))) + (let ((expand (macroexpand-all (macroexp-progn body) (list (cons name macro))))) + (if total-tco + `(let ,bindings ,expand) + `(funcall + (letrec ((,self (lambda ,fargs ,expand))) ,self) + ,@aargs)))))) + +;;;; Defined in files.el + +(declare-function compat--string-trim-left "compat-26" (string &optional regexp)) +(declare-function compat--directory-name-p "compat-25" (name)) +(compat-defun file-name-with-extension (filename extension) + "Set the EXTENSION of a FILENAME. +The extension (in a file name) is the part that begins with the last \".\". + +Trims a leading dot from the EXTENSION so that either \"foo\" or +\".foo\" can be given. + +Errors if the FILENAME or EXTENSION are empty, or if the given +FILENAME has the format of a directory. + +See also `file-name-sans-extension'." + (let ((extn (compat--string-trim-left extension "[.]"))) + (cond + ((string= filename "") + (error "Empty filename")) + ((string= extn "") + (error "Malformed extension: %s" extension)) + ((compat--directory-name-p filename) + (error "Filename is a directory: %s" filename)) + (t + (concat (file-name-sans-extension filename) "." extn))))) + +;;* UNTESTED +(compat-defun directory-empty-p (dir) + "Return t if DIR names an existing directory containing no other files. +Return nil if DIR does not name a directory, or if there was +trouble determining whether DIR is a directory or empty. + +Symbolic links to directories count as directories. +See `file-symlink-p' to distinguish symlinks." + (and (file-directory-p dir) + (null (directory-files dir nil directory-files-no-dot-files-regexp t)))) + +(compat-defun file-modes-number-to-symbolic (mode &optional filetype) + "Return a string describing a file's MODE. +For instance, if MODE is #o700, then it produces `-rwx------'. +FILETYPE if provided should be a character denoting the type of file, +such as `?d' for a directory, or `?l' for a symbolic link and will override +the leading `-' char." + (string + (or filetype + (pcase (lsh mode -12) + ;; POSIX specifies that the file type is included in st_mode + ;; and provides names for the file types but values only for + ;; the permissions (e.g., S_IWOTH=2). + + ;; (#o017 ??) ;; #define S_IFMT 00170000 + (#o014 ?s) ;; #define S_IFSOCK 0140000 + (#o012 ?l) ;; #define S_IFLNK 0120000 + ;; (8 ??) ;; #define S_IFREG 0100000 + (#o006 ?b) ;; #define S_IFBLK 0060000 + (#o004 ?d) ;; #define S_IFDIR 0040000 + (#o002 ?c) ;; #define S_IFCHR 0020000 + (#o001 ?p) ;; #define S_IFIFO 0010000 + (_ ?-))) + (if (zerop (logand 256 mode)) ?- ?r) + (if (zerop (logand 128 mode)) ?- ?w) + (if (zerop (logand 64 mode)) + (if (zerop (logand 2048 mode)) ?- ?S) + (if (zerop (logand 2048 mode)) ?x ?s)) + (if (zerop (logand 32 mode)) ?- ?r) + (if (zerop (logand 16 mode)) ?- ?w) + (if (zerop (logand 8 mode)) + (if (zerop (logand 1024 mode)) ?- ?S) + (if (zerop (logand 1024 mode)) ?x ?s)) + (if (zerop (logand 4 mode)) ?- ?r) + (if (zerop (logand 2 mode)) ?- ?w) + (if (zerop (logand 512 mode)) + (if (zerop (logand 1 mode)) ?- ?x) + (if (zerop (logand 1 mode)) ?T ?t)))) + +;;* UNTESTED +(compat-defun file-backup-file-names (filename) + "Return a list of backup files for FILENAME. +The list will be sorted by modification time so that the most +recent files are first." + ;; `make-backup-file-name' will get us the right directory for + ;; ordinary or numeric backups. It might create a directory for + ;; backups as a side-effect, according to `backup-directory-alist'. + (let* ((filename (file-name-sans-versions + (make-backup-file-name (expand-file-name filename)))) + (dir (file-name-directory filename)) + files) + (dolist (file (file-name-all-completions + (file-name-nondirectory filename) dir)) + (let ((candidate (concat dir file))) + (when (and (backup-file-name-p candidate) + (string= (file-name-sans-versions candidate) filename)) + (push candidate files)))) + (sort files #'file-newer-than-file-p))) + +(compat-defun make-lock-file-name (filename) + "Make a lock file name for FILENAME. +This prepends \".#\" to the non-directory part of FILENAME, and +doesn't respect `lock-file-name-transforms', as Emacs 28.1 and +onwards does." + (expand-file-name + (concat + ".#" (file-name-nondirectory filename)) + (file-name-directory filename))) + +;;;; Defined in files-x.el + +(declare-function tramp-tramp-file-p "tramp" (name)) + +;;* UNTESTED +(compat-defun null-device () + "Return the best guess for the null device." + (require 'tramp) + (if (tramp-tramp-file-p default-directory) + "/dev/null" + null-device)) + +;;;; Defined in minibuffer.el + +(compat-defun format-prompt (prompt default &rest format-args) + "Format PROMPT with DEFAULT. +If FORMAT-ARGS is nil, PROMPT is used as a plain string. If +FORMAT-ARGS is non-nil, PROMPT is used as a format control +string, and FORMAT-ARGS are the arguments to be substituted into +it. See `format' for details. + +If DEFAULT is a list, the first element is used as the default. +If not, the element is used as is. + +If DEFAULT is nil or an empty string, no \"default value\" string +is included in the return value." + (concat + (if (null format-args) + prompt + (apply #'format prompt format-args)) + (and default + (or (not (stringp default)) + (> (length default) 0)) + (format " (default %s)" + (if (consp default) + (car default) + default))) + ": ")) + +;;;; Defined in windows.el + +;;* UNTESTED +(compat-defun count-windows (&optional minibuf all-frames) + "Handle optional argument ALL-FRAMES: + +If ALL-FRAMES is non-nil, count the windows in all frames instead +just the selected frame." + :prefix t + (if all-frames + (let ((sum 0)) + (dolist (frame (frame-list)) + (with-selected-frame frame + (setq sum (+ (count-windows minibuf) sum)))) + sum) + (count-windows minibuf))) + +;;;; Defined in thingatpt.el + +(declare-function mouse-set-point "mouse" (event &optional promote-to-region)) + +;;* UNTESTED +(compat-defun thing-at-mouse (event thing &optional no-properties) + "Return the THING at mouse click. +Like `thing-at-point', but tries to use the event +where the mouse button is clicked to find a thing nearby." + :feature 'thingatpt + (save-excursion + (mouse-set-point event) + (thing-at-point thing no-properties))) + +;;;; Defined in macroexp.el + +;;* UNTESTED +(compat-defun macroexp-file-name () + "Return the name of the file from which the code comes. +Returns nil when we do not know. +A non-nil result is expected to be reliable when called from a macro in order +to find the file in which the macro's call was found, and it should be +reliable as well when used at the top-level of a file. +Other uses risk returning non-nil value that point to the wrong file." + :feature 'macroexp + (let ((file (car (last current-load-list)))) + (or (if (stringp file) file) + (bound-and-true-p byte-compile-current-file)))) + +;;;; Defined in env.el + +;;* UNTESTED +(compat-defmacro with-environment-variables (variables &rest body) + "Set VARIABLES in the environent and execute BODY. +VARIABLES is a list of variable settings of the form (VAR VALUE), +where VAR is the name of the variable (a string) and VALUE +is its value (also a string). + +The previous values will be be restored upon exit." + (declare (indent 1) (debug (sexp body))) + (unless (consp variables) + (error "Invalid VARIABLES: %s" variables)) + `(let ((process-environment (copy-sequence process-environment))) + ,@(mapcar (lambda (elem) + `(setenv ,(car elem) ,(cadr elem))) + variables) + ,@body)) + +;;;; Defined in button.el + +;;* UNTESTED +(compat-defun button-buttonize (string callback &optional data) + "Make STRING into a button and return it. +When clicked, CALLBACK will be called with the DATA as the +function argument. If DATA isn't present (or is nil), the button +itself will be used instead as the function argument." + :feature 'button + (propertize string + 'face 'button + 'button t + 'follow-link t + 'category t + 'button-data data + 'keymap button-map + 'action callback)) + +;;;; Defined in autoload.el + +(defvar generated-autoload-file) + +;;* UNTESTED +(compat-defun make-directory-autoloads (dir output-file) + "Update autoload definitions for Lisp files in the directories DIRS. +DIR can be either a single directory or a list of +directories. (The latter usage is discouraged.) + +The autoloads will be written to OUTPUT-FILE. If any Lisp file +binds `generated-autoload-file' as a file-local variable, write +its autoloads into the specified file instead. + +The function does NOT recursively descend into subdirectories of the +directory or directories specified." + (let ((generated-autoload-file output-file)) + ;; We intentionally don't sharp-quote + ;; `update-directory-autoloads', because it was deprecated in + ;; Emacs 28 and we don't want to trigger the byte compiler for + ;; newer versions. + (apply 'update-directory-autoloads + (if (listp dir) dir (list dir))))) + +;;;; Defined in time-data.el + +(compat-defun decoded-time-period (time) + "Interpret DECODED as a period and return its length in seconds. +For computational purposes, years are 365 days long and months +are 30 days long." + :feature 'time-date + :version "28" + ;; Inlining the definitions from compat-27 + (+ (if (consp (nth 0 time)) + ;; Fractional second. + (/ (float (car (nth 0 time))) + (cdr (nth 0 time))) + (or (nth 0 time) 0)) + (* (or (nth 1 time) 0) 60) + (* (or (nth 2 time) 0) 60 60) + (* (or (nth 3 time) 0) 60 60 24) + (* (or (nth 4 time) 0) 60 60 24 30) + (* (or (nth 5 time) 0) 60 60 24 365))) + +(compat--inhibit-prefixed (provide 'compat-28)) +;;; compat-28.el ends here diff --git a/elpa/compat-28.1.2.2/compat-autoloads.el b/elpa/compat-28.1.2.2/compat-autoloads.el @@ -0,0 +1,38 @@ +;;; compat-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + + +;;; Generated autoloads from compat-27.el + +(register-definition-prefixes "compat-27" '("derived-mode-p")) + + +;;; Generated autoloads from compat-help.el + +(register-definition-prefixes "compat-help" '("compat---describe")) + + +;;; Generated autoloads from compat-macs.el + +(register-definition-prefixes "compat-macs" '("compat-")) + +;;; End of scraped data + +(provide 'compat-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8-emacs-unix +;; End: + +;;; compat-autoloads.el ends here diff --git a/elpa/compat-28.1.2.2/compat-font-lock.el b/elpa/compat-28.1.2.2/compat-font-lock.el @@ -0,0 +1,48 @@ +;;; compat-font-lock.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Keywords: + +;; 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: + +;; Optional font-locking for `compat' definitions. Every symbol with +;; an active compatibility definition will be highlighted. +;; +;; Load this file to enable the functionality. + +;;; Code: + +(eval-and-compile + (require 'cl-lib) + (require 'compat-macs)) + +(defvar compat-generate-common-fn) +(let ((compat-generate-common-fn + (lambda (name _def-fn _install-fn check-fn attr _type) + (unless (and (plist-get attr :no-highlight) + (funcall check-fn)) + `(font-lock-add-keywords + 'emacs-lisp-mode + ',`((,(concat "\\_<\\(" + (regexp-quote (symbol-name name)) + "\\)\\_>") + 1 font-lock-preprocessor-face prepend))))))) + (load "compat")) + +(provide 'compat-font-lock) +;;; compat-font-lock.el ends here diff --git a/elpa/compat-28.1.2.2/compat-help.el b/elpa/compat-28.1.2.2/compat-help.el @@ -0,0 +1,57 @@ +;;; compat-help.el --- Documentation for compat functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> + +;; 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: + +;; Load this file to insert `compat'-relevant documentation next to +;; the regular documentation of a symbol. + +;;; Code: + +(defun compat---describe (symbol) + "Insert documentation for SYMBOL if it has compatibility code." + (let ((compat (get symbol 'compat-def))) + (when compat + (let ((doc (get compat 'compat-doc)) + (start (point))) + (when doc + (insert "There is a ") + (insert-button + "compatibility notice" + 'action (let ((type (get compat 'compat-type))) + (cond + ((memq type '(func macro advice)) + #'find-function) + ((memq type '(variable)) + #'find-variable) + ((error "Unknown type")))) + 'button-data compat) + (insert (format " for %s (for versions of Emacs before %s):" + (symbol-name symbol) + (get compat 'compat-version))) + (add-text-properties start (point) '(face bold)) + (newline 2) + (insert (substitute-command-keys doc)) + (fill-region start (point)) + (newline 2)))))) + +(add-hook 'help-fns-describe-function-functions #'compat---describe) + +(provide 'compat-help) +;;; compat-help.el ends here diff --git a/elpa/compat-28.1.2.2/compat-macs.el b/elpa/compat-28.1.2.2/compat-macs.el @@ -0,0 +1,316 @@ +;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Keywords: lisp + +;; 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: + +;; These macros are used to define compatibility functions, macros and +;; advice. + +;;; Code: + +(defmacro compat--ignore (&rest _) + "Ignore all arguments." + nil) + +(defvar compat--inhibit-prefixed nil + "Non-nil means that prefixed definitions are not loaded. +A prefixed function is something like `compat-assoc', that is +only made visible when the respective compatibility version file +is loaded (in this case `compat-26').") + +(defmacro compat--inhibit-prefixed (&rest body) + "Ignore BODY unless `compat--inhibit-prefixed' is true." + `(unless (bound-and-true-p compat--inhibit-prefixed) + ,@body)) + +(defvar compat-current-version nil + "Default version to use when no explicit version was given.") + +(defmacro compat-declare-version (version) + "Set the Emacs version that is currently being handled to VERSION." + ;; FIXME: Avoid setting the version for any definition that might + ;; follow, but try to restrict it to the current file/buffer. + (setq compat-current-version version) + nil) + +(defvar compat--generate-function #'compat--generate-default + "Function used to generate compatibility code. +The function must take six arguments: NAME, DEF-FN, INSTALL-FN, +CHECK-FN, ATTR and TYPE. The resulting body is constructed by +invoking the functions DEF-FN (passed the \"realname\" and the +version number, returning the compatibility definition), the +INSTALL-FN (passed the \"realname\" and returning the +installation code), CHECK-FN (passed the \"realname\" and +returning a check to see if the compatibility definition should +be installed). ATTR is a plist used to modify the generated +code. The following attributes are handled, all others are +ignored: + +- :min-version :: Prevent the compatibility definition from begin + installed in versions older than indicated (string). + +- :max-version :: Prevent the compatibility definition from begin + installed in versions newer than indicated (string). + +- :feature :: The library the code is supposed to be loaded + with (via `eval-after-load'). + +- :cond :: Only install the compatibility code, iff the value + evaluates to non-nil. + + For prefixed functions, this can be interpreted as a test to + `defalias' an existing definition or not. + +- :no-highlight :: Do not highlight this definition as + compatibility function. + +- :version :: Manual specification of the version the compatee + code was defined in (string). + +- :realname :: Manual specification of a \"realname\" to use for + the compatibility definition (symbol). + +- :notes :: Additional notes that a developer using this + compatibility function should keep in mind. + +- :prefix :: Add a `compat-' prefix to the name, and define the + compatibility code unconditionally. + +TYPE is used to set the symbol property `compat-type' for NAME.") + +(defun compat--generate-default (name def-fn install-fn check-fn attr type) + "Generate a leaner compatibility definition. +See `compat-generate-function' for details on the arguments NAME, +DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE." + (let* ((min-version (plist-get attr :min-version)) + (max-version (plist-get attr :max-version)) + (feature (plist-get attr :feature)) + (cond (plist-get attr :cond)) + (version (or (plist-get attr :version) + compat-current-version)) + (realname (or (plist-get attr :realname) + (intern (format "compat--%S" name)))) + (check (cond + ((or (and min-version + (version< emacs-version min-version)) + (and max-version + (version< max-version emacs-version))) + '(compat--ignore)) + ((plist-get attr :prefix) + '(compat--inhibit-prefixed)) + ((and version (version<= version emacs-version) (not cond)) + '(compat--ignore)) + (`(when (and ,(if cond cond t) + ,(funcall check-fn))))))) + (cond + ((and (plist-get attr :prefix) (memq type '(func macro)) + (string-match "\\`compat-\\(.+\\)\\'" (symbol-name name)) + (let* ((actual-name (intern (match-string 1 (symbol-name name)))) + (body (funcall install-fn actual-name version))) + (when (and (version<= version emacs-version) + (fboundp actual-name)) + `(,@check + ,(if feature + ;; See https://nullprogram.com/blog/2018/02/22/: + `(eval-after-load ,feature `(funcall ',(lambda () ,body))) + body)))))) + ((plist-get attr :realname) + `(progn + ,(funcall def-fn realname version) + (,@check + ,(let ((body (funcall install-fn realname version))) + (if feature + ;; See https://nullprogram.com/blog/2018/02/22/: + `(eval-after-load ,feature `(funcall ',(lambda () ,body))) + body))))) + ((let* ((body (if (eq type 'advice) + `(,@check + ,(funcall def-fn realname version) + ,(funcall install-fn realname version)) + `(,@check ,(funcall def-fn name version))))) + (if feature + ;; See https://nullprogram.com/blog/2018/02/22/: + `(eval-after-load ,feature `(funcall ',(lambda () ,body))) + body)))))) + +(defun compat-generate-common (name def-fn install-fn check-fn attr type) + "Common code for generating compatibility definitions. +See `compat-generate-function' for details on the arguments NAME, +DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE." + (when (and (plist-get attr :cond) (plist-get attr :prefix)) + (error "A prefixed function %s cannot have a condition" name)) + (funcall compat--generate-function + name def-fn install-fn check-fn attr type)) + +(defun compat-common-fdefine (type name arglist docstring rest) + "Generate compatibility code for a function NAME. +TYPE is one of `func', for functions and `macro' for macros, and +`advice' ARGLIST is passed on directly to the definition, and +DOCSTRING is prepended with a compatibility note. REST contains +the remaining definition, that may begin with a property list of +attributes (see `compat-generate-common')." + (let ((oldname name) (body rest)) + (while (keywordp (car body)) + (setq body (cddr body))) + ;; It might be possible to set these properties otherwise. That + ;; should be looked into and implemented if it is the case. + (when (and (listp (car-safe body)) (eq (caar body) 'declare)) + (when (version<= emacs-version "25") + (delq (assq 'side-effect-free (car body)) (car body)) + (delq (assq 'pure (car body)) (car body)))) + ;; Check if we want an explicitly prefixed function + (when (plist-get rest :prefix) + (setq name (intern (format "compat-%s" name)))) + (compat-generate-common + name + (lambda (realname version) + `(,(cond + ((memq type '(func advice)) 'defun) + ((eq type 'macro) 'defmacro) + ((error "Unknown type"))) + ,realname ,arglist + ;; Prepend compatibility notice to the actual + ;; documentation string. + ,(let ((type (cond + ((eq type 'func) "function") + ((eq type 'macro) "macro") + ((eq type 'advice) "advice") + ((error "Unknown type"))))) + (if version + (format + "[Compatibility %s for `%S', defined in Emacs %s]\n\n%s" + type oldname version docstring) + (format + "[Compatibility %s for `%S']\n\n%s" + type oldname docstring))) + ;; Advice may use the implicit variable `oldfun', but + ;; to avoid triggering the byte compiler, we make + ;; sure the argument is used at least once. + ,@(if (eq type 'advice) + (cons '(ignore oldfun) body) + body))) + (lambda (realname _version) + (cond + ((memq type '(func macro)) + ;; Functions and macros are installed by + ;; aliasing the name of the compatible + ;; function to the name of the compatibility + ;; function. + `(defalias ',name #',realname)) + ((eq type 'advice) + `(advice-add ',name :around #',realname)))) + (lambda () + (cond + ((memq type '(func macro)) + `(not (fboundp ',name))) + ((eq type 'advice) t))) + rest type))) + +(defmacro compat-defun (name arglist docstring &rest rest) + "Define NAME with arguments ARGLIST as a compatibility function. +The function must be documented in DOCSTRING. REST may begin +with a plist, that is interpreted by the macro but not passed on +to the actual function. See `compat-generate-common' for a +listing of attributes. + +The definition will only be installed, if the version this +function was defined in, as indicated by the `:version' +attribute, is greater than the current Emacs version." + (declare (debug (&define name (&rest symbolp) + stringp + [&rest keywordp sexp] + def-body)) + (doc-string 3) (indent 2)) + (compat-common-fdefine 'func name arglist docstring rest)) + +(defmacro compat-defmacro (name arglist docstring &rest rest) + "Define NAME with arguments ARGLIST as a compatibility macro. +The macro must be documented in DOCSTRING. REST may begin +with a plist, that is interpreted by this macro but not passed on +to the actual macro. See `compat-generate-common' for a +listing of attributes. + +The definition will only be installed, if the version this +function was defined in, as indicated by the `:version' +attribute, is greater than the current Emacs version." + (declare (debug compat-defun) (doc-string 3) (indent 2)) + (compat-common-fdefine 'macro name arglist docstring rest)) + +(defmacro compat-advise (name arglist docstring &rest rest) + "Define NAME with arguments ARGLIST as a compatibility advice. +The advice function must be documented in DOCSTRING. REST may +begin with a plist, that is interpreted by this macro but not +passed on to the actual advice function. See +`compat-generate-common' for a listing of attributes. The advice +wraps the old definition, that is accessible via using the symbol +`oldfun'. + +The advice will only be installed, if the version this function +was defined in, as indicated by the `:version' attribute, is +greater than the current Emacs version." + (declare (debug compat-defun) (doc-string 3) (indent 2)) + (compat-common-fdefine 'advice name (cons 'oldfun arglist) docstring rest)) + +(defmacro compat-defvar (name initval docstring &rest attr) + "Declare compatibility variable NAME with initial value INITVAL. +The obligatory documentation string DOCSTRING must be given. + +The remaining arguments ATTR form a plist, modifying the +behaviour of this macro. See `compat-generate-common' for a +listing of attributes. Furthermore, `compat-defvar' also handles +the attribute `:local' that either makes the variable permanent +local with a value of `permanent' or just buffer local with any +non-nil value." + (declare (debug (name form stringp [&rest keywordp sexp])) + (doc-string 3) (indent 2)) + ;; Check if we want an explicitly prefixed function + (let ((oldname name)) + (when (plist-get attr :prefix) + (setq name (intern (format "compat-%s" name)))) + (compat-generate-common + name + (lambda (realname version) + (let ((localp (plist-get attr :local))) + `(progn + (,(if (plist-get attr :constant) 'defconst 'defvar) + ,realname ,initval + ;; Prepend compatibility notice to the actual + ;; documentation string. + ,(if version + (format + "[Compatibility variable for `%S', defined in Emacs %s]\n\n%s" + oldname version docstring) + (format + "[Compatibility variable for `%S']\n\n%s" + oldname docstring))) + ;; Make variable as local if necessary + ,(cond + ((eq localp 'permanent) + `(put ',realname 'permanent-local t)) + (localp + `(make-variable-buffer-local ',realname)))))) + (lambda (realname _version) + `(defvaralias ',name ',realname)) + (lambda () + `(not (boundp ',name))) + attr 'variable))) + +(provide 'compat-macs) +;;; compat-macs.el ends here diff --git a/elpa/compat-28.1.2.2/compat-pkg.el b/elpa/compat-28.1.2.2/compat-pkg.el @@ -0,0 +1,2 @@ +;; Generated package description from compat.el -*- no-byte-compile: t -*- +(define-package "compat" "28.1.2.2" "Emacs Lisp Compatibility Library" '((emacs "24.3") (nadvice "0.3")) :commit "d533692182c084bad623977b69f9dc298255eaab" :authors '(("Philip Kaludercic" . "philipk@posteo.net")) :maintainer '("Compat Development" . "~pkal/compat-devel@lists.sr.ht") :keywords '("lisp") :url "https://sr.ht/~pkal/compat") diff --git a/elpa/compat-28.1.2.2/compat.el b/elpa/compat-28.1.2.2/compat.el @@ -0,0 +1,58 @@ +;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic <philipk@posteo.net> +;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> +;; Version: 28.1.2.2 +;; URL: https://sr.ht/~pkal/compat +;; Package-Requires: ((emacs "24.3") (nadvice "0.3")) +;; Keywords: lisp + +;; 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: + +;; To allow for the usage of Emacs functions and macros that are +;; defined in newer versions of Emacs, compat.el provides definitions +;; that are installed ONLY if necessary. These reimplementations of +;; functions and macros are at least subsets of the actual +;; implementations. Be sure to read the documentation string to make +;; sure. +;; +;; Not every function provided in newer versions of Emacs is provided +;; here. Some depend on new features from the core, others cannot be +;; implemented to a meaningful degree. Please consult the Compat +;; manual for details. The main audience for this library are not +;; regular users, but package maintainers. Therefore commands and +;; user options are usually not implemented here. + +;;; Code: + +(defvar compat--inhibit-prefixed) +(let ((compat--inhibit-prefixed (not (bound-and-true-p compat-testing)))) + ;; Instead of using `require', we manually check `features' and call + ;; `load' to avoid the issue of not using `provide' at the end of + ;; the file (which is disabled by `compat--inhibit-prefixed', so + ;; that the file can be loaded again at some later point when the + ;; prefixed definitions are needed). + (dolist (vers '(24 25 26 27 28)) + (unless (memq (intern (format "compat-%d" vers)) features) + (load (format "compat-%d%s" vers + (if (bound-and-true-p compat-testing) + ".el" "")) + nil t)))) + +(provide 'compat) +;;; compat.el ends here diff --git a/elpa/compat-28.1.2.2/compat.info b/elpa/compat-28.1.2.2/compat.info @@ -0,0 +1,2070 @@ +This is compat.info, produced by makeinfo version 6.7 from compat.texi. + +Copyright © 2022 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with the Front-Cover Texts + being “A GNU Manual,” and with the Back-Cover Texts as in (a) + below. A copy of the license is included in the section entitled + “GNU Free Documentation License.” + + (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and + modify this GNU manual.” + +INFO-DIR-SECTION Emacs +START-INFO-DIR-ENTRY +* Compat: (compat). Compatibility Library for Emacs Lisp. +END-INFO-DIR-ENTRY + + +File: compat.info, Node: Top, Next: Introduction, Up: (dir) + +"Compat" Manual +*************** + +This manual documents the usage of the "Compat" Emacs lisp library, the +forward-compatibility library for Emacs Lisp, corresponding to version +28.1.2.2. + + Copyright © 2022 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with the Front-Cover Texts + being “A GNU Manual,” and with the Back-Cover Texts as in (a) + below. A copy of the license is included in the section entitled + “GNU Free Documentation License.” + + (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and + modify this GNU manual.” + +* Menu: + +* Introduction:: +* Support:: +* Development:: +* Function Index:: +* Variable Index:: + +— The Detailed Node Listing — + +Introduction + +* Overview:: +* Usage:: +* Intentions:: + +Usage + +* Additional libraries:: + +Support + +* Emacs 24.4:: Compatibility support for Emacs 24.4 +* Emacs 25.1:: Compatibility support for Emacs 25.1 +* Emacs 26.1:: Compatibility support for Emacs 26.1 +* Emacs 27.1:: Compatibility support for Emacs 27.1 +* Emacs 28.1:: Compatibility support for Emacs 28.1 + + + +File: compat.info, Node: Introduction, Next: Support, Prev: Top, Up: Top + +1 Introduction +************** + +* Menu: + +* Overview:: +* Usage:: +* Intentions:: + + +File: compat.info, Node: Overview, Next: Usage, Up: Introduction + +1.1 Overview +============ + +The objective of Compat is to provide "forwards compatibility" library +for Emacs Lisp. That is to say by using Compat, an Elisp package does +not have to make the decision to either use new and useful functionality +or support old versions of Emacs. + + Version 24.3 is chosen as the oldest version, because this is the +newest version on CentOS 7. It is intended to preserve compatibility +for at least as the Centos 7 reaches EOL +(https://wiki.centos.org/About/Product), 2024. + + If you are developing a package with Compat in mind, consider loading +‘compat-help‘ (on your system, not in a package) to get relevant notes +inserted into the help buffers of functions that are implemented or +advised in Compat. + + Note that Compat provides a few prefixed function, ie. functions +with a ‘compat-’ prefix. These are used to provide extended +functionality for commands that are already defined (‘sort’, ‘assoc’, +‘seq’, ...). It might be possible to transform these into advised +functions later on, so that the modified functionality is accessible +without a prefix. Feedback on this point is appreciated. + + +File: compat.info, Node: Usage, Next: Intentions, Prev: Overview, Up: Introduction + +1.2 Usage +========= + +The intended use-case for this library is for package developers to add +as a dependency in the header: + + ;; Package-Requires: ((emacs "24.3") (compat "28.1.2.2")) + + There is no need to depend on ‘emacs’ 24.3 specifically. One can +choose to any newer version, if features not provided by Compat +necessitate it. + + In any file where compatibility forms are used, a + + (require 'compat) + + should be added early on. + + This will load all non-prefixed definitions (functions and macros +with a leading ‘compat-‘). To load these, an additional + + (require 'compat-XY) ; e.g. 26 + + will be necessary, to load compatibility code for Emacs version XY. + + It is recommended to subscribe to the compat-announce +(https://lists.sr.ht/~pkal/compat-announce) mailing list to be notified +when new versions are released or relevant changes are made. + +* Menu: + +* Additional libraries:: + + +File: compat.info, Node: Additional libraries, Up: Usage + +1.2.1 Additional libraries +-------------------------- + +These libraries are packages with Compat, but are disabled by default. +To use them you can use ‘M-x load-library’: + +compat-help + Add notes to ‘*Help*’ buffer, if a compatibility definition has + something to warn you about. +compat-font-lock + Highlight functions that are implemented as compatibility + definitions. + + +File: compat.info, Node: Intentions, Prev: Usage, Up: Introduction + +1.3 Intentions +============== + +The library intends to provide support back until Emacs 24.3. The +intended audience are package developers that are interested in using +newer developments, without having to break compatibility. + + Sadly, total backwards compatibility cannot be provided for technical +reasons. These might include: + + • An existing function or macro was extended by some new + functionality. To support these cases, the function or macro would + have to be advised. As this is usually regarded as invasive and is + shown to be a significant overhead, even when the new feature is + not used, this approach is not used. + + As a compromise, prefixed functions and macros (starting with a + ‘compat-’ prefix) can be provided. + + • New functionality was implemented in the core, and depends on + external libraries that cannot be reasonably duplicated in the + scope of a compatibility library. + + • New functionality depends on an entire new, non-trivial library. + Sometimes these are provided via ELPA (xref, project, ...), but + other times it would be infeasible to duplicate an entire library + within Compat while also providing the necessary backwards + compatibility. + + • It just wasn’t added, and there is no good reason (though good + excuses might exist). If you happen to find such a function, *note + reporting: Development. it would be much appreciated. + + Always begin by assuming that this might be the case, unless proven + otherwise. + + +File: compat.info, Node: Support, Next: Development, Prev: Introduction, Up: Top + +2 Support +********* + +This section goes into the features that Compat manages and doesn’t +manage to provide for each Emacs version. + +* Menu: + +* Emacs 24.4:: Compatibility support for Emacs 24.4 +* Emacs 25.1:: Compatibility support for Emacs 25.1 +* Emacs 26.1:: Compatibility support for Emacs 26.1 +* Emacs 27.1:: Compatibility support for Emacs 27.1 +* Emacs 28.1:: Compatibility support for Emacs 28.1 + + +File: compat.info, Node: Emacs 24.4, Next: Emacs 25.1, Up: Support + +2.1 Emacs 24.4 +============== + +2.1.1 Unprefixed Definitions +---------------------------- + +The following functions and macros implemented in 24.4, and are provided +by Compat by default: + + -- Macro: with-eval-after-load library body... + This macro arranges to evaluate BODY at the end of loading the file + LIBRARY, each time LIBRARY is loaded. If LIBRARY is already + loaded, it evaluates BODY right away. + + You don’t need to give a directory or extension in the file name + LIBRARY. Normally, you just give a bare file name, like this: + + (with-eval-after-load "js" (keymap-set js-mode-map "C-c C-c" 'js-eval)) + + To restrict which files can trigger the evaluation, include a + directory or an extension or both in LIBRARY. Only a file whose + absolute true name (i.e., the name with all symbolic links chased + out) matches all the given name components will match. In the + following example, ‘my_inst.elc’ or ‘my_inst.elc.gz’ in some + directory ‘..../foo/bar’ will trigger the evaluation, but not + ‘my_inst.el’: + + (with-eval-after-load "foo/bar/my_inst.elc" ...) + + LIBRARY can also be a feature (i.e., a symbol), in which case BODY + is evaluated at the end of any file where ‘(provide LIBRARY)’ is + called. + + An error in BODY does not undo the load, but does prevent execution + of the rest of BODY. + + *Note (elisp)Hooks for Loading::. + + -- Function: special-form-p object + This predicate tests whether its argument is a special form, and + returns ‘t’ if so, ‘nil’ otherwise. + + *Note (elisp)Special Forms::. + + -- Function: macrop object + This predicate tests whether its argument is a macro, and returns + ‘t’ if so, ‘nil’ otherwise. + + *Note (elisp)Simple Macro::. + + -- Function: string-suffix-p suffix string &optional ignore-case + This function returns non-‘nil’ if SUFFIX is a suffix of STRING; + i.e., if STRING ends with SUFFIX. If the optional argument + IGNORE-CASE is non-‘nil’, the comparison ignores case differences. + + *Note (elisp)Text Comparison::. + + -- Function: delete-consecutive-dups list &optional circular + Destructively remove ‘equal’ consecutive duplicates from LIST. + First and last elements are considered consecutive if CIRCULAR is + non-nil. + + -- Function: define-error name message &optional parent + In order for a symbol to be an error symbol, it must be defined + with ‘define-error’ which takes a parent condition (defaults to + ‘error’). This parent defines the conditions that this kind of + error belongs to. The transitive set of parents always includes + the error symbol itself, and the symbol ‘error’. Because quitting + is not considered an error, the set of parents of ‘quit’ is just + ‘(quit)’. + + *Note (elisp)Error Symbols::. + + -- Function: bool-vector-exclusive-or a b &optional c + Return “bitwise exclusive or” of bool vectors A and B. If optional + argument C is given, the result of this operation is stored into C. + All arguments should be bool vectors of the same length. + + *Note (elisp)Bool-Vectors::. + + -- Function: bool-vector-union a b &optional c + Return “bitwise or” of bool vectors A and B. If optional argument + C is given, the result of this operation is stored into C. All + arguments should be bool vectors of the same length. + + *Note (elisp)Bool-Vectors::. + + -- Function: bool-vector-intersection a b &optional c + Return “bitwise and” of bool vectors A and B. If optional argument + C is given, the result of this operation is stored into C. All + arguments should be bool vectors of the same length. + + *Note (elisp)Bool-Vectors::. + + -- Function: bool-vector-set-difference a b &optional c + Return “set difference” of bool vectors A and B. If optional + argument C is given, the result of this operation is stored into C. + All arguments should be bool vectors of the same length. + + *Note (elisp)Bool-Vectors::. + + -- Function: bool-vector-not a &optional b + Return “set complement” of bool vector A. If optional argument B + is given, the result of this operation is stored into B. All + arguments should be bool vectors of the same length. + + *Note (elisp)Bool-Vectors::. + + -- Function: bool-vector-subsetp a b + Return ‘t’ if every ‘t’ value in A is also ‘t’ in B, ‘nil’ + otherwise. All arguments should be bool vectors of the same + length. + + *Note (elisp)Bool-Vectors::. + + -- Function: bool-vector-count-consecutive a b i + Return the number of consecutive elements in A equal B starting at + I. ‘a’ is a bool vector, B is ‘t’ or ‘nil’, and I is an index into + ‘a’. + + *Note (elisp)Bool-Vectors::. + + -- Function: bool-vector-count-population a + Return the number of elements that are ‘t’ in bool vector A. + + *Note (elisp)Bool-Vectors::. + + -- Function: completion-table-with-cache function &optional ignore-case + This is a wrapper for ‘completion-table-dynamic’ that saves the + last argument-result pair. This means that multiple lookups with + the same argument only need to call FUNCTION once. This can be + useful when a slow operation is involved, such as calling an + external process. + + *Note (elisp)Programmed Completion::. + + -- Function: face-spec-set face spec &optional spec-type + This function applies SPEC as a face spec for ‘face’. SPEC should + be a face spec, as described in the above documentation for + ‘defface’. + + This function also defines FACE as a valid face name if it is not + already one, and (re)calculates its attributes on existing frames. + + The optional argument SPEC-TYPE determines which spec to set. If + it is omitted or ‘nil’ or ‘face-override-spec’, this function sets + the “override spec”, which overrides face specs on FACE of all the + other types mentioned below. This is useful when calling this + function outside of Custom code. If SPEC-TYPE is ‘customized-face’ + or ‘saved-face’, this function sets the customized spec or the + saved custom spec, respectively. If it is ‘face-defface-spec’, + this function sets the default face spec (the same one set by + ‘defface’). If it is ‘reset’, this function clears out all + customization specs and override specs from FACE (in this case, the + value of SPEC is ignored). The effect of any other value of + SPEC-TYPE on the face specs is reserved for internal use, but the + function will still define FACE itself and recalculate its + attributes, as described above. + + *Note (elisp)Defining Faces::. + +2.1.2 Prefixed Definitions +-------------------------- + +These functions are prefixed with ‘compat’ prefix, and are only loaded +when ‘compat-24’ is required: + + -- Function: compat-= number-or-marker &rest number-or-markers + This function tests whether all its arguments are numerically + equal, and returns ‘t’ if so, ‘nil’ otherwise. + + *Note (elisp)Comparison of Numbers::. + -- Function: compat-< number-or-marker &rest number-or-markers + This function tests whether each argument is strictly less than the + following argument. It returns ‘t’ if so, ‘nil’ otherwise. + + *Note (elisp)Comparison of Numbers::. + -- Function: compat-> number-or-marker &rest number-or-markers + This function tests whether each argument is strictly greater than + the following argument. It returns ‘t’ if so, ‘nil’ otherwise. + + *Note (elisp)Comparison of Numbers::. + -- Function: compat-<= number-or-marker &rest number-or-markers + This function tests whether each argument is less than or equal to + the following argument. It returns ‘t’ if so, ‘nil’ otherwise. + + *Note (elisp)Comparison of Numbers::. + -- Function: compat->= number-or-marker &rest number-or-markers + This function tests whether each argument is greater than or equal + to the following argument. It returns ‘t’ if so, ‘nil’ otherwise. + + *Note (elisp)Comparison of Numbers::. + + These functions differ from the previous implementation in that they +allow for more than two argument to be compared. + + -- Function: compat-split-string string &optional separators omit-nulls + trim + This function splits STRING into substrings based on the regular + expression SEPARATORS (*note (elisp)Regular Expressions::). Each + match for SEPARATORS defines a splitting point; the substrings + between splitting points are made into a list, which is returned. + + *note (elisp)Creating Strings:: for more details. + + This version handles the optional argument TRIM. If it is + non-‘nil’, it should be a regular expression to match text to trim + from the beginning and end of each substring. If trimming makes + the substring empty, it is treated as null. + +2.1.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 24.4: + + • Allowing the second optional argument to ‘eval’ to specify a + lexical environment. + • The ‘define-alternatives’ macro. + • Support for the ‘defalias-fset-function’ symbol property. + • The ‘group-gid’ and ‘groupd-read-gid’ functions. + • The ‘pre-redisplay-function’ hook. + • Allowing for ‘with-demoted-errors’ to take a additional argument + ‘format’. + • The ‘add-face-text-property’ function. + • No ‘tty-setup-hook’ hook. + • The ‘get-pos-property’ function. + • The ‘define-advice’ macro. + • Support for generators. + • The ‘string-trim’, ‘string-trim-left’ and ‘string-trim-right’ + functions. These are instead provided as prefixed function as part + of *note Emacs 26.1:: support. + + +File: compat.info, Node: Emacs 25.1, Next: Emacs 26.1, Prev: Emacs 24.4, Up: Support + +2.2 Emacs 25.1 +============== + +2.2.1 Unprefixed Definitions +---------------------------- + +The following functions and macros implemented in 25.1, and are provided +by Compat by default: + + -- Function: format-message string &rest objects + This function acts like ‘format’, except it also converts any grave + accents (`) and apostrophes (') in STRING as per the value of + ‘text-quoting-style’. + + Typically grave accent and apostrophe in the format translate to + matching curved quotes, e.g., "Missing `%s'" might result in + "Missing ‘foo’". *Note (elisp)Text Quoting Style::, for how to + influence or inhibit this translation. + + *note (elisp)Formatting Strings::. + + -- Function: directory-name-p filename + This function returns non-‘nil’ if FILENAME ends with a directory + separator character. This is the forward slash ‘/’ on GNU and + other POSIX-like systems; MS-Windows and MS-DOS recognize both the + forward slash and the backslash ‘\’ as directory separators. + + *Note (elisp)Directory Names::. + + -- Function: string-greaterp string1 string2 + This function returns the result of comparing STRING1 and STRING2 + in the opposite order, i.e., it is equivalent to calling + ‘(string-lessp STRING2 STRING1)’. + + *Note (elisp)Text Comparison::. + + -- Macro: with-file-modes mode body... + This macro evaluates the BODY forms with the default permissions + for new files temporarily set to MODES (whose value is as for + ‘set-file-modes’ above). When finished, it restores the original + default file permissions, and returns the value of the last form in + BODY. + + This is useful for creating private files, for example. + + *Note (elisp)Changing Files::. + + -- Function: alist-get key alist &optional default remove testfn + This function is similar to ‘assq’. It finds the first association + ‘(KEY . VALUE)’ by comparing KEY with ALIST elements, and, if + found, returns the VALUE of that association. If no association is + found, the function returns DEFAULT. Comparison of KEY against + ALIST elements uses the function specified by TESTFN, defaulting to + ‘eq’. + + This is a generalized variable (*note (elisp)Generalized + Variables::) that can be used to change a value with ‘setf’. When + using it to set a value, optional argument REMOVE non-‘nil’ means + to remove KEY’s association from ALIST if the new value is ‘eql’ to + DEFAULT. + + *note (elisp)Association Lists::. + + -- Macro: if-let (bindings...) then &rest else... + As with ‘let*’, BINDINGS will consist of ‘(SYMBOL VALUE-FORM)’ + entries that are evaluated and bound sequentially. If all + VALUE-FORM evaluate to non-‘nil’ values, then THEN is evaluated as + were the case with a regular ‘let*’ expression, with all the + variables bound. If any VALUE-FORM evaluates to ‘nil’, ELSE is + evaluated, without any bound variables. + + A binding may also optionally drop the SYMBOL, and simplify to + ‘(VALUE-FORM)’ if only the test is of interest. + + For the sake of backwards compatibility, it is possible to write a + single binding without a binding list: + + (if-let* (SYMBOL (test)) foo bar) + ≡ + (if-let* ((SYMBOL (test))) foo bar) + + -- Macro: when-let (bindings...) &rest body + As with ‘when’, if one is only interested in the case where all + BINDINGS are non-nil. Otherwise BINDINGS are interpreted just as + they are by ‘if-let*’. + + -- Macro: thread-first &rest forms + Combine FORMS into a single expression by “threading” each element + as the _first_ argument of their successor. Elements of FORMS can + either be an list of an atom. + + For example, consider the threading expression and it’s equivalent + macro expansion: + + (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) + ≡ + (+ (- (/ (+ 5 20) 25)) 40) + + Note how the single ‘-’ got converted into a list before threading. + This example uses arithmetic functions, but ‘thread-first’ is not + restricted to arithmetic or side-effect free code. + + -- Macro: thread-last &rest forms + Combine FORMS into a single expression by “threading” each element + as the _last_ argument of their successor. Elements of FORMS can + either be an list of an atom. + + For example, consider the threading expression and it’s equivalent + macro expansion: + + (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) + ≡ + (+ 40 (- (/ 25 (+ 20 5)))) + + Note how the single ‘-’ got converted into a list before threading. + This example uses arithmetic functions, but ‘thread-last’ is not + restricted to arithmetic or side-effect free code. + + -- Function: macroexpand-1 form &optional environment + This function expands macros like ‘macroexpand’, but it only + performs one step of the expansion: if the result is another macro + call, ‘macroexpand-1’ will not expand it. + + *Note Expansion: (elisp)Expansion. + + -- Function: directory-files-recursively directory regexp &optional + include-directories predicate follow-symlinks + Return all files under DIRECTORY whose names match REGEXP. This + function searches the specified DIRECTORY and its sub-directories, + recursively, for files whose basenames (i.e., without the leading + directories) match the specified REGEXP, and returns a list of the + absolute file names of the matching files (*note absolute file + names: (elisp)Relative File Names.). The file names are returned + in depth-first order, meaning that files in some sub-directory are + returned before the files in its parent directory. In addition, + matching files found in each subdirectory are sorted alphabetically + by their basenames. By default, directories whose names match + REGEXP are omitted from the list, but if the optional argument + INCLUDE-DIRECTORIES is non-‘nil’, they are included. + + By default, all subdirectories are descended into. If PREDICATE is + ‘t’, errors when trying to descend into a subdirectory (for + instance, if it’s not readable by this user) are ignored. If it’s + neither ‘nil’ nor ‘t’, it should be a function that takes one + parameter (the subdirectory name) and should return non-‘nil’ if + the directory is to be descended into. + + Symbolic links to subdirectories are not followed by default, but + if FOLLOW-SYMLINKS is non-‘nil’, they are followed. + + *Note (elisp)Contents of Directories::. + + -- Function: bool-vector &rest objects + This function creates and returns a bool-vector whose elements are + the arguments, OBJECTS. + + *Note (elisp)Bool-Vectors::. + +2.2.2 Prefixed Definitions +-------------------------- + +These functions are prefixed with ‘compat’ prefix, and are only loaded +when ‘compat-25’ is required: + + -- Function: compat-sort sequence predicate + This function sorts SEQUENCE stably. Note that this function + doesn’t work for all sequences; it may be used only for lists and + vectors. If SEQUENCE is a list, it is modified destructively. + This functions returns the sorted SEQUENCE and compares elements + using PREDICATE. A stable sort is one in which elements with equal + sort keys maintain their relative order before and after the sort. + Stability is important when successive sorts are used to order + elements according to different criteria. + + *Note (elisp)Sequence Functions::. + + The compatibility version adds support for vectors to be sorted, + not just lists. + +2.2.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 25.1: + + • New ‘pcase’ patterns. + • The hook ‘prefix-command-echo-keystrokes-functions’ and + ‘prefix-command-preserve-state-hook’. + • The hook ‘pre-redisplay-functions’. + • The function ‘make-process’. + • Support for the variable ‘inhibit-message’. + • The ‘define-inline’ functionality. + • The functions ‘string-collate-lessp’ and ‘string-collate-equalp’. + • The function ‘funcall-interactivly’. + • The function ‘buffer-substring-with-bidi-context’. + • The function ‘font-info’. + • The function ‘default-font-width’. + • The function ‘window-font-height’ and ‘window-font-width’. + • The function ‘window-max-chars-per-line’. + • The function ‘set-binary-mode’. + • The functions ‘bufferpos-to-filepos’ and ‘filepos-to-bufferpos’. + + +File: compat.info, Node: Emacs 26.1, Next: Emacs 27.1, Prev: Emacs 25.1, Up: Support + +2.3 Emacs 26.1 +============== + +2.3.1 Unprefixed Definitions +---------------------------- + +The following functions and macros implemented in 26.1, and are provided +by Compat by default: + + -- Function: func-arity function + This function provides information about the argument list of the + specified FUNCTION. The returned value is a cons cell of the form + ‘(MIN . MAX)’, where MIN is the minimum number of arguments, and + MAX is either the maximum number of arguments, or the symbol ‘many’ + for functions with ‘&rest’ arguments, or the symbol ‘unevalled’ if + FUNCTION is a special form. + + Note that this function might return inaccurate results in some + situations, such as the following: + + − Functions defined using ‘apply-partially’ (*note + apply-partially: (elisp)Calling Functions.). + + − Functions that are advised using ‘advice-add’ (*note + (elisp)Advising Named Functions::). + + − Functions that determine the argument list dynamically, as + part of their code. + + *Note (elisp)What Is a Function::. + + -- Function: mapcan function sequence + This function applies FUNCTION to each element of SEQUENCE, like + ‘mapcar’, but instead of collecting the results into a list, it + returns a single list with all the elements of the results (which + must be lists), by altering the results (using ‘nconc’; *note + (elisp)Rearrangement::). Like with ‘mapcar’, SEQUENCE can be of + any type except a char-table. + + ;; Contrast this: (mapcar #'list '(a b c d)) ⇒ ((a) (b) (c) + (d)) ;; with this: (mapcan #'list '(a b c d)) ⇒ (a b c d) + + *Note (elisp)Mapping Functions::. + + -- Function: cXXXr + -- Function: cXXXXr + *Note (elisp)List Elements::. + + -- Function: gensym &optional prefix + This function returns a symbol using ‘make-symbol’, whose name is + made by appending ‘gensym-counter’ to PREFIX and incrementing that + counter, guaranteeing that no two calls to this function will + generate a symbol with the same name. The prefix defaults to + ‘"g"’. + + -- Variable: gensym-counter + See ‘gensym’. + + -- Function: make-nearby-temp-file prefix &optional dir-flag suffix + This function is similar to ‘make-temp-file’, but it creates a + temporary file as close as possible to ‘default-directory’. If + PREFIX is a relative file name, and ‘default-directory’ is a remote + file name or located on a mounted file systems, the temporary file + is created in the directory returned by the function + ‘temporary-file-directory’. Otherwise, the function + ‘make-temp-file’ is used. PREFIX, DIR-FLAG and SUFFIX have the + same meaning as in ‘make-temp-file’. + + (let ((default-directory "/ssh:remotehost:")) (make-nearby-temp-file + "foo")) ⇒ "/ssh:remotehost:/tmp/foo232J6v" + + -- Variable: mounted-file-systems + A regular expression matching files names that are probably on a + mounted file system. + + -- Function: temporary-file-directory + The directory for writing temporary files via + ‘make-nearby-temp-file’. In case of a remote ‘default-directory’, + this is a directory for temporary files on that remote host. If + such a directory does not exist, or ‘default-directory’ ought to be + located on a mounted file system (see ‘mounted-file-systems’), the + function returns ‘default-directory’. For a non-remote and + non-mounted ‘default-directory’, the value of the variable + ‘temporary-file-directory’ is returned. + + *Note (elisp)Unique File Names::. + + -- Macro: if-let* (bindings...) then &rest else + ‘if-let*’ is mostly equivalent to ‘if-let’, with the exception that + the legacy ‘(if (VAR (test)) foo bar)’ syntax is not permitted. + + -- Macro: when-let* (bindings...) then &rest else + ‘when-let*’ is mostly equivalent to ‘when-let’, with the exception + that the legacy ‘(when-let (VAR (test)) foo bar)’ syntax is not + permitted. + + -- Macro: and-let* (bindings...) &rest body + A combination of LET* and AND, analogous to ‘when-let*’. If all + BINDINGS are non-‘nil’ and BODY is ‘nil’, then the result of the + ‘and-let*’ form will be the last value bound in BINDINGS. + + **Please Note:** The implementation provided by Compat does not + include a bug that was observed with Emacs 26 (see + <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31840>). + + -- Function: file-local-name filename + This function returns the _local part_ of FILENAME. This is the + part of the file’s name that identifies it on the remote host, and + is typically obtained by removing from the remote file name the + parts that specify the remote host and the method of accessing it. + For example: + + (file-local-name "/ssh:USER@HOST:/foo/bar") ⇒ + "/foo/bar" + + For a remote FILENAME, this function returns a file name which + could be used directly as an argument of a remote process (*note + (elisp)Asynchronous Processes::, and *note (elisp)Synchronous + Processes::), and as the program to run on the remote host. If + FILENAME is local, this function returns it unchanged. + + *Note (elisp)Magic File Names::. + + -- Macro: file-name-quoted-p name + This macro returns non-‘nil’, when NAME is quoted with the prefix + ‘/:’. If NAME is a remote file name, the local part of NAME is + checked. + + *Note (elisp)File Name Expansion::. + + -- Macro: file-name-quote name + This macro adds the quotation prefix ‘/:’ to the file NAME. For a + local file NAME, it prefixes NAME with ‘/:’. If NAME is a remote + file name, the local part of NAME (*note (elisp)Magic File Names::) + is quoted. If NAME is already a quoted file name, NAME is returned + unchanged. + + (substitute-in-file-name (file-name-quote "bar/~/foo")) ⇒ + "/:bar/~/foo" + + (substitute-in-file-name (file-name-quote "/ssh:host:bar/~/foo")) + ⇒ "/ssh:host:/:bar/~/foo" + + The macro cannot be used to suppress file name handlers from magic + file names (*note (elisp)Magic File Names::). + + *Note (elisp)File Name Expansion::. + + -- Function: read-multiple-choice prompt choices &optional help-string + show-help long-form + Ask user a multiple choice question. PROMPT should be a string + that will be displayed as the prompt. + + CHOICES is an alist where the first element in each entry is a + character to be entered, the second element is a short name for the + entry to be displayed while prompting (if there’s room, it might be + shortened), and the third, optional entry is a longer explanation + that will be displayed in a help buffer if the user requests more + help. + + If optional argument LONG-FORM is non-‘nil’, the user will have to + type in long-form answers (using ‘completing-read’) instead of + hitting a single key. The answers must be among the second + elements of the values in the CHOICES list. + + Note: The Compat implementation of this function ignores the + optional arguments HELP-STRING and SHOW-HELP. Therefore the + optional third element in each CHOICES entry will also be + disregarded. + + See *note Reading One Event: (elisp)Reading One Event. + + -- Function: image-property + Defined in ‘image.el’. + + This function can also be used as a generalised variable. To use + this you need to explicitly require ‘compat-26’. + + -- Function: file-attribute-type + Return the field _type_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-link-number + Return the field _link-number_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-user-id + Return the field _user-id_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-group-id + Return the field _group-id_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-access-time + Return the field _access-time_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-modification-time + Return the field _modification-time_ as generated by + ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-status-change-time + Return the field _modification-time_ as generated by + ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-size + Return the field _size_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-modes + Return the field _modes_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-inode-number + Return the field _inode-number_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-device-number + Return the field _device-number_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-collect attributes &rest attr-names + Filter the file attributes ATTRIBUTES, as generated by + ‘file-attributes’, according to ATTR-NAMES. + + Valid attribute names for ATTR-NAMES are: type, link-number, + user-id, group-id, access-time, modification-time, + status-change-time, size, modes, inode-number and device-number. + + (file-attributes ".") ⇒ (t 1 1000 1000 (25329 18215 325481 96000) (25325 15364 530263 840000) (25325 15364 530263 840000) 788 "drwxr-xr-x" t 137819 40) + (file-attribute-collect (file-attributes ".") 'type 'modes + 'inode-number) ⇒ (t "drwxr-xr-x" 137819) + +2.3.2 Prefixed Definitions +-------------------------- + +These functions are prefixed with ‘compat’ prefix, and are only loaded +when ‘compat-26’ is required: + + -- Function: compat-assoc key alist &optional testfn + This function returns the first association for KEY in ALIST, + comparing KEY against the alist elements using TESTFN if it is a + function, and ‘equal’ otherwise (*note (elisp)Equality + Predicates::). If TESTFN is a function, it is called with two + arguments: the CAR of an element from ALIST and KEY. The function + returns ‘nil’ if no association in ALIST has a CAR equal to KEY, as + tested by TESTFN. + + *Note (elisp)Association Lists::. + + The compatibility version adds support for handling the optional + argument TESTFN. + + -- Function: compat-line-number-at-pos &optional pos absolute + This function returns the line number in the current buffer + corresponding to the buffer position POS. If POS is ‘nil’ or + omitted, the current buffer position is used. If ABSOLUTE is + ‘nil’, the default, counting starts at ‘(point-min)’, so the value + refers to the contents of the accessible portion of the + (potentially narrowed) buffer. If ABSOLUTE is non-‘nil’, ignore + any narrowing and return + + *Note (elisp)Text Lines::. + + The compatibility version adds support for handling the optional + argument ABSOLUTE. + + -- Function: compat-alist-get key alist &optional default remove testfn + *Note (elisp)Association Lists::. This function is similar to + ‘assq’. It finds the first association ‘(KEY . VALUE)’ by + comparing KEY with ALIST elements, and, if found, returns the VALUE + of that association. If no association is found, the function + returns DEFAULT. Comparison of KEY against ALIST elements uses the + function specified by TESTFN, defaulting to ‘eq’. + + *Note (elisp)Association Lists::. + + The compatibility version handles the optional argument TESTFN. It + can also be used as a *note Generalized Variables: + (elisp)generalised variable. + + -- Function: compat-string-trim-left string &optional regexp + Remove the leading text that matches REGEXP from STRING. REGEXP + defaults to ‘[ \t\n\r]+’. + + *Note (elisp)Creating Strings::. + + The compatibility version handles the optional argument REGEXP. + + -- Function: compat-string-trim-right string &optional regexp + Remove the trailing text that matches REGEXP from STRING. REGEXP + defaults to ‘[ \t\n\r]+’. + + *Note (elisp)Creating Strings::. + + The compatibility version handles the optional argument REGEXP. + + -- Function: compat-string-trim string &optional trim-left trim-right + Remove the leading text that matches TRIM-LEFT and trailing text + that matches TRIM-RIGHT from STRING. Both regexps default to ‘[ + \t\n\r]+’. + + *Note (elisp)Creating Strings::. + + The compatibility version handles the optional arguments TRIM-LEFT + and TRIM-RIGHT. + +2.3.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 26.1: + + • The function ‘secure-hash-algorithms’. + • The function ‘gnutls-avalaible-p’. + • Support for records and record functions. + • The function ‘mapbacktrace’. + • The function ‘file-name-case-insensitive-p’. + • The file-attributes constructors. + • The additional elements of ‘parse-partial-sexp’. + • The function ‘add-variable-watcher’. + • The function ‘undo-amalgamate-change-group’. + • The function ‘char-from-name’ + • Signalling errors when ‘length’ or ‘member’ deal with list cycles. + • The function ‘frame-list-z-order’. + • The function ‘frame-restack’. + • Support for side windows and atomic windows. + • All changes related to ‘display-buffer’. + • The function ‘window-swap-states’. + + +File: compat.info, Node: Emacs 27.1, Next: Emacs 28.1, Prev: Emacs 26.1, Up: Support + +2.4 Emacs 27.1 +============== + +2.4.1 Unprefixed Definitions +---------------------------- + +The following functions and macros implemented in 27.1, and are provided +by Compat by default: + + -- Function: proper-list-p object + This function returns the length of OBJECT if it is a proper list, + ‘nil’ otherwise (*note (elisp)Cons Cells::). In addition to + satisfying ‘listp’, a proper list is neither circular nor dotted. + + (proper-list-p '(a b c)) ⇒ 3 + (proper-list-p '(a b . c)) ⇒ nil + + *Note (elisp)List-related Predicates::. + + -- Function: string-distance string1 string2 &optional bytecompare + This function returns the _Levenshtein distance_ between the source + string STRING1 and the target string STRING2. The Levenshtein + distance is the number of single-character changes—deletions, + insertions, or replacements—required to transform the source string + into the target string; it is one possible definition of the _edit + distance_ between strings. + + Letter-case of the strings is significant for the computed + distance, but their text properties are ignored. If the optional + argument BYTECOMPARE is non-‘nil’, the function calculates the + distance in terms of bytes instead of characters. The byte-wise + comparison uses the internal Emacs representation of characters, so + it will produce inaccurate results for multibyte strings that + include raw bytes (*note (elisp)Text Representations::); make the + strings unibyte by encoding them (*note (elisp)Explicit Encoding::) + if you need accurate results with raw bytes. + + *Note (elisp)Text Comparison::. + + -- Function: json-serialize object &rest args + This function returns a new Lisp string which contains the JSON + representation of OBJECT. The argument ARGS is a list of + keyword/argument pairs. The following keywords are accepted: + + ‘:null-object’ + The value decides which Lisp object to use to represent the + JSON keyword ‘null’. It defaults to the symbol ‘:null’. + + ‘:false-object’ + The value decides which Lisp object to use to represent the + JSON keyword ‘false’. It defaults to the symbol ‘:false’. + + *Note (elisp)Parsing JSON::. + + -- Function: json-insert object &rest args + This function inserts the JSON representation of OBJECT into the + current buffer before point. The argument ARGS are interpreted as + in ‘json-parse-string’. + + *Note (elisp)Parsing JSON::. + + -- Function: json-parse-string string &rest args + This function parses the JSON value in STRING, which must be a Lisp + string. If STRING doesn’t contain a valid JSON object, this + function signals the ‘json-parse-error’ error. + + The argument ARGS is a list of keyword/argument pairs. The + following keywords are accepted: + + ‘:object-type’ + The value decides which Lisp object to use for representing + the key-value mappings of a JSON object. It can be either + ‘hash-table’, the default, to make hashtables with strings as + keys; ‘alist’ to use alists with symbols as keys; or ‘plist’ + to use plists with keyword symbols as keys. + + ‘:array-type’ + The value decides which Lisp object to use for representing a + JSON array. It can be either ‘array’, the default, to use + Lisp arrays; or ‘list’ to use lists. + + ‘:null-object’ + The value decides which Lisp object to use to represent the + JSON keyword ‘null’. It defaults to the symbol ‘:null’. + + ‘:false-object’ + The value decides which Lisp object to use to represent the + JSON keyword ‘false’. It defaults to the symbol ‘:false’. + + *Note (elisp)Parsing JSON::. + + -- Function: json-parse-buffer &rest args + This function reads the next JSON value from the current buffer, + starting at point. It moves point to the position immediately + after the value if contains a valid JSON object; otherwise it + signals the ‘json-parse-error’ error and doesn’t move point. The + arguments ARGS are interpreted as in ‘json-parse-string’. + + *Note (elisp)Parsing JSON::. + + -- Macro: ignore-errors body... + This construct executes BODY, ignoring any errors that occur during + its execution. If the execution is without error, ‘ignore-errors’ + returns the value of the last form in BODY; otherwise, it returns + ‘nil’. + + Here’s the example at the beginning of this subsection rewritten + using ‘ignore-errors’: + + (ignore-errors (delete-file filename)) + + *Note (elisp)Handling Errors::. + + -- Macro: dolist-with-progress-reporter (var count [result]) + reporter-or-message body... + This is another convenience macro that works the same way as + ‘dolist’ does, but also reports loop progress using the functions + described above. As in ‘dotimes-with-progress-reporter’, + ‘reporter-or-message’ can be a progress reporter or a string. You + can rewrite the previous example with this macro as follows: + + (dolist-with-progress-reporter (k (number-sequence 0 500)) "Collecting + some mana for Emacs..." (sit-for 0.01)) + + *Note (elisp)Progress::. + + -- Function: flatten-tree tree + This function returns a “flattened” copy of TREE, that is, a list + containing all the non-‘nil’ terminal nodes, or leaves, of the tree + of cons cells rooted at TREE. Leaves in the returned list are in + the same order as in TREE. + + (flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) ⇒(1 2 3 4 5 6 7) + + *Note (elisp)Building Lists::. + + -- Function: xor condition1 condition2 + This function returns the boolean exclusive-or of CONDITION1 and + CONDITION2. That is, ‘xor’ returns ‘nil’ if either both arguments + are ‘nil’, or both are non-‘nil’. Otherwise, it returns the value + of that argument which is non-‘nil’. + + Note that in contrast to ‘or’, both arguments are always evaluated. + + *Note (elisp)Combining Conditions::. + + -- Variable: regexp-unmatchable + This variable contains a regexp that is guaranteed not to match any + string at all. It is particularly useful as default value for + variables that may be set to a pattern that actually matches + something. + + *Note (elisp)Regexp Functions:: + + -- Function: decoded-time-second time + Return the SECONDS field of a ‘decoded-time’ record TIME. + + -- Function: decoded-time-minute time + Return the MINUTE field of a ‘decoded-time’ record TIME. + + -- Function: decoded-time-hour time + Return the HOUR field of a ‘decoded-time’ record TIME. + + -- Function: decoded-time-day time + Return the DAY field of a ‘decoded-time’ record TIME. + + -- Function: decoded-time-month time + Return the MONTH field of a ‘decoded-time’ record TIME. + + -- Function: decoded-time-year time + Return the YEAR field of a ‘decoded-time’ record TIME. + + -- Function: decoded-time-weekday time + Return the WEEKDAY field of a ‘decoded-time’ record TIME. + + -- Function: decoded-time-dst time + Return the DST (daylight saving time indicator) field of a + ‘decoded-time’ record TIME. + + -- Function: decoded-time-zone time + Return the ZONE field of a ‘decoded-time’ record TIME. + + -- Function: package-get-version + Return the version number of the package in which this is used. + + -- Function: time-equal-p t1 t2 + This returns ‘t’ if the two time values T1 and T2 are equal. + + *Note (elisp)Time Calculations::. + + -- Function: date-days-in-month year month + Return the number of days in MONTH in YEAR. For instance, February + 2020 has 29 days. + + *Note (elisp)Time Calculations::. This function requires the + ‘time-date’ feature to be loaded. + + -- User Option: exec-path + The value of this variable is a list of directories to search for + programs to run in subprocesses. Each element is either the name + of a directory (i.e., a string), or ‘nil’, which stands for the + default directory (which is the value of ‘default-directory’). + *Note executable-find: (elisp)Locating Files, for the details of + this search. + + The value of ‘exec-path’ is used by ‘call-process’ and + ‘start-process’ when the PROGRAM argument is not an absolute file + name. + + Generally, you should not modify ‘exec-path’ directly. Instead, + ensure that your ‘PATH’ environment variable is set appropriately + before starting Emacs. Trying to modify ‘exec-path’ independently + of ‘PATH’ can lead to confusing results. + + *Note (elisp)Subprocess Creation::. + + -- Function: provided-mode-derived-p mode &rest modes + This function returns non-‘nil’ if MODE is derived from any of the + major modes given by the symbols MODES. + + -- Function: derived-mode-p &rest modes + This function returns non-‘nil’ if the current major mode is + derived from any of the major modes given by the symbols MODES. + + *Note (elisp)Derived Modes::. + +2.4.2 Prefixed Definitions +-------------------------- + +These functions are prefixed with ‘compat’ prefix, and are only loaded +when ‘compat-27’ is required: + + -- Function: compat-recenter &optional count redisplay + This function scrolls the text in the selected window so that point + is displayed at a specified vertical position within the window. + It does not move point with respect to the text. + + *Note (elisp)Textual Scrolling::. + + This compatibility version adds support for the optional argument + REDISPLAY. + + -- Function: compat-lookup-key keymap key &optional accept-defaults + This function returns the definition of KEY in KEYMAP. If the + string or vector KEY is not a valid key sequence according to the + prefix keys specified in KEYMAP, it must be too long and have extra + events at the end that do not fit into a single key sequence. Then + the value is a number, the number of events at the front of KEY + that compose a complete key. + + *Note (elisp)Low-Level Key Binding::. + + This compatibility version allows for KEYMAP to be a list of + keymaps, instead of just a singular keymap. + + -- Macro: setq-local &rest pairs + PAIRS is a list of variable and value pairs. This macro creates a + buffer-local binding in the current buffer for each of the + variables, and gives them a buffer-local value. It is equivalent + to calling ‘make-local-variable’ followed by ‘setq’ for each of the + variables. The variables should be unquoted symbols. + + (setq-local var1 "value1" + var2 "value2") + + *Note (elisp)Creating Buffer-Local::. + + This compatibility version allows for more than one variable to be + set at once, as can be done with ‘setq’. + + -- Function: compat-regexp-opt strings &optional paren + This function returns an efficient regular expression that will + match any of the strings in the list STRINGS. This is useful when + you need to make matching or searching as fast as possible—for + example, for Font Lock mode. + + *Note (elisp)Regexp Functions::. + + The compatibility version of this functions handles the case where + STRINGS in an empty list. In that case, a regular expression is + generated that never matches anything (see ‘regexp-unmatchable’). + + -- Function: compat-file-size-human-readable file-size &optional flavor + space unit + Return a string with a human readable representation of FILE-SIZE. + + The optional second argument FLAVOR controls the units and the + display format. If FLAVOR is... + + • ‘si’, each kilobyte is 1000 bytes and the produced suffixes + are ‘k’, ‘M’, ‘G’, ‘T’, etc. + • ‘iec’, each kilobyte is 1024 bytes and the produced suffixes + are ‘KiB’, ‘MiB’, ‘GiB’, ‘TiB’, etc. + • ‘nil’ or omitted, each kilobyte is 1024 bytes and the produced + suffixes are ‘k’, ‘M’, ‘G’, ‘T’, etc. + + The compatibility version handles the optional third (SPACE) and + forth (UNIT) arguments. The argument SPACE can be a string that is + placed between the number and the unit. The argument UNIT + determines the unit to use. By default it will be an empty string, + unless FLAVOR is ‘iec’, in which case it will be ‘B’. + + -- Function: compat-assoc-delete-all + This function is like ‘assq-delete-all’ except that it accepts an + optional argument TEST, a predicate function to compare the keys in + ALIST. If omitted or ‘nil’, TEST defaults to ‘equal’. As + ‘assq-delete-all’, this function often modifies the original list + structure of ALIST. + + *Note (elisp)Association Lists::. + + This compatibility version handles the optional third (TESTFN) + argument. + + -- Function: compat-executable-find program &optional remote + This function searches for the executable file of the named PROGRAM + and returns the absolute file name of the executable, including its + file-name extensions, if any. It returns ‘nil’ if the file is not + found. The function searches in all the directories in + ‘exec-path’, and tries all the file-name extensions in + ‘exec-suffixes’ (*note (elisp)Subprocess Creation::). + + If REMOTE is non-‘nil’, and ‘default-directory’ is a remote + directory, PROGRAM is searched on the respective remote host. + + *Note (elisp)Locating Files::. + + This compatibility version adds support to handle the optional + second (REMOTE) argument. + + -- Function: compat-dired-get-marked-files &optional localp arg filter + distinguish-one-marked error + Return a list of file names that are _marked_ in a Dired buffer. + + This compatibility version handles the optional fifth (ERROR) + argument, which signals an error if the list of found files is + empty. ‘error’ can be a string with the error message. + +2.4.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 27.1: + + • Bigint support. + • The function ‘time-convert’. + • All ‘iso8601-*’ functions. + • The macro ‘benchmark-progn’. + • The function ‘read-char-from-minibuffer’. + • The minor mode ‘reveal-mode’. + • The macro ‘with-suppressed-warnings’. + • Support for ‘condition-case’ to handle t. + • The functions ‘major-mode-suspend’ and ‘major-mode-restore’. + • The function ‘provided-mode-derived-p’. + • The function ‘file-system-info’. + • The more consistent treatment of NaN values. + • The function ‘ring-resize’. + • The function ‘group-name’. + • Additional ‘format-spec’ modifiers. + • Support for additional body forms for + ‘define-globalized-minor-mode’. + • The macro ‘with-connection-local-variables’ and related + functionality. + + +File: compat.info, Node: Emacs 28.1, Prev: Emacs 27.1, Up: Support + +2.5 Emacs 28.1 +============== + +2.5.1 Unprefixed Definitions +---------------------------- + +The following functions and macros implemented in 28.1, and are provided +by Compat by default: + + -- Function: string-search needle haystack &optional start-pos + Return the position of the first instance of NEEDLE in HAYSTACK, + both of which are strings. If START-POS is non-‘nil’, start + searching from that position in NEEDLE. Return ‘nil’ if no match + was found. This function only considers the characters in the + strings when doing the comparison; text properties are ignored. + Matching is always case-sensitive. + + -- Function: length= sequence length + Return non-‘nil’ if the length of SEQUENCE is equal to LENGTH. + + -- Function: length< sequence length + Return non-‘nil’ if SEQUENCE is shorter than LENGTH. This may be + more efficient than computing the length of SEQUENCE if SEQUENCE is + a long list. + + -- Function: length> sequence length + Return non-‘nil’ if SEQUENCE is longer than LENGTH. + + -- Function: file-name-concat directory &rest components + Concatenate COMPONENTS to DIRECTORY, inserting a slash before the + components if DIRECTORY or the preceding component didn’t end with + a slash. + + (file-name-concat "/tmp" "foo") ⇒ "/tmp/foo" + + A DIRECTORY or components that are ‘nil’ or the empty string are + ignored—they are filtered out first and do not affect the results + in any way. + + This is almost the same as using ‘concat’, but DIRNAME (and the + non-final components) may or may not end with slash characters, and + this function will not double those characters. + + -- Function: garbage-collect-maybe factor + Suggest to run garbage collection, if _enough_ data has been + allocated. This is determined by the positive numerical argument + FACTOR, that would proportionally increase the likelihood of + garbage collection taking place. + + This compatibility function does nothing and ignores any + suggestion. + + -- Function: string-replace from-string to-string in-string + This function replaces all occurrences of FROM-STRING with + TO-STRING in IN-STRING and returns the result. It may return one + of its arguments unchanged, a constant string or a new string. + Case is significant, and text properties are ignored. + + -- Function: always &rest arguments + This function ignores any ARGUMENTS and returns ‘t’. + + *Note (elisp)Calling Functions::. + + -- Function: insert-into-buffer to-buffer &optional start end + This is like ‘insert-buffer-substring’, but works in the opposite + direction: The text is copied from the current buffer into + TO-BUFFER. The block of text is copied to the current point in + TO-BUFFER, and point (in that buffer) is advanced to after the end + of the copied text. Is ‘start’/‘end’ is ‘nil’, the entire text in + the current buffer is copied over. + + *Note (elisp)Insertion::. + + -- Function: replace-string-in-region regexp replacement &optional + start end + This function replaces all the occurrences of REGEXP with + REPLACEMENT in the region of buffer text between START and END; + START defaults to position of point, and END defaults to the last + accessible position of the buffer. The search for REGEXP is + case-sensitive, and REPLACEMENT is inserted without changing its + letter-case. The REPLACEMENT string can use the same special + elements starting with ‘\’ as ‘replace-match’ does. The function + returns the number of replaced occurrences, or ‘nil’ if REGEXP is + not found. The function preserves the position of point. + + (replace-regexp-in-region "foo[ \t]+bar" "foobar") + *Note (elisp)Search and Replace::. + + -- Function: replace-regexp-in-string string replacement &optional + start end + This function works similarly to ‘replace-regexp-in-region’, but + searches for, and replaces, literal STRINGs instead of regular + expressions. + + *Note (elisp)Search and Replace::. + + -- Function: buffer-local-boundp variable buffer + This returns non-‘nil’ if there’s either a buffer-local binding of + VARIABLE (a symbol) in buffer BUFFER, or VARIABLE has a global + binding. + + *Note (elisp)Creating Buffer-Local::. + + -- Macro: with-existing-directory body... + This macro ensures that ‘default-directory’ is bound to an existing + directory before executing BODY. If ‘default-directory’ already + exists, that’s preferred, and otherwise some other directory is + used. This macro can be useful, for instance, when calling an + external command that requires that it’s running in a directory + that exists. The chosen directory is not guaranteed to be + writable. + + *Note (elisp)Testing Accessibility::. + + -- Macro: dlet (bindings...) forms... + This special form is like ‘let’, but it binds all variables + dynamically. This is rarely useful—you usually want to bind normal + variables lexically, and special variables (i.e., variables that + are defined with ‘defvar’) dynamically, and this is what ‘let’ + does. + + ‘dlet’ can be useful when interfacing with old code that assumes + that certain variables are dynamically bound (*note (elisp)Dynamic + Binding::), but it’s impractical to ‘defvar’ these variables. + ‘dlet’ will temporarily make the bound variables special, execute + the forms, and then make the variables non-special again. + + *Note (elisp)Local Variables::. + + -- Function: ensure-list object + This function returns OBJECT as a list. If OBJECT is already a + list, the function returns it; otherwise, the function returns a + one-element list containing OBJECT. + + This is usually useful if you have a variable that may or may not + be a list, and you can then say, for instance: + + (dolist (elem (ensure-list foo)) + (princ elem)) + + *Note (elisp)Building Lists::. + + -- Function: string-clean-whitespace string + Clean up the whitespace in STRING by collapsing stretches of + whitespace to a single space character, as well as removing all + whitespace from the start and the end of STRING. + + *Note (elisp)Creating Strings::. + + -- Function: string-fill string length + Attempt to Word-wrap STRING so that no lines are longer than + LENGTH. Filling is done on whitespace boundaries only. If there + are individual words that are longer than LENGTH, these will not be + shortened. + + *Note (elisp)Creating Strings::. + + -- Function: string-lines string &optional omit-nulls keep-newlines + Split STRING into a list of strings on newline boundaries. If the + optional argument OMIT-NULLS is non-‘nil’, remove empty lines from + the results. If the optional argument KEEP-NEWLINES is non-‘nil’, + don’t remove the trailing newlines from the result strings. + + *Note (elisp)Creating Strings::. + + -- Function: string-pad string length &optional padding start + Pad STRING to be of the given LENGTH using PADDING as the padding + character. PADDING defaults to the space character. If STRING is + longer than LENGTH, no padding is done. If START is ‘nil’ or + omitted, the padding is appended to the characters of STRING, and + if it’s non-‘nil’, the padding is prepended to STRING’s characters. + + *Note (elisp)Creating Strings::. + + -- Function: string-chop-newline string + Remove the final newline, if any, from STRING. + + *Note (elisp)Creating Strings::. + + -- Macro: named-let name bindings &rest body + This special form is a looping construct inspired from the Scheme + language. It is similar to ‘let’: It binds the variables in + BINDINGS, and then evaluates BODY. However, ‘named-let’ also binds + NAME to a local function whose formal arguments are the variables + in BINDINGS and whose body is BODY. This allows BODY to call + itself recursively by calling NAME, where the arguments passed to + NAME are used as the new values of the bound variables in the + recursive invocation. + + Recursive calls to NAME that occur in _tail positions_ in BODY are + guaranteed to be optimized as _tail calls_, which means that they + will not consume any additional stack space no matter how deeply + the recursion runs. Such recursive calls will effectively jump to + the top of the loop with new values for the variables. + + *Note (elisp)Local Variables::. + + -- Function: file-name-with-extension filename extension + This function returns FILENAME with its extension set to EXTENSION. + A single leading dot in the EXTENSION will be stripped if there is + one. For example: + + (file-name-with-extension "file" "el") + ⇒ "file.el" + (file-name-with-extension "file" ".el") + ⇒ "file.el" + (file-name-with-extension "file.c" "el") + ⇒ "file.el" + + Note that this function will error if FILENAME or EXTENSION are + empty, or if the FILENAME is shaped like a directory (i.e., if + ‘directory-name-p’ returns non-‘nil’). + + *Note File Name Components: (elisp)File Name Components. + + -- Function: directory-empty-p directory + This utility function returns ‘t’ if given DIRECTORY is an + accessible directory and it does not contain any files, i.e., is an + empty directory. It will ignore ‘.’ and ‘..’ on systems that + return them as files in a directory. + + Symbolic links to directories count as directories. See + FILE-SYMLINK-P to distinguish symlinks. + + *Note (elisp)Contents of Directories::. + + -- Function: format-prompt prompt default &rest format-args + Format PROMPT with default value DEFAULT according to the + ‘minibuffer-default-prompt-format’ variable. + + ‘minibuffer-default-prompt-format’ is a format string (defaulting + to ‘" (default %s)"’ that says how the “default” bit in prompts + like ‘"Local filename (default somefile): "’ are to be formatted. + + To allow the users to customize how this is displayed, code that + prompts the user for a value (and has a default) should look + something along the lines of this code snippet: + + (read-file-name + (format-prompt "Local filename" file) + nil file) + + If FORMAT-ARGS is ‘nil’, PROMPT is used as a literal string. If + FORMAT-ARGS is non-‘nil’, PROMPT is used as a format control + string, and PROMPT and FORMAT-ARGS are passed to ‘format’ (*note + (elisp)Formatting Strings::). + + ‘minibuffer-default-prompt-format’ can be ‘""’, in which case no + default values are displayed. + + If DEFAULT is ‘nil’, there is no default value, and therefore no + “default value” string is included in the result value. If DEFAULT + is a non-‘nil’ list, the first element of the list is used in the + prompt. + + *Note (elisp)Text from Minibuffer::. + + -- Function: thing-at-mouse event thing &optional no-properties + Mouse-EVENT equivalent of ‘thing-at-point’. THING can be ‘symbol’, + ‘list’, ‘sexp’, ‘filename’, ‘url’, ... among other things. + + When NO-PROPERTIES has a non-‘nil’ value, any text properties that + might have been present in the buffer are stripped away. + + -- Function: macroexp-file-name + Return the name of the file in which the code is currently being + evaluated, or ‘nil’ if it cannot be determined. + + -- Macro: with-environment-variables variables body... + This macro sets the environment variables according to VARIABLES + temporarily when executing BODY. The previous values are restored + when the form finishes. The argument VARIABLES should be a list of + pairs of strings of the form ‘(VAR VALUE)’, where VAR is the name + of the environment variable and VALUE is that variable’s value. + + (with-environment-variables (("LANG" "C") + ("LANGUAGE" "en_US:en")) + (call-process "ls" nil t)) + + *Note System Environment: (elisp)System Environment. + + -- Function: button-buttonize string callback &optional data help-echo + Return a button with STRING as its label. When interacted on, the + one-argument function in CALLBACK is called and DATA (or ‘nil’ is + not present) will be passed as the argument. + + If non-‘nil’, the argument HELP-ECHO will be used to set the + ‘help-echo’ text property. + + -- Function: make-directory-autoloads dir output-file + Parse and search the directory DIR for autoload definitions, and + write the processed results to the file OUTPUT-FILE. + + -- Function: color-values-from-color-spec spec + Convert the textual color specification SPEC to a color triple + ‘(RED GREEN blue)’. Each of RED, GREEN and ‘blue’ is a integer + value between 0 and 65535. + + The specification SPEC can be one of the following + • ‘#RGB’, where R, G and B are hex numbers of equal length, 1-4 + digits each. + • ‘rgb:R/G/B’, where R, G, and B are hex numbers, 1-4 digits + each. + • ‘rgbi:R/G/B’, where R, G and B are floating-point numbers in + [0,1]. + + -- Function: file-modes-number-to-symbolic modes + This function converts a numeric file mode specification in MODES + into the equivalent symbolic form. + + *Note Changing Files: (elisp)Changing Files. + + -- Function: file-backup-file-names filename + This function returns a list of all the backup file names for + FILENAME, or ‘nil’ if there are none. The files are sorted by + modification time, descending, so that the most recent files are + first. + + *Note (elisp)Backup Names::. + + -- Function: make-lock-file-name filename + Return a string containing a lock file name for FILENAME, obeying + ‘lock-file-name-transforms’. + + -- Function: null-device + Return the path to the null device (usually something like + ‘/dev/null’) on the current system. + + -- Function: decoded-time-period time + Interpret TIME as a period and return its length in seconds. For + computational purposes, years are 365 days long and months are 30 + days long. + + -- Function: subr-primitive-p object + Return ‘t’ if OBJECT is a primitive, built-in function. On systems + with native compilation ‘subrp’ does not distinguish between + built-in functions and functions that have been compiled. If + native compilation is not avaliable, this function behaves + identically to ‘subrp’. + + -- Function: file-name-absolute-p filename + This function returns ‘t’ if file FILENAME is an absolute file + name, ‘nil’ otherwise. A file name is considered to be absolute if + its first component is ‘~’, or is ‘~USER’ where USER is a valid + login name. In the following examples, assume that there is a user + named ‘rms’ but no user named ‘nosuchuser’. + + (file-name-absolute-p "~rms/foo") + ⇒ t + (file-name-absolute-p "~nosuchuser/foo") + ⇒ nil + (file-name-absolute-p "rms/foo") + ⇒ nil + (file-name-absolute-p "/user/rms/foo") + ⇒ t + + *Note (elisp)Absolute and Relative File Names::. + +2.5.2 Prefixed Definitions +-------------------------- + +These functions are prefixed with ‘compat’ prefix, and are only loaded +when ‘compat-28’ is required: + + -- Function: compat-unlock-buffer + This function unlocks the file being visited in the current buffer, + if the buffer is modified. If the buffer is not modified, then the + file should not be locked, so this function does nothing. It also + does nothing if the current buffer is not visiting a file, or is + not locked. This function handles file system errors by calling + ‘display-warning’ and otherwise ignores the error. + + *Note (elisp)File Locks::. + + This compatibility versions catches the ‘file-error’ condition, + issuing a warning instead of propagating on the error. + + -- Function: compat-string-width string &optional from to + This function returns the width in columns of the string STRING, if + it were displayed in the current buffer and the selected window. + Optional arguments FROM and TO specify the substring of STRING to + consider, and are interpreted as in ‘substring’ (*note + (elisp)Creating Strings::). + + The return value is an approximation: it only considers the values + returned by ‘char-width’ for the constituent characters, always + takes a tab character as taking ‘tab-width’ columns, ignores + display properties and fonts, etc. + + *Note (elisp)Size of Displayed Text::. + + This compatibility version handles the optional arguments FROM and + TO. + + -- Function: compat-json-serialize + *Note Emacs 27.1::. + + This compatibility version handles primitive, top-level JSON values + (numbers, strings, booleans). + + -- Function: compat-json-insert + *Note Emacs 27.1::. + + This compatibility version handles primitive, top-level JSON values + (numbers, strings, booleans). + + -- Function: compat-json-parse-string + *Note Emacs 27.1::. + + This compatibility version handles primitive, top-level JSON values + (numbers, strings, booleans). + + -- Function: compat-json-parse-buffer + *Note Emacs 27.1::. + + This compatibility version handles primitive, top-level JSON values + (numbers, strings, booleans). + + -- Function: compat-count-windows + Return the number of live windows on the selected frame. + + The optional argument MINIBUF specifies whether the minibuffer + window is included in the count. + + If ALL-FRAMES is non-‘nil’, count the windows in all frames instead + just the selected frame. + + This compatibility version handles the optional argument + ALL-FRAMES. + +2.5.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 28.1: + + • Support for ‘interactive’ or ‘declare’ to list applicable modes. + • Support for ‘:interactive’ argument to ‘define-minor-mode’ and + ‘define-derived-mode’. + • Support for ‘:predicate’ argument to + ‘define-globalized-minor-mode’. + • "Success handler" for ‘condition-case’. + • The function ‘benchmark-call’. + • Support for the ‘natnum’ defcustom type. + • The function ‘macroexp-compiling-p’. + • The function ‘macroexp-warn-and-return’. + • Additional Edebug keywords. + • Shorthand support. + • The function ‘custom-add-choice’. + • The function ‘decoded-time-period’. + • The function ‘dom-print’. + • The function ‘dom-remove-attribute’. + • The function ‘dns-query-asynchronous’. + • The function ‘get-locale-names’. + • The function ‘json-avaliable-p’. + • The function ‘mail-header-parse-addresses-lax’. + • The function ‘mail-header-parse-address-lax’. + • The function ‘make-separator-line’. + • The function ‘num-processors’. + • The function ‘object-intervals’. + • The function ‘process-lines-ignore-status’. + • The function ‘require-theme’. + • The function ‘syntax-class-to-char’. + • The function ‘path-separator’. + + +File: compat.info, Node: Development, Next: Function Index, Prev: Support, Up: Top + +3 Development +************* + +Compat is developed on SourceHut (https://sr.ht/~pkal/compat). A +restricted GitHub mirror (https://github.com/phikal/compat.el) is also +maintained. + + Patches and comments can be sent to the development mailing list +(https://lists.sr.ht/~pkal/compat-devel) (~pkal/compat-devel@lists.sr.ht +<~pkal/compat-devel@lists.sr.ht>). Bug reports are best sent to the +issue tracker (https://todo.sr.ht/~pkal/compat) (~pkal/compat@todo.sr.ht +<~pkal/compat@todo.sr.ht>). The GitHub mirror can also be used to +submit patches. These may include issues in the compatibility code, +missing definitions or performance issues. + + Please note that as a GNU ELPA package, Compat requires contributors +to have signed the FSF copyright assignment +(https://www.gnu.org/software/emacs/manual/html_node/emacs/Copyright-Assignment.html), +before any non-trivial contribution (roughly 15 lines of code) can be +applied. + + +File: compat.info, Node: Function Index, Next: Variable Index, Prev: Development, Up: Top + +Appendix A Function Index +************************* + + +* Menu: + +* alist-get: Emacs 25.1. (line 50) +* always: Emacs 28.1. (line 61) +* and-let*: Emacs 26.1. (line 99) +* bool-vector: Emacs 25.1. (line 166) +* bool-vector-count-consecutive: Emacs 24.4. (line 118) +* bool-vector-count-population: Emacs 24.4. (line 125) +* bool-vector-exclusive-or: Emacs 24.4. (line 76) +* bool-vector-intersection: Emacs 24.4. (line 90) +* bool-vector-not: Emacs 24.4. (line 104) +* bool-vector-set-difference: Emacs 24.4. (line 97) +* bool-vector-subsetp: Emacs 24.4. (line 111) +* bool-vector-union: Emacs 24.4. (line 83) +* buffer-local-boundp: Emacs 28.1. (line 99) +* button-buttonize: Emacs 28.1. (line 285) +* color-values-from-color-spec: Emacs 28.1. (line 297) +* compat-<: Emacs 24.4. (line 175) +* compat-<=: Emacs 24.4. (line 185) +* compat-=: Emacs 24.4. (line 170) +* compat->: Emacs 24.4. (line 180) +* compat->=: Emacs 24.4. (line 190) +* compat-alist-get: Emacs 26.1. (line 284) +* compat-assoc: Emacs 26.1. (line 256) +* compat-assoc-delete-all: Emacs 27.1. (line 305) +* compat-count-windows: Emacs 28.1. (line 422) +* compat-dired-get-marked-files: Emacs 27.1. (line 333) +* compat-executable-find: Emacs 27.1. (line 317) +* compat-file-size-human-readable: Emacs 27.1. (line 285) +* compat-json-insert: Emacs 28.1. (line 404) +* compat-json-parse-buffer: Emacs 28.1. (line 416) +* compat-json-parse-string: Emacs 28.1. (line 410) +* compat-json-serialize: Emacs 28.1. (line 398) +* compat-line-number-at-pos: Emacs 26.1. (line 270) +* compat-lookup-key: Emacs 27.1. (line 245) +* compat-recenter: Emacs 27.1. (line 235) +* compat-regexp-opt: Emacs 27.1. (line 273) +* compat-sort: Emacs 25.1. (line 178) +* compat-split-string: Emacs 24.4. (line 199) +* compat-string-trim: Emacs 26.1. (line 314) +* compat-string-trim-left: Emacs 26.1. (line 298) +* compat-string-trim-right: Emacs 26.1. (line 306) +* compat-string-width: Emacs 28.1. (line 381) +* compat-unlock-buffer: Emacs 28.1. (line 368) +* completion-table-with-cache: Emacs 24.4. (line 130) +* cXXXr: Emacs 26.1. (line 47) +* cXXXXr: Emacs 26.1. (line 48) +* date-days-in-month: Emacs 27.1. (line 193) +* decoded-time-day: Emacs 27.1. (line 166) +* decoded-time-dst: Emacs 27.1. (line 178) +* decoded-time-hour: Emacs 27.1. (line 163) +* decoded-time-minute: Emacs 27.1. (line 160) +* decoded-time-month: Emacs 27.1. (line 169) +* decoded-time-period: Emacs 28.1. (line 332) +* decoded-time-second: Emacs 27.1. (line 157) +* decoded-time-weekday: Emacs 27.1. (line 175) +* decoded-time-year: Emacs 27.1. (line 172) +* decoded-time-zone: Emacs 27.1. (line 182) +* define-error: Emacs 24.4. (line 65) +* delete-consecutive-dups: Emacs 24.4. (line 60) +* derived-mode-p: Emacs 27.1. (line 223) +* directory-empty-p: Emacs 28.1. (line 218) +* directory-files-recursively: Emacs 25.1. (line 139) +* directory-name-p: Emacs 25.1. (line 24) +* dlet: Emacs 28.1. (line 117) +* dolist-with-progress-reporter: Emacs 27.1. (line 116) +* ensure-list: Emacs 28.1. (line 132) +* face-spec-set: Emacs 24.4. (line 139) +* file-attribute-access-time: Emacs 26.1. (line 201) +* file-attribute-collect: Emacs 26.1. (line 238) +* file-attribute-device-number: Emacs 26.1. (line 233) +* file-attribute-group-id: Emacs 26.1. (line 196) +* file-attribute-inode-number: Emacs 26.1. (line 228) +* file-attribute-link-number: Emacs 26.1. (line 186) +* file-attribute-modes: Emacs 26.1. (line 223) +* file-attribute-modification-time: Emacs 26.1. (line 206) +* file-attribute-size: Emacs 26.1. (line 218) +* file-attribute-status-change-time: Emacs 26.1. (line 212) +* file-attribute-type: Emacs 26.1. (line 181) +* file-attribute-user-id: Emacs 26.1. (line 191) +* file-backup-file-names: Emacs 28.1. (line 316) +* file-local-name: Emacs 26.1. (line 108) +* file-modes-number-to-symbolic: Emacs 28.1. (line 310) +* file-name-absolute-p: Emacs 28.1. (line 344) +* file-name-concat: Emacs 28.1. (line 31) +* file-name-quote: Emacs 26.1. (line 133) +* file-name-quoted-p: Emacs 26.1. (line 126) +* file-name-with-extension: Emacs 28.1. (line 200) +* flatten-tree: Emacs 27.1. (line 129) +* format-message: Emacs 25.1. (line 12) +* format-prompt: Emacs 28.1. (line 229) +* func-arity: Emacs 26.1. (line 12) +* garbage-collect-maybe: Emacs 28.1. (line 46) +* gensym: Emacs 26.1. (line 51) +* if-let: Emacs 25.1. (line 67) +* if-let*: Emacs 26.1. (line 90) +* ignore-errors: Emacs 27.1. (line 103) +* image-property: Emacs 26.1. (line 175) +* insert-into-buffer: Emacs 28.1. (line 66) +* json-insert: Emacs 27.1. (line 57) +* json-parse-buffer: Emacs 27.1. (line 94) +* json-parse-string: Emacs 27.1. (line 64) +* json-serialize: Emacs 27.1. (line 42) +* length<: Emacs 28.1. (line 23) +* length=: Emacs 28.1. (line 20) +* length>: Emacs 28.1. (line 28) +* macroexp-file-name: Emacs 28.1. (line 267) +* macroexpand-1: Emacs 25.1. (line 132) +* macrop: Emacs 24.4. (line 47) +* make-directory-autoloads: Emacs 28.1. (line 293) +* make-lock-file-name: Emacs 28.1. (line 324) +* make-nearby-temp-file: Emacs 26.1. (line 61) +* mapcan: Emacs 26.1. (line 34) +* named-let: Emacs 28.1. (line 182) +* null-device: Emacs 28.1. (line 328) +* package-get-version: Emacs 27.1. (line 185) +* proper-list-p: Emacs 27.1. (line 12) +* provided-mode-derived-p: Emacs 27.1. (line 219) +* read-multiple-choice: Emacs 26.1. (line 151) +* replace-regexp-in-string: Emacs 28.1. (line 91) +* replace-string-in-region: Emacs 28.1. (line 76) +* setq-local: Emacs 27.1. (line 258) +* special-form-p: Emacs 24.4. (line 41) +* string-chop-newline: Emacs 28.1. (line 177) +* string-clean-whitespace: Emacs 28.1. (line 145) +* string-distance: Emacs 27.1. (line 22) +* string-fill: Emacs 28.1. (line 152) +* string-greaterp: Emacs 25.1. (line 32) +* string-lines: Emacs 28.1. (line 160) +* string-pad: Emacs 28.1. (line 168) +* string-replace: Emacs 28.1. (line 55) +* string-search: Emacs 28.1. (line 12) +* string-suffix-p: Emacs 24.4. (line 53) +* subr-primitive-p: Emacs 28.1. (line 337) +* temporary-file-directory: Emacs 26.1. (line 78) +* thing-at-mouse: Emacs 28.1. (line 260) +* thread-first: Emacs 25.1. (line 90) +* thread-last: Emacs 25.1. (line 111) +* time-equal-p: Emacs 27.1. (line 188) +* when-let: Emacs 25.1. (line 85) +* when-let*: Emacs 26.1. (line 94) +* with-environment-variables: Emacs 28.1. (line 271) +* with-eval-after-load: Emacs 24.4. (line 12) +* with-existing-directory: Emacs 28.1. (line 106) +* with-file-modes: Emacs 25.1. (line 39) +* xor: Emacs 27.1. (line 139) + + +File: compat.info, Node: Variable Index, Prev: Function Index, Up: Top + +Appendix B Variable Index +************************* + + +* Menu: + +* exec-path: Emacs 27.1. (line 200) +* gensym-counter: Emacs 26.1. (line 58) +* mounted-file-systems: Emacs 26.1. (line 74) +* regexp-unmatchable: Emacs 27.1. (line 149) + + + +Tag Table: +Node: Top821 +Node: Introduction2274 +Node: Overview2433 +Node: Usage3656 +Node: Additional libraries4663 +Node: Intentions5118 +Node: Support6728 +Node: Emacs 24.47310 +Node: Emacs 25.117364 +Node: Emacs 26.126321 +Node: Emacs 27.140419 +Node: Emacs 28.155775 +Node: Development75469 +Node: Function Index76484 +Node: Variable Index87168 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/elpa/compat-28.1.2.2/dir b/elpa/compat-28.1.2.2/dir @@ -0,0 +1,18 @@ +This is the file .../info/dir, which contains the +topmost node of the Info hierarchy, called (dir)Top. +The first time you invoke Info you start off looking at this node. + +File: dir, Node: Top This is the top of the INFO tree + + This (the Directory node) gives a menu of major topics. + Typing "q" exits, "H" lists all Info commands, "d" returns here, + "h" gives a primer for first-timers, + "mEmacs<Return>" visits the Emacs manual, etc. + + In Emacs, you can click mouse button 2 on a menu item or cross reference + to select it. + +* Menu: + +Emacs +* Compat: (compat). Compatibility Library for Emacs Lisp. diff --git a/elpa/consult-0.17/consult-autoloads.el b/elpa/consult-0.17/consult-autoloads.el @@ -1,522 +0,0 @@ -;;; consult-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "consult" "consult.el" (0 0 0 0)) -;;; Generated autoloads from consult.el - -(autoload 'consult-completion-in-region "consult" "\ -Use minibuffer completion as the UI for `completion-at-point'. - -The function is called with 4 arguments: START END COLLECTION PREDICATE. -The arguments and expected return value are as specified for -`completion-in-region'. Use as a value for `completion-in-region-function'. - -The function can be configured via `consult-customize'. - - (consult-customize consult-completion-in-region - :completion-styles (basic) - :cycle-threshold 3) - -These configuration options are supported: - - * :cycle-threshold - Cycling threshold (def: `completion-cycle-threshold') - * :completion-styles - Use completion styles (def: `completion-styles') - * :require-match - Require matches when completing (def: nil) - * :prompt - The prompt string shown in the minibuffer - -\(fn START END COLLECTION &optional PREDICATE)" nil nil) - -(autoload 'consult-completing-read-multiple "consult" "\ -Enhanced replacement for `completing-read-multiple'. -See `completing-read-multiple' for the documentation of the arguments. - -\(fn PROMPT TABLE &optional PRED REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil) - -(autoload 'consult-multi-occur "consult" "\ -Improved version of `multi-occur' based on `completing-read-multiple'. - -See `multi-occur' for the meaning of the arguments BUFS, REGEXP and NLINES. - -\(fn BUFS REGEXP &optional NLINES)" t nil) - -(autoload 'consult-outline "consult" "\ -Jump to an outline heading, obtained by matching against `outline-regexp'. - -This command supports narrowing to a heading level and candidate preview. -The symbol at point is added to the future history." t nil) - -(autoload 'consult-mark "consult" "\ -Jump to a marker in MARKERS list (defaults to buffer-local `mark-ring'). - -The command supports preview of the currently selected marker position. -The symbol at point is added to the future history. - -\(fn &optional MARKERS)" t nil) - -(autoload 'consult-global-mark "consult" "\ -Jump to a marker in MARKERS list (defaults to `global-mark-ring'). - -The command supports preview of the currently selected marker position. -The symbol at point is added to the future history. - -\(fn &optional MARKERS)" t nil) - -(autoload 'consult-line "consult" "\ -Search for a matching line. - -Depending on the setting `consult-line-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. - -\(fn &optional INITIAL START)" t nil) - -(autoload 'consult-line-multi "consult" "\ -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'. - -\(fn QUERY &optional INITIAL)" t nil) - -(autoload 'consult-keep-lines "consult" "\ -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 -command obeys narrowing. - -FILTER is the filter function. -INITIAL is the initial input. - -\(fn &optional FILTER INITIAL)" t nil) - -(autoload 'consult-focus-lines "consult" "\ -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. - -FILTER is the filter function. -INITIAL is the initial input. - -\(fn &optional SHOW FILTER INITIAL)" t nil) - -(autoload 'consult-goto-line "consult" "\ -Read line number and jump to the line with preview. - -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'. - -\(fn &optional ARG)" t nil) - -(autoload 'consult-recent-file "consult" "\ -Find recent file using `completing-read'." t nil) - -(autoload 'consult-file-externally "consult" "\ -Open FILE externally using the default application of the system. - -\(fn FILE)" t nil) - -(autoload 'consult-mode-command "consult" "\ -Run a command from any of the given MODES. - -If no MODES are specified, use currently active major and minor modes. - -\(fn &rest MODES)" t nil) - -(autoload 'consult-yank-from-kill-ring "consult" "\ -Select STRING from the kill ring and insert it. -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 -version supports preview of the selected string. - -\(fn STRING &optional ARG)" t nil) - -(autoload 'consult-yank-pop "consult" "\ -If there is a recent yank act like `yank-pop'. - -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 -version supports preview of the selected string. - -\(fn &optional ARG)" t nil) - -(autoload 'consult-yank-replace "consult" "\ -Select STRING from the kill ring. - -If there was no recent yank, insert the string. -Otherwise replace the just-yanked string with the selected string. - -There exists no equivalent of this command in Emacs 28. - -\(fn STRING)" t nil) - -(autoload 'consult-bookmark "consult" "\ -If bookmark NAME exists, open it, otherwise create a new bookmark with NAME. - -The command supports preview of file bookmarks and narrowing. See the -variable `consult-bookmark-narrow' for the narrowing configuration. - -\(fn NAME)" t nil) - -(autoload 'consult-apropos "consult" "\ -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'." t nil) - -(autoload 'consult-complex-command "consult" "\ -Select and evaluate command from the command history. - -This command can act as a drop-in replacement for `repeat-complex-command'." t nil) - -(autoload 'consult-history "consult" "\ -Insert string from HISTORY of current buffer. - -In order to select from a specific HISTORY, pass the history variable -as argument. - -\(fn &optional HISTORY)" t nil) - -(autoload 'consult-isearch-history "consult" "\ -Read a search string with completion from the Isearch history. - -This replaces the current search string if Isearch is active, and -starts a new Isearch session otherwise." t nil) - -(autoload 'consult-minor-mode-menu "consult" "\ -Enable or disable minor mode. - -This is an alternative to `minor-mode-menu-from-indicator'." t nil) - -(autoload 'consult-theme "consult" "\ -Disable current themes and enable THEME from `consult-themes'. - -The command supports previewing the currently selected theme. - -\(fn THEME)" t nil) - -(autoload 'consult-buffer "consult" "\ -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), -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 -configuration of the virtual buffer sources. - -\(fn &optional SOURCES)" t nil) - -(autoload 'consult-project-buffer "consult" "\ -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." t nil) - -(autoload 'consult-buffer-other-window "consult" "\ -Variant of `consult-buffer' which opens in other window." t nil) - -(autoload 'consult-buffer-other-frame "consult" "\ -Variant of `consult-buffer' which opens in other frame." t nil) - -(autoload 'consult-kmacro "consult" "\ -Run a chosen keyboard macro. - -With prefix ARG, run the macro that many times. -Macros containing mouse clicks are omitted. - -\(fn ARG)" t nil) - -(autoload 'consult-grep "consult" "\ -Search with `grep' for files in DIR where the content matches a regexp. - -The initial input is given by the INITIAL argument. - -The input string is split, the first part of the string (grep input) is -passed to the asynchronous grep process and the second part of the string is -passed to the completion-style filtering. - -The input string is split at a punctuation character, which is given as the -first character of the input string. The format is similar to Perl-style -regular expressions, e.g., /regexp/. Furthermore command line options can be -passed to grep, specified behind --. The overall prompt input has the form -`#async-input -- grep-opts#filter-string'. - -Note that the grep input string is transformed from Emacs regular expressions -to Posix regular expressions. Always enter Emacs regular expressions at the -prompt. `consult-grep' behaves like builtin Emacs search commands, e.g., -Isearch, which take Emacs regular expressions. Furthermore the asynchronous -input split into words, each word must match separately and in any order. See -`consult--regexp-compiler' for the inner workings. In order to disable -transformations of the grep input, adjust `consult--regexp-compiler' -accordingly. - -Here we give a few example inputs: - -#alpha beta : Search for alpha and beta in any order. -#alpha.*beta : Search for alpha before beta. -#\\(alpha\\|beta\\) : Search for alpha or beta (Note Emacs syntax!) -#word -- -C3 : Search for word, include 3 lines as context -#first#second : Search for first, quick filter for second. - -The symbol at point is added to the future history. If `consult-grep' -is called interactively with a prefix argument, the user can specify -the directory to search in. By default the project directory is used -if `consult-project-function' is defined and returns non-nil. -Otherwise the `default-directory' is searched. - -\(fn &optional DIR INITIAL)" t nil) - -(autoload 'consult-git-grep "consult" "\ -Search with `git grep' for files in DIR where the content matches a regexp. -The initial input is given by the INITIAL argument. See `consult-grep' -for more details. - -\(fn &optional DIR INITIAL)" t nil) - -(autoload 'consult-ripgrep "consult" "\ -Search with `rg' for files in DIR where the content matches a regexp. -The initial input is given by the INITIAL argument. See `consult-grep' -for more details. - -\(fn &optional DIR INITIAL)" t nil) - -(autoload 'consult-find "consult" "\ -Search for files in DIR matching input regexp given INITIAL input. - -The find process is started asynchronously, similar to `consult-grep'. -See `consult-grep' for more details regarding the asynchronous search. - -\(fn &optional DIR INITIAL)" t nil) - -(autoload 'consult-locate "consult" "\ -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 -details regarding the asynchronous search. - -\(fn &optional INITIAL)" t nil) - -(autoload 'consult-man "consult" "\ -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 -the asynchronous search. - -\(fn &optional INITIAL)" t nil) - -(register-definition-prefixes "consult" '("consult-")) - -;;;*** - -;;;### (autoloads nil "consult-compile" "consult-compile.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from consult-compile.el - -(autoload 'consult-compile-error "consult-compile" "\ -Jump to a compilation error in the current buffer. - -This command collects entries from compilation buffers and grep -buffers related to the current buffer. The command supports -preview of the currently selected error." t nil) - -(register-definition-prefixes "consult-compile" '("consult-compile--")) - -;;;*** - -;;;### (autoloads nil "consult-flymake" "consult-flymake.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from consult-flymake.el - -(autoload 'consult-flymake "consult-flymake" "\ -Jump to Flymake diagnostic." t nil) - -(register-definition-prefixes "consult-flymake" '("consult-flymake--")) - -;;;*** - -;;;### (autoloads nil "consult-icomplete" "consult-icomplete.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from consult-icomplete.el - -(register-definition-prefixes "consult-icomplete" '("consult-icomplete--refresh")) - -;;;*** - -;;;### (autoloads nil "consult-imenu" "consult-imenu.el" (0 0 0 0)) -;;; Generated autoloads from consult-imenu.el - -(autoload 'consult-imenu "consult-imenu" "\ -Select item from flattened `imenu' using `completing-read' with preview. - -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'." t nil) - -(autoload 'consult-imenu-multi "consult-imenu" "\ -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, -QUERY can be set to a plist according to `consult--buffer-query'. - -\(fn &optional QUERY)" t nil) - -(register-definition-prefixes "consult-imenu" '("consult-imenu-")) - -;;;*** - -;;;### (autoloads nil "consult-org" "consult-org.el" (0 0 0 0)) -;;; Generated autoloads from consult-org.el - -(autoload 'consult-org-heading "consult-org" "\ -Jump to an Org heading. - -MATCH and SCOPE are as in `org-map-entries' and determine which -entries are offered. By default, all entries of the current -buffer are offered. - -\(fn &optional MATCH SCOPE)" t nil) - -(autoload 'consult-org-agenda "consult-org" "\ -Jump to an Org agenda heading. - -By default, all agenda entries are offered. MATCH is as in -`org-map-entries' and can used to refine this. - -\(fn &optional MATCH)" t nil) - -(register-definition-prefixes "consult-org" '("consult-org--")) - -;;;*** - -;;;### (autoloads nil "consult-register" "consult-register.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from consult-register.el - -(autoload 'consult-register-window "consult-register" "\ -Enhanced drop-in replacement for `register-preview'. - -BUFFER is the window buffer. -SHOW-EMPTY must be t if the window should be shown for an empty register list. - -\(fn BUFFER &optional SHOW-EMPTY)" nil nil) - -(autoload 'consult-register-format "consult-register" "\ -Enhanced preview of register REG. -This function can be used as `register-preview-function'. -If COMPLETION is non-nil format the register for completion. - -\(fn REG &optional COMPLETION)" nil nil) - -(autoload 'consult-register "consult-register" "\ -Load register and either jump to location or insert the stored text. - -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 -`jump-to-register' and `insert-register' for the meaning of prefix ARG. - -\(fn &optional ARG)" t nil) - -(autoload 'consult-register-load "consult-register" "\ -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 the meaning of prefix ARG. - -\(fn REG &optional ARG)" t nil) - -(autoload 'consult-register-store "consult-register" "\ -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 -kmacro. - -\(fn ARG)" t nil) - -(register-definition-prefixes "consult-register" '("consult-register-")) - -;;;*** - -;;;### (autoloads nil "consult-selectrum" "consult-selectrum.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from consult-selectrum.el - -(register-definition-prefixes "consult-selectrum" '("consult-selectrum--")) - -;;;*** - -;;;### (autoloads nil "consult-vertico" "consult-vertico.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from consult-vertico.el - -(register-definition-prefixes "consult-vertico" '("consult-vertico--")) - -;;;*** - -;;;### (autoloads nil "consult-xref" "consult-xref.el" (0 0 0 0)) -;;; Generated autoloads from consult-xref.el - -(autoload 'consult-xref "consult-xref" "\ -Show xrefs with preview in the minibuffer. - -This function can be used for `xref-show-xrefs-function'. -See `xref-show-xrefs-function' for the description of the -FETCHER and ALIST arguments. - -\(fn FETCHER &optional ALIST)" nil nil) - -(register-definition-prefixes "consult-xref" '("consult-xref--")) - -;;;*** - -;;;### (autoloads nil nil ("consult-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; consult-autoloads.el ends here diff --git a/elpa/consult-0.17/consult-compile.el b/elpa/consult-0.17/consult-compile.el @@ -1,128 +0,0 @@ -;;; consult-compile.el --- Provides the command `consult-compile-error' -*- 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; 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: - -(require 'consult) -(require 'compile) - -(defvar consult-compile--history nil) - -(defconst consult-compile--narrow - '((?e . "Error") - (?w . "Warning") - (?i . "Info"))) - -(defun consult-compile--font-lock (str) - "Apply `font-lock' faces in STR, copy them to `face'." - (let ((pos 0) (len (length str))) - (while (< pos len) - (let* ((face (get-text-property pos 'font-lock-face str)) - (end (or (text-property-not-all pos len 'font-lock-face face str) len))) - (put-text-property pos end 'face face str) - (setq pos end))) - str)) - -(defun consult-compile--error-candidates (buffer) - "Return alist of errors and positions in BUFFER, a compilation buffer." - (with-current-buffer buffer - (let ((candidates) - (pos (point-min))) - (save-excursion - (while (setq pos (compilation-next-single-property-change pos 'compilation-message)) - (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--type (pcase (compilation--message->type msg) - (0 ?i) - (1 ?w) - (_ ?e)) - 'consult--candidate (point-marker)) - candidates)))) - (nreverse candidates)))) - -(defun consult-compile--lookup (marker) - "Lookup error position given error MARKER." - (when-let (buffer (and marker (marker-buffer marker))) - (with-current-buffer buffer - (let ((next-error-highlight nil) - (compilation-current-error marker) - (overlay-arrow-position overlay-arrow-position)) - (ignore-errors - (save-window-excursion - (compilation-next-error-function 0) - (point-marker))))))) - -(defun consult-compile--compilation-buffers (file) - "Return a list of compilation buffers relevant to FILE." - (consult--buffer-query - :sort 'alpha :predicate - (lambda (buffer) - (with-current-buffer buffer - (and (compilation-buffer-internal-p) - (file-in-directory-p file default-directory)))))) - -(defun consult-compile--state () - "Like `consult--jump-state', also setting the current compilation error." - (let ((state (consult--jump-state 'consult-preview-error))) - (lambda (action marker) - (let ((pos (consult-compile--lookup marker))) - (when-let (buffer (and (eq action 'return) - marker - (marker-buffer marker))) - (with-current-buffer buffer - (setq compilation-current-error marker - overlay-arrow-position marker))) - (funcall state action pos))))) - -;;;###autoload -(defun consult-compile-error () - "Jump to a compilation error in the current buffer. - -This command collects entries from compilation buffers and grep -buffers related to the current buffer. The command supports -preview of the currently selected error." - (interactive) - (consult--read - (consult--with-increased-gc - (or (mapcan #'consult-compile--error-candidates - (or (consult-compile--compilation-buffers - default-directory) - (user-error "No compilation buffers found for the current buffer"))) - (user-error "No compilation errors found"))) - :prompt "Go to error: " - :category 'consult-compile-error - :sort nil - :require-match t - :history t ;; disable history - :lookup #'consult--lookup-candidate - :group (consult--type-group consult-compile--narrow) - :narrow (consult--type-narrow consult-compile--narrow) - :history '(:input consult-compile--history) - :state (consult-compile--state))) - -(provide 'consult-compile) -;;; consult-compile.el ends here diff --git a/elpa/consult-0.17/consult-flymake.el b/elpa/consult-0.17/consult-flymake.el @@ -1,100 +0,0 @@ -;;; consult-flymake.el --- Provides the command `consult-flymake' -*- 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides the command `consult-flymake'. This is an extra package, -;; to allow lazy loading of flymake.el. The `consult-flymake' command -;; is autoloaded. - -;;; Code: - -(require 'consult) -(require 'flymake) - -(defconst consult-flymake--narrow - '((?e . "Error") - (?w . "Warning") - (?n . "Note"))) - -(defun consult-flymake--candidates () - "Return Flymake errors as alist." - (consult--forbid-minibuffer) - (let* ((raw-diags (or (flymake-diagnostics) - (user-error "No flymake errors (Status: %s)" - (if (seq-difference (flymake-running-backends) - (flymake-reporting-backends)) - 'running 'finished)))) - (diags - (mapcar - (lambda (diag) - (let ((buffer (flymake-diagnostic-buffer diag)) - (type (flymake-diagnostic-type diag))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char (flymake-diagnostic-beg diag)) - (list (buffer-name buffer) - (line-number-at-pos) - type - (flymake-diagnostic-text diag) - (point-marker) - (pcase (flymake--lookup-type-property type 'flymake-category) - ('flymake-error ?e) - ('flymake-warning ?w) - (_ ?n)))))))) - raw-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))) - (mapcar - (pcase-lambda (`(,buffer ,line ,type ,text ,marker ,narrow)) - (propertize (format fmt buffer line - (propertize (format "%s" (flymake--lookup-type-property - type 'flymake-type-name type)) - 'face (flymake--lookup-type-property - type 'mode-line-face 'flymake-error)) - text) - 'consult--candidate marker - 'consult--type narrow)) - (sort diags - (pcase-lambda (`(_ _ ,t1 _ ,m1 _) `(_ _ ,t2 _ ,m2 _)) - (let ((s1 (flymake--severity t1)) - (s2 (flymake--severity t2))) - (or (> s1 s2) (and (= s1 s2) (< m1 m2))))))))) - -;;;###autoload -(defun consult-flymake () - "Jump to Flymake diagnostic." - (interactive) - (consult--read - (consult--with-increased-gc (consult-flymake--candidates)) - :prompt "Flymake diagnostic: " - :category 'consult-flymake-error - :history t ;; disable history - :require-match t - :sort nil - :group (consult--type-group consult-flymake--narrow) - :narrow (consult--type-narrow consult-flymake--narrow) - :lookup #'consult--lookup-candidate - :state (consult--jump-state 'consult-preview-error))) - -(provide 'consult-flymake) -;;; consult-flymake.el ends here diff --git a/elpa/consult-0.17/consult-imenu.el b/elpa/consult-0.17/consult-imenu.el @@ -1,234 +0,0 @@ -;;; consult-imenu.el --- Consult commands for imenu -*- 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides imenu-related Consult commands. - -;;; Code: - -(require 'consult) -(require 'imenu) - -(defcustom consult-imenu-config - '((emacs-lisp-mode :toplevel "Functions" - :types ((?f "Functions" font-lock-function-name-face) - (?m "Macros" font-lock-function-name-face) - (?p "Packages" font-lock-constant-face) - (?t "Types" font-lock-type-face) - (?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." - :type '(repeat (cons symbol plist)) - :group 'consult) - -(defface consult-imenu-prefix - '((t :inherit consult-key)) - "Face used to highlight imenu prefix in `consult-imenu'." - :group 'consult-faces) - -(defvar consult-imenu--history nil) -(defvar-local consult-imenu--cache nil) - -(defun consult-imenu--special (_name pos buf name fn &rest args) - "Wrapper function for special imenu items. - -POS is the position. -BUF is the buffer. -NAME is the item name. -FN is the original special item function. -ARGS are the arguments to the special item function." - (funcall consult--buffer-display buf) - (apply fn name pos args)) - -(defun consult-imenu--flatten (prefix face list types) - "Flatten imenu LIST. - -PREFIX is prepended in front of all items. -FACE is the item face. -TYPES is the mode-specific types configuration." - (mapcan - (lambda (item) - (if (imenu--subalist-p item) - (let ((name (car item)) - (next-prefix prefix) - (next-face face)) - (if prefix - (setq next-prefix (concat prefix "/" (propertize name 'face 'consult-imenu-prefix))) - (if-let (type (cdr (assoc name types))) - (setq next-prefix (propertize name - 'face 'consult-imenu-prefix - 'consult--type (car type)) - next-face (cadr type)) - (setq next-prefix (propertize name 'face 'consult-imenu-prefix)))) - (consult-imenu--flatten next-prefix next-face (cdr item) types)) - (let* ((name (car item)) - (key (if prefix (concat prefix " " (propertize name 'face face)) name)) - (payload (cdr item))) - (list (cons key - (pcase payload - ;; Simple marker item - ((pred markerp) payload) - ;; Simple integer item - ((pred integerp) (copy-marker payload)) - ;; Semantic uses overlay for positions - ((pred overlayp) (copy-marker (overlay-start payload))) - ;; Wrap special item - (`(,pos ,fn . ,args) - (nconc - (list pos #'consult-imenu--special (current-buffer) name fn) - args)) - (_ (error "Unknown imenu item: %S" item)))))))) - list)) - -(defun consult-imenu--compute () - "Compute imenu candidates." - (consult--forbid-minibuffer) - (let* ((imenu-use-markers t) - ;; Generate imenu, see `imenu--make-index-alist'. - (items (imenu--truncate-items - (save-excursion - (save-restriction - (widen) - (funcall imenu-create-index-function))))) - (config (cdr (seq-find (lambda (x) (derived-mode-p (car x))) consult-imenu-config)))) - ;; Fix toplevel items, e.g., emacs-lisp-mode toplevel items are functions - (when-let (toplevel (plist-get config :toplevel)) - (let ((tops (seq-remove (lambda (x) (listp (cdr x))) items)) - (rest (seq-filter (lambda (x) (listp (cdr x))) items))) - (setq items (nconc rest (and tops (list (cons toplevel tops))))))) - ;; Apply our flattening in order to ease searching the imenu. - (consult-imenu--flatten - nil nil items - (mapcar (pcase-lambda (`(,x ,y ,z)) (list y x z)) - (plist-get config :types))))) - -(defun consult-imenu--deduplicate (items) - "Deduplicate imenu ITEMS by appending a counter." - ;; Some imenu backends generate duplicate items (e.g. for overloaded methods in java) - (let ((ht (make-hash-table :test #'equal :size (length items)))) - (dolist (item items) - (if-let (count (gethash (car item) ht)) - (setcar item (format "%s (%s)" (car item) - (puthash (car item) (1+ count) ht))) - (puthash (car item) 0 ht))))) - -(defun consult-imenu--items () - "Return cached imenu candidates, may error." - (unless (equal (car consult-imenu--cache) (buffer-modified-tick)) - (setq consult-imenu--cache (cons (buffer-modified-tick) (consult-imenu--compute)))) - (cdr consult-imenu--cache)) - -(defun consult-imenu--items-safe () - "Return cached imenu candidates, will not error." - (condition-case err - (consult-imenu--items) - (t (message "Cannot create Imenu for buffer %s (%s)" - (buffer-name) (error-message-string err)) - nil))) - -(defun consult-imenu--multi-items (buffers) - "Return all imenu items from BUFFERS." - (apply #'append (consult--buffer-map buffers #'consult-imenu--items-safe))) - -(defun consult-imenu--jump (item) - "Jump to imenu ITEM via `consult--jump'. - -In contrast to the builtin `imenu' jump function, -this function can jump across buffers." - (pcase item - (`(,name ,pos ,fn . ,args) (apply fn name pos args)) - (`(,_ . ,pos) (consult--jump pos)) - (_ (error "Unknown imenu item: %S" item)))) - -(defun consult-imenu--select (prompt items) - "Select from imenu ITEMS given PROMPT string." - (let ((narrow - (mapcar (lambda (x) (cons (car x) (cadr x))) - (plist-get (cdr (seq-find (lambda (x) (derived-mode-p (car x))) - consult-imenu-config)) - :types)))) - (consult-imenu--deduplicate items) - (consult-imenu--jump - (consult--read - (or items (user-error "Imenu is empty")) - :prompt prompt - :state - (let ((preview (consult--jump-preview))) - (lambda (action cand) - ;; Only preview simple menu items which are markers, - ;; in order to avoid any bad side effects. - (funcall preview action (and (markerp (cdr cand)) (cdr cand))))) - :require-match t - :group - (when narrow - (lambda (cand transform) - (let ((type (get-text-property 0 'consult--type cand))) - (cond - ((and transform type) - (substring cand (1+ (next-single-property-change 0 'consult--type cand)))) - (transform cand) - (type (alist-get type narrow)))))) - :narrow - (when narrow - (list :predicate - (lambda (cand) - (eq (get-text-property 0 'consult--type (car cand)) consult--narrow)) - :keys narrow)) - :category 'imenu - :lookup #'consult--lookup-cons - :history 'consult-imenu--history - :add-history (thing-at-point 'symbol) - :sort nil)))) - -;;;###autoload -(defun consult-imenu () - "Select item from flattened `imenu' using `completing-read' with preview. - -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))) - -;;;###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, -QUERY can be set to a plist according to `consult--buffer-query'." - (interactive "P") - (unless (keywordp (car-safe query)) - (setq query (list :sort 'alpha :mode major-mode - :directory (and (not query) 'project)))) - (let ((buffers (consult--buffer-query-prompt "Go to item" query))) - (consult-imenu--select (car buffers) - (consult-imenu--multi-items (cdr buffers))))) - -(provide 'consult-imenu) -;;; consult-imenu.el ends here diff --git a/elpa/consult-0.17/consult-org.el b/elpa/consult-0.17/consult-org.el @@ -1,124 +0,0 @@ -;;; consult-org.el --- Consult commands for org-mode -*- 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides a `completing-read' interface for Org mode navigation. -;; This is an extra package, to allow lazy loading of Org. - -;;; Code: - -(require 'consult) -(require 'org) - -(defvar consult-org--history nil) - -(defun consult-org--narrow () - "Narrowing configuration for `consult-org' commands." - (let ((todo-kws - (seq-filter - (lambda (x) (<= ?a (car x) ?z)) - (mapcar (lambda (s) - (pcase-let ((`(,a ,b) (split-string s "("))) - (cons (downcase (string-to-char (or b a))) a))) - (apply #'append (mapcar #'cdr org-todo-keywords)))))) - (list :predicate - (lambda (cand) - (pcase-let ((`(,level ,todo . ,prio) - (get-text-property 0 'consult-org--heading cand))) - (cond - ((<= ?1 consult--narrow ?9) (<= level (- consult--narrow ?0))) - ((<= ?A consult--narrow ?Z) (eq prio consult--narrow)) - (t (equal todo (alist-get consult--narrow todo-kws)))))) - :keys - (nconc (mapcar (lambda (c) (cons c (format "Level %c" c))) - (number-sequence ?1 ?9)) - (mapcar (lambda (c) (cons c (format "Priority %c" c))) - (number-sequence (max ?A org-highest-priority) - (min ?Z org-lowest-priority))) - todo-kws)))) - -(defun consult-org--headings (prefix match scope &rest skip) - "Return a list of Org heading candidates. - -If PREFIX is non-nil, prefix the candidates with the buffer name. -MATCH, SCOPE and SKIP are as in `org-map-entries'." - (let (buffer) - (apply - #'org-map-entries - (lambda () - ;; Reset the cache when the buffer changes, since `org-get-outline-path' uses the cache - (unless (eq buffer (buffer-name)) - (setq buffer (buffer-name) - org-outline-path-cache nil)) - (pcase-let ((`(_ ,level ,todo ,prio . _) (org-heading-components)) - (cand (org-format-outline-path - (org-get-outline-path 'with-self 'use-cache) - most-positive-fixnum))) - (setq cand (if prefix - (concat buffer " " cand (consult--tofu-encode (point))) - (concat cand (consult--tofu-encode (point))))) - (add-text-properties 0 1 - `(consult--candidate ,(point-marker) - consult-org--heading (,level ,todo . ,prio)) - cand) - cand)) - match scope skip))) - -;;;###autoload -(defun consult-org-heading (&optional match scope) - "Jump to an Org heading. - -MATCH and SCOPE are as in `org-map-entries' and determine which -entries are offered. By default, all entries of the current -buffer are offered." - (interactive (unless (derived-mode-p 'org-mode) - (user-error "Must be called from an Org buffer"))) - (let ((prefix (not (memq scope '(nil tree region region-start-level file))))) - (consult--read - (consult--with-increased-gc (consult-org--headings prefix match scope)) - :prompt "Go to heading: " - :category 'consult-org-heading - :sort nil - :require-match t - :history '(:input consult-org--history) - :narrow (consult-org--narrow) - :state (consult--jump-state) - :group - (when prefix - (lambda (cand transform) - (let ((name (buffer-name - (marker-buffer - (get-text-property 0 'consult--candidate cand))))) - (if transform (substring cand (1+ (length name))) name)))) - :lookup #'consult--lookup-candidate))) - -;;;###autoload -(defun consult-org-agenda (&optional match) - "Jump to an Org agenda heading. - -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 - (user-error "No agenda files")) - (consult-org-heading match 'agenda)) - -(provide 'consult-org) -;;; consult-org.el ends here diff --git a/elpa/consult-0.17/consult-pkg.el b/elpa/consult-0.17/consult-pkg.el @@ -1,10 +0,0 @@ -(define-package "consult" "0.17" "Consulting completing-read" - '((emacs "27.1")) - :commit "f517b70dd8a3be0b8c883633f2a7721448b40f0f" :authors - '(("Daniel Mendler and Consult contributors")) - :maintainer - '("Daniel Mendler" . "mail@daniel-mendler.de") - :url "https://github.com/minad/consult") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/consult-0.17/consult-register.el b/elpa/consult-0.17/consult-register.el @@ -1,315 +0,0 @@ -;;; consult-register.el --- Consult commands for registers -*- 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides register-related Consult commands. - -;;; Code: - -(require 'consult) - -(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) - -(defvar consult-register--narrow - '((?n . "Number") - (?s . "String") - (?p . "Point") - (?r . "Rectangle") - (?t . "Frameset") - (?k . "Kmacro") - (?f . "File") - (?w . "Window")) - "Register type names. -Each element of the list must have the form '(char . name).") - -(cl-defun consult-register--format-value (val) - "Format generic register VAL as string." - (with-output-to-string (register-val-describe val nil))) - -(cl-defgeneric consult-register--describe (val) - "Describe generic register VAL." - (list (consult-register--format-value val))) - -(cl-defmethod consult-register--describe ((val number)) - "Describe numeric register VAL." - (list (consult-register--format-value val) 'consult--type ?n)) - -(cl-defmethod consult-register--describe ((val string)) - "Describe string register VAL." - (list val 'consult--type - (if (eq (car (get-text-property 0 'yank-handler val)) - 'rectangle--insert-for-yank) - ?r ?s))) - -(cl-defmethod consult-register--describe ((val marker)) - "Describe marker register VAL." - (with-current-buffer (marker-buffer val) - (save-restriction - (save-excursion - (widen) - (goto-char val) - (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) - 'multi-category `(consult-location . ,str) - 'consult--type ?p)))))) - -(cl-defmethod consult-register--describe ((val kmacro-register)) - "Describe kmacro register VAL." - (list (consult-register--format-value val) 'consult--type ?k)) - -(cl-defmethod consult-register--describe ((val (head file))) - "Describe file register VAL." - (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 file-query))) - "Describe file-query register VAL." - (list (format "%s at position %d" - (propertize (abbreviate-file-name (cadr val)) - 'face 'consult-file) - (caddr val)) - 'consult--type ?f 'multi-category `(file . ,(cadr val)))) - -(cl-defmethod consult-register--describe ((val cons)) - "Describe rectangle or window-configuration register VAL." - (cond - ((stringp (car val)) - (list (string-join val "\n") 'consult--type ?r)) - ((window-configuration-p (car val)) - (list (consult-register--format-value val) - 'consult--type ?w)) - (t (list (consult-register--format-value val))))) - -(with-eval-after-load 'frameset - (cl-defmethod consult-register--describe ((val frameset-register)) - "Describe frameset register VAL." - (list (consult-register--format-value val) 'consult--type ?t))) - -;;;###autoload -(defun consult-register-window (buffer &optional show-empty) - "Enhanced drop-in replacement for `register-preview'. - -BUFFER is the window buffer. -SHOW-EMPTY must be t if the window should be shown for an empty register list." - (let ((regs (consult-register--alist 'noerror)) - (separator - (and (display-graphic-p) - (propertize #(" \n" 0 1 (display (space :align-to right))) - 'face '(:inherit consult-separator :height 1 :underline t))))) - (when (or show-empty regs) - (with-current-buffer-window buffer - (cons 'display-buffer-at-bottom - '((window-height . fit-window-to-buffer) - (preserve-size . (nil . t)))) - nil - (setq-local cursor-in-non-selected-windows nil - mode-line-format nil - truncate-lines t - window-min-height 1 - window-resize-pixelwise t) - (insert (mapconcat - (lambda (reg) - (concat (funcall register-preview-function reg) separator)) - regs nil)))))) - -;;;###autoload -(defun consult-register-format (reg &optional completion) - "Enhanced preview of register REG. -This function can be used as `register-preview-function'. -If COMPLETION is non-nil format the register for completion." - (pcase-let* ((`(,key . ,val) reg) - (key-str (propertize (single-key-description key) 'face 'consult-key)) - (key-len (max 3 (length key-str))) - (`(,str . ,props) (consult-register--describe val))) - (when (string-match-p "\n" str) - (let* ((lines (seq-take (seq-remove #'string-blank-p (split-string str "\n")) 3)) - (space (apply #'min most-positive-fixnum - (mapcar (lambda (x) (string-match-p "[^ ]" x)) lines)))) - (setq str (mapconcat (lambda (x) (substring x space)) - lines (concat "\n" (make-string (1+ key-len) ?\s)))))) - (setq str (concat - (and completion consult-register-prefix) - key-str (make-string (- key-len (length key-str)) ?\s) " " - str (and (not completion) "\n"))) - (when completion - (add-text-properties - 0 (length str) - `(consult--candidate ,(car reg) ,@props) - str)) - str)) - -(defun consult-register--alist (&optional noerror) - "Return sorted register list. -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) - (and (not noerror) (user-error "All registers are empty")))) - -;;;###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 -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 -`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)) - :prompt "Register: " - :category 'multi-category - :state - (let ((preview (consult--jump-preview))) - (lambda (action cand) - ;; Preview only markers - (funcall preview action - (when-let (reg (get-register cand)) - (and (markerp reg) reg))))) - :group (consult--type-group consult-register--narrow) - :narrow (consult--type-narrow consult-register--narrow) - :sort nil - :require-match t - :history t ;; disable history - :lookup #'consult--lookup-candidate) - arg)) - -;;;###autoload -(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 the meaning of prefix ARG." - (interactive - (list - (and (consult-register--alist) - (register-read-with-preview "Load register: ")) - current-prefix-arg)) - (condition-case err - (jump-to-register reg arg) - (user-error - (unless (string-match-p - "access aborted" - (error-message-string err) ) - (insert-register reg (not arg)))))) - -(defun consult-register--action (action-list) - "Read register key and execute action from ACTION-LIST. - -This function is derived from `register-read-with-preview'." - (let* ((buffer "*Register Preview*") - (prefix (car action-list)) - (action-list (cdr action-list)) - (action (car (nth 0 action-list))) - (preview - (lambda () - (unless (get-buffer-window buffer) - (register-preview buffer 'show-empty) - (when-let (win (get-buffer-window buffer)) - (with-selected-window win - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (insert - (propertize (concat prefix ": ") 'face 'consult-help) - (mapconcat - (lambda (x) - (concat (propertize (format "M-%c" (car x)) 'face 'consult-key) - " " (propertize (cadr x) 'face 'consult-help))) - action-list " ")) - (fit-window-to-buffer))))))) - (timer (when (numberp register-preview-delay) - (run-at-time register-preview-delay nil preview))) - (help-chars (seq-remove #'get-register (cons help-char help-event-list))) - key reg) - (unwind-protect - (while (not reg) - (while (memq (setq key - (read-key (propertize (caddr (assq action action-list)) - 'face 'minibuffer-prompt))) - help-chars) - (funcall preview)) - (setq key (if (and (eql key ?\e) (characterp last-input-event)) - ;; in terminal Emacs M-letter is read as two keys, ESC and the letter, - ;; use what would have been read in graphical Emacs - (logior #x8000000 last-input-event) - last-input-event)) - (cond - ((or (eq ?\C-g key) - (eq 'escape key) - (eq ?\C-\[ key)) - (keyboard-quit)) - ((and (numberp key) (assq (logxor #x8000000 key) action-list)) - (setq action (logxor #x8000000 key))) - ((characterp key) - (setq reg key)) - (t (error "Non-character input")))) - (when (timerp timer) - (cancel-timer timer)) - (let ((w (get-buffer-window buffer))) - (when (window-live-p w) - (delete-window w))) - (when (get-buffer buffer) - (kill-buffer buffer))) - (when reg - (funcall (cadddr (assq action action-list)) reg)))) - -;;;###autoload -(defun consult-register-store (arg) - "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 -kmacro." - (interactive "P") - (consult-register--action - (cond - ((use-region-p) - (let ((beg (region-beginning)) - (end (region-end))) - `("Region" - (?c "copy" "Copy region to register: " ,(lambda (r) (copy-to-register r beg end arg t))) - (?a "append" "Append region to register: " ,(lambda (r) (append-to-register r beg end arg))) - (?p "prepend" "Prepend region to register: " ,(lambda (r) (prepend-to-register r beg end arg)))))) - ((numberp arg) - `(,(format "Number %s" arg) - (?s "store" ,(format "Store %s in register: " arg) ,(lambda (r) (number-to-register arg r))) - (?a "add" ,(format "Add %s to register: " arg) ,(lambda (r) (increment-register arg r))))) - (t - `("Store" - (?p "point" "Point to register: " ,#'point-to-register) - (?f "file" "File to register: " ,(lambda (r) (set-register r `(file . ,(buffer-file-name))))) - (?t "frameset" "Frameset to register: " ,#'frameset-to-register) - (?w "window" "Window to register: " ,#'window-configuration-to-register) - ,@(and last-kbd-macro `((?k "kmacro" "Kmacro to register: " ,#'kmacro-to-register)))))))) - -(provide 'consult-register) -;;; consult-register.el ends here diff --git a/elpa/consult-0.17/consult-selectrum.el b/elpa/consult-0.17/consult-selectrum.el @@ -1,105 +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 <http://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 (cadr (funcall split str 0)) 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--crm-adv (&rest args) - "Setup crm for Selectrum given ARGS." - (consult--minibuffer-with-setup-hook - (lambda () - (when selectrum-is-active - (setq-local selectrum-default-value-format nil))) - (apply args))) - -(add-hook 'consult--completion-candidate-hook #'consult-selectrum--candidate) -(add-hook 'consult--completion-refresh-hook #'consult-selectrum--refresh) -(advice-add #'consult-completing-read-multiple :around #'consult-selectrum--crm-adv) -(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) - -(provide 'consult-selectrum) -;;; consult-selectrum.el ends here diff --git a/elpa/consult-0.17/consult-xref.el b/elpa/consult-0.17/consult-xref.el @@ -1,119 +0,0 @@ -;;; consult-xref.el --- Xref 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides Xref integration for Consult. This is an extra package, to -;; allow lazy loading of xref.el. The `consult-xref' function is -;; autoloaded. - -;;; Code: - -(require 'consult) -(require 'xref) - -(defvar consult-xref--history nil) - -(defun consult-xref--candidates (xrefs) - "Return candidate list from XREFS." - (let ((root (consult--project-root))) - (mapcar (lambda (xref) - (let* ((loc (xref-item-location xref)) - (group (if (fboundp 'xref--group-name-for-display) - ;; This function is available in xref 1.3.2 - (xref--group-name-for-display - (xref-location-group loc) root) - (xref-location-group loc))) - (cand (consult--format-location - group - (or (xref-location-line loc) 0) - (xref-item-summary xref)))) - (add-text-properties - 0 1 `(consult--candidate ,xref consult-xref--group ,group) cand) - cand)) - xrefs))) - -(defun consult-xref--preview (display) - "Xref preview with DISPLAY function." - (let ((open (consult--temporary-files)) - (preview (consult--jump-preview))) - (lambda (action cand) - (unless cand - (funcall open)) - (let ((consult--buffer-display display)) - (funcall preview action - (when-let (loc (and cand (eq action 'preview) - (xref-item-location cand))) - ;; Only preview file and buffer markers - (cl-typecase loc - (xref-buffer-location - (xref-location-marker loc)) - (xref-file-location - (consult--position-marker - (funcall open - ;; xref-location-group returns the file name - (let ((xref-file-name-display 'abs)) - (xref-location-group loc))) - (xref-location-line loc) - (xref-file-location-column loc))) - (t (message "No preview for %s" (type-of loc)) nil)))))))) - -(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. - -This function can be used for `xref-show-xrefs-function'. -See `xref-show-xrefs-function' for the description of the -FETCHER and ALIST arguments." - (let ((candidates (consult--with-increased-gc - (consult-xref--candidates (funcall fetcher)))) - (display (alist-get 'display-action alist))) - (xref-pop-to-location - (if (cdr candidates) - (apply - #'consult--read - candidates - (append - (consult--customize-get #'consult-xref) - (list - :prompt "Go to xref: " - :history 'consult-xref--history - :require-match t - :sort nil - :category 'xref-location - :group #'consult-xref--group - :state - ;; do not preview other frame - (when-let (fun (pcase-exhaustive display - ('frame nil) - ('window #'switch-to-buffer-other-window) - ('nil #'switch-to-buffer))) - (consult-xref--preview fun)) - :lookup #'consult--lookup-candidate))) - (get-text-property 0 'consult--candidate (car candidates))) - display))) - -(provide 'consult-xref) -;;; consult-xref.el ends here diff --git a/elpa/consult-0.17/consult.el b/elpa/consult-0.17/consult.el @@ -1,4878 +0,0 @@ -;;; consult.el --- Consulting completing-read -*- lexical-binding: t -*- - -;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. - -;; Author: Daniel Mendler and Consult contributors -;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> -;; Created: 2020 -;; Version: 0.17 -;; Package-Requires: ((emacs "27.1")) -;; Homepage: https://github.com/minad/consult - -;; 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 <http://www.gnu.org/licenses/>. - -;;; 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. - -;; The Consult commands are compatible with completion systems based -;; on the Emacs `completing-read' API, including the default completion -;; system, Vertico, Mct, Icomplete and Selectrum. - -;; Consult has been inspired by Counsel. Some of the Consult commands -;; originated in the Counsel package or the Selectrum wiki. See the -;; README for a full list of contributors. - -;;; Code: - -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) -(require 'bookmark) -(require 'kmacro) -(require 'recentf) -(require 'seq) - -(defgroup consult nil - "Consulting `completing-read'." - :group 'convenience - :group 'minibuffer - :prefix "consult-") - -;;;; Customization - -(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))) - -(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))) - -(defcustom consult-project-function - #'consult--default-project-function - "Function which returns project root directory. -The function takes one boolargument MAY-PROMPT. If MAY-PROMPT is non-nil, -the function may ask the prompt the user for a project directory. -The root directory is used by `consult-buffer' and `consult-grep'." - :type '(choice function (const nil))) - -(defcustom consult-async-refresh-delay 0.2 - "Refreshing delay of the completion ui for asynchronous commands. - -The completion ui is only updated every `consult-async-refresh-delay' -seconds. This applies to asynchronous commands like for example -`consult-grep'." - :type 'float) - -(defcustom consult-async-input-throttle 0.4 - "Input throttle for asynchronous commands. - -The asynchronous process is started only every -`consult-async-input-throttle' seconds. This applies to asynchronous -commands, e.g., `consult-grep'." - :type 'float) - -(defcustom consult-async-input-debounce 0.2 - "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 -asynchronous commands, e.g., `consult-grep'." - :type 'float) - -(defcustom consult-async-min-input 3 - "Minimum number of letters needed, before asynchronous process is called. - -This applies to asynchronous commands, e.g., `consult-grep'." - :type 'integer) - -(defcustom consult-async-split-style 'perl - "Async splitting style, see `consult-async-split-styles-alist'." - :type '(choice (const :tag "No splitting" nil) - (const :tag "Comma" comma) - (const :tag "Semicolon" semicolon) - (const :tag "Perl" perl))) - -(defcustom consult-async-split-styles-alist - '((nil :type nil) - (comma :separator ?, :type separator) - (semicolon :separator ?\; :type separator) - (perl :initial "#" :type perl)) - "Async splitting styles." - :type '(alist :key-type symbol :value-type plist)) - -(defcustom consult-mode-histories - '((eshell-mode . eshell-history-ring) - (comint-mode . comint-input-ring) - (term-mode . term-input-ring)) - "Alist of (mode . history) pairs of mode histories. -The histories can be rings or lists." - :type '(alist :key-type symbol :value-type symbol)) - -(defcustom consult-themes nil - "List of themes to be presented for selection. -nil shows all `custom-available-themes'." - :type '(repeat symbol)) - -(defcustom consult-after-jump-hook '(recenter) - "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 -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 -after selection." - :type 'hook) - -(defcustom consult-line-start-from-top nil - "Start search from the top if non-nil. -Otherwise start the search at the current line and wrap around." - :type 'boolean) - -(defcustom consult-line-point-placement 'match-beginning - "Where to leave point after `consult-line' jumps to a match." - :type '(choice (const :tag "Beginning of the line" line-beginning) - (const :tag "Beginning of the match" match-beginning) - (const :tag "End of the match" match-end))) - -(defcustom consult-line-numbers-widen t - "Show absolute line numbers when narrowing is active. - -See also `display-line-numbers-widen'." - :type 'boolean) - -(defcustom consult-goto-line-numbers t - "Show line numbers for `consult-goto-line'." - :type 'boolean) - -(defcustom consult-fontify-preserve t - "Preserve fontification for line-based commands." - :type 'boolean) - -(defcustom consult-fontify-max-size 1048576 - "Buffers larger than this byte limit are not fontified. - -This is necessary in order to prevent a large startup time -for navigation commands like `consult-line'." - :type 'integer) - -(defvar consult-recent-file-filter nil) -(make-obsolete-variable 'consult-recent-file-filter - "Deprecated in favor of `recentf-exclude'." "0.16") - -(defcustom consult-buffer-filter - '("\\` " - "\\`\\*Completions\\*\\'" - "\\`\\*Flymake log\\*\\'" - "\\`\\*Semantic SymRef\\*\\'" - "\\`\\*tramp/.*\\*\\'") - "Filter regexps for `consult-buffer'. - -The default setting is to filter ephemeral buffer names beginning with a space -character, the *Completions* buffer and a few log buffers." - :type '(repeat regexp)) - -(defcustom consult-buffer-sources - '(consult--source-hidden-buffer - consult--source-buffer - consult--source-recent-file - consult--source-bookmark - consult--source-project-buffer - consult--source-project-recent-file) - "Sources used by `consult-buffer'. -See also `consult-project-buffer-sources'. -See `consult--multi' for a description of the source data structure." - :type '(repeat symbol)) - -(defcustom consult-project-buffer-sources nil - "Sources used by `consult-project-buffer'. -See also `consult-buffer-sources'. -See `consult--multi' for a description of the source data structure." - :type '(repeat symbol)) - -(defcustom consult-mode-command-filter - '(;; Filter commands - "-mode\\'" "--" - ;; Filter whole features - simple mwheel time so-long recentf) - "Filter commands for `consult-mode-command'." - :type '(repeat (choice symbol regexp))) - -(defcustom consult-grep-max-columns 300 - "Maximal number of columns of grep output." - :type 'integer) - -(defconst consult--grep-match-regexp - "\\`\\(?:\\./\\)?\\([^\n\0]+\\)\0\\([0-9]+\\)\\([-:\0]\\)" - "Regexp used to match file and line of grep output.") - -(defcustom consult-grep-args - "grep --null --line-buffered --color=never --ignore-case\ - --exclude-dir=.git --line-number -I -r ." - "Command line arguments for grep, see `consult-grep'. -The dynamically computed arguments are appended." - :type 'string) - -(defcustom consult-git-grep-args - "git --no-pager grep --null --color=never --ignore-case\ - --extended-regexp --line-number -I" - "Command line arguments for git-grep, see `consult-git-grep'. -The dynamically computed arguments are appended." - :type 'string) - -(defcustom consult-ripgrep-args - "rg --null --line-buffered --color=never --max-columns=1000 --path-separator /\ - --smart-case --no-heading --line-number ." - "Command line arguments for ripgrep, see `consult-ripgrep'. -The dynamically computed arguments are appended." - :type 'string) - -(defcustom consult-find-args - "find . -not ( -wholename */.* -prune )" - "Command line arguments for find, see `consult-find'. -The dynamically computed arguments are appended." - :type 'string) - -(defcustom consult-locate-args - "locate --ignore-case --existing" - "Command line arguments for locate, see `consult-locate'. -The dynamically computed arguments are appended." - :type 'string) - -(defcustom consult-man-args - "man -k" - "Command line arguments for man, see `consult-man'. -The dynamically computed arguments are appended." - :type 'string) - -(defcustom consult-preview-key 'any - "Preview trigger keys, can be nil, 'any, a single key or a list of keys." - :type '(choice (const :tag "Any key" 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))) - -(defcustom consult-preview-max-size 10485760 - "Files larger than this byte limit are not previewed." - :type 'integer) - -(defcustom consult-preview-raw-size 524288 - "Files larger than this byte limit are previewed in raw form." - :type 'integer) - -(defcustom consult-preview-max-count 10 - "Number of files to keep open at once during preview." - :type 'integer) - -(defvar consult-preview-excluded-hooks nil) -(make-obsolete-variable 'consult-preview-excluded-hooks - "Deprecated in favor of `consult-preview-allowed-hooks'." "0.16") - -(defcustom consult-preview-allowed-hooks - '(global-font-lock-mode-check-buffers - save-place-find-file-hook) - "List of `find-file' hooks, which should be executed during file preview." - :type '(repeat symbol)) - -(defcustom consult-preview-variables - '((inhibit-message . t) - (enable-dir-local-variables . nil) - (enable-local-variables . :safe) - (non-essential . t) - (delay-mode-hooks . t)) - "Variables which are bound for file preview." - :type '(alist :key-type symbol)) - -(defcustom consult-bookmark-narrow - `((?f "File" ,#'bookmark-default-handler) - (?h "Help" ,#'help-bookmark-jump) - (?i "Info" ,#'Info-bookmark-jump) - (?p "Picture" ,#'image-bookmark-jump) - (?d "Docview" ,#'doc-view-bookmark-jump) - (?m "Man" ,#'Man-bookmark-jump) - (?w "Woman" ,#'woman-bookmark-jump) - (?g "Gnus" ,#'gnus-summary-bookmark-jump) - ;; Introduced on Emacs 28 - (?s "Eshell" eshell-bookmark-jump) - (?e "Eww" eww-bookmark-jump) - (?v "VC Directory" vc-dir-bookmark-jump)) - "Bookmark narrowing configuration. - -Each element of the list must have the form '(char name handler)." - :type '(repeat (list character string function))) - -(defcustom consult-crm-prefix - (cons " " (propertize "✓ " 'face 'success)) - "Prefix for `consult-completing-read-multiple' candidates." - :type '(cons (string :tag "Not selected") (string :tag "Selected"))) - -;;;; Faces - -(defgroup consult-faces nil - "Faces used by Consult." - :group 'consult - :group 'faces) - -(defface consult-preview-line - '((t :inherit consult-preview-insertion :extend t)) - "Face used for line previews.") - -(defface consult-preview-match - '((t :inherit match)) - "Face used for match previews in `consult-grep'.") - -(defface consult-preview-cursor - '((t :inherit consult-preview-match)) - "Face used for cursor previews and marks in `consult-mark'.") - -(defface consult-preview-error - '((t :inherit isearch-fail)) - "Face used for cursor previews and marks in `consult-compile-error'.") - -(defface consult-preview-insertion - '((t :inherit region)) - "Face used for previews of text to be inserted. -Used by `consult-completion-in-region', `consult-yank' and `consult-history'.") - -(defface consult-narrow-indicator - '((t :inherit warning)) - "Face used for the narrowing indicator.") - -(defface consult-async-running - '((t :inherit consult-narrow-indicator)) - "Face used if asynchronous process is running.") - -(defface consult-async-finished - '((t :inherit success)) - "Face used if asynchronous process has finished.") - -(defface consult-async-failed - '((t :inherit error)) - "Face used if asynchronous process has failed.") - -(defface consult-async-split - '((t :inherit font-lock-negation-char-face)) - "Face used to highlight punctuation character.") - -(defface consult-help - '((t :inherit shadow)) - "Face used to highlight help, e.g., in `consult-register-store'.") - -(defface consult-key - '((t :inherit font-lock-keyword-face)) - "Face used to highlight keys, e.g., in `consult-register'.") - -(defface consult-line-number - '((t :inherit consult-key)) - "Face used to highlight location line in `consult-global-mark'.") - -(defface consult-file - '((t :inherit font-lock-function-name-face)) - "Face used to highlight files in `consult-buffer'.") - -(defface consult-grep-context - '((t :inherit shadow)) - "Face used to highlight grep context in `consult-grep'.") - -(defface consult-bookmark - '((t :inherit font-lock-constant-face)) - "Face used to highlight bookmarks in `consult-buffer'.") - -(defface consult-buffer - '((t)) - "Face used to highlight buffers in `consult-buffer'.") - -(defface consult-crm-selected - '((t :inherit secondary-selection)) - "Face used to highlight selected items in `consult-completing-read-multiple'.") - -(defface consult-line-number-prefix - '((t :inherit line-number)) - "Face used to highlight line number prefixes.") - -(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.") - -(defface consult-separator - '((((class color) (min-colors 88) (background light)) - :foreground "#ccc") - (((class color) (min-colors 88) (background dark)) - :foreground "#333")) - "Face used for thin line separators in `consult-register-window'.") - -;;;; History variables - -(defvar consult--keep-lines-history nil) -(defvar consult--grep-history nil) -(defvar consult--find-history nil) -(defvar consult--man-history nil) -(defvar consult--line-history nil) -(defvar consult--apropos-history nil) -(defvar consult--theme-history nil) -(defvar consult--minor-mode-menu-history nil) -(defvar consult--kmacro-history nil) -(defvar consult--buffer-history nil) -(defvar consult--crm-history nil) - -;;;; Internal variables - -(defvar consult--regexp-compiler - #'consult--default-regexp-compiler - "Regular expression compiler used by `consult-grep' and other commands. -The function must return a list of regular expressions and a highlighter -function.") - -(defvar consult--customize-alist nil - "Command configuration alist for fine-grained configuration. - -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 -the private `consult--read' API and should not be considered as stable -as the public API.") - -(defvar consult--buffer-display #'switch-to-buffer - "Buffer display function.") - -(defvar consult--completion-candidate-hook - (list #'consult--default-completion-mb-candidate - #'consult--default-completion-list-candidate) - "Get candidate from completion system.") - -(defvar consult--completion-refresh-hook nil - "Refresh completion system.") - -(defvar-local consult--preview-function nil - "Minibuffer-local variable which exposes the current preview function. -This function can be called by custom completion systems from -outside the minibuffer.") - -(defconst consult--tofu-char #x200000 - "Special character used to encode line prefixes for disambiguation. -We use invalid characters outside the Unicode range.") - -(defconst consult--tofu-range #x100000 - "Special character range.") - -(defvar-local consult--narrow nil - "Current narrowing key.") - -(defvar-local consult--narrow-keys nil - "Narrowing prefixes of the current completion.") - -(defvar-local consult--narrow-predicate nil - "Narrowing predicate of the current completion.") - -(defvar-local consult--narrow-overlay nil - "Narrowing indicator overlay.") - -(defvar consult--gc-threshold (* 64 1024 1024) - "Large gc threshold for temporary increase.") - -(defvar consult--gc-percentage 0.5 - "Large gc percentage for temporary increase.") - -(defvar consult--process-chunk (* 1024 1024) - "Increase process output chunk size.") - -(defvar consult--async-log - " *consult-async*" - "Buffer for async logging output used by `consult--async-process'.") - -(defvar-local consult--focus-lines-overlays nil - "Overlays used by `consult-focus-lines'.") - -;;;; Customization helper - -(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 - -(defun consult--command-split (str) - "Return command argument and options list given input STR." - (save-match-data - (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. - (cons str (and opts (ignore-errors (split-string-and-unquote opts))))))) - -(defun consult--highlight-regexps (regexps 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." - (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-preview-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)) - (lambda (str) - (let ((case-fold-search ignore-case)) - (consult--highlight-regexps regexps str)))))) - -(defun consult--split-escaped (str) - "Split STR at spaces, which can be escaped with backslash." - (mapcar - (lambda (x) (replace-regexp-in-string (string 0) " " x)) - (split-string (replace-regexp-in-string - "\\\\\\\\\\|\\\\ " - (lambda (x) (if (equal x "\\ ") (string 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)) - (let ((head (make-symbol "head")) - (prev (make-symbol "prev")) - (result (make-symbol "result"))) - `(let* ((,head (cons nil ,list)) - (,prev ,head)) - (while (cdr ,prev) - (if-let (,result (let ((it (cadr ,prev))) ,form)) - (progn - (pop ,prev) - (setcar ,prev ,result)) - (setcdr ,prev (cddr ,prev)))) - (setq ,list (cdr ,head)) - nil))) - -;; Upstream bug#46326, Consult issue https://github.com/minad/consult/issues/193 -(defmacro consult--minibuffer-with-setup-hook (fun &rest body) - "Variant of `minibuffer-with-setup-hook' using a symbol and `fset'. - -This macro is only needed to prevent memory leaking issues with -the upstream `minibuffer-with-setup-hook' macro. -FUN is the hook function and BODY opens the minibuffer." - (declare (indent 1) (debug t)) - (let ((hook (make-symbol "hook")) - (append)) - (when (eq (car-safe fun) :append) - (setq append '(t) fun (cadr fun))) - `(let ((,hook (make-symbol "consult--minibuffer-setup"))) - (fset ,hook (lambda () - (remove-hook 'minibuffer-setup-hook ,hook) - (funcall ,fun))) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook ,hook ,@append) - ,@body) - (remove-hook 'minibuffer-setup-hook ,hook))))) - -(defun consult--completion-filter (pattern cands category _highlight) - "Filter CANDS with PATTERN. - -CATEGORY is the completion category, used to find the completion style via -`completion-category-defaults' and `completion-category-overrides'. -HIGHLIGHT must be non-nil if the resulting strings should be highlighted." - ;; completion-all-completions returns an improper list - ;; where the last link is not necessarily nil. - (nconc (completion-all-completions pattern cands nil (length pattern) - `(metadata (category . ,category))) - nil)) - -(defun consult--completion-filter-complement (pattern cands category _highlight) - "Filter CANDS with complement of PATTERN. -See `consult--completion-filter' for the arguments CATEGORY and HIGHLIGHT." - (let ((ht (consult--string-hash (consult--completion-filter pattern cands category nil)))) - (seq-remove (lambda (x) (gethash x ht)) cands))) - -(defun consult--completion-filter-dispatch (pattern cands category 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 -HIGHLIGHT." - (cond - ((string-match-p "\\`!? ?\\'" pattern) cands) ;; empty pattern - ((string-prefix-p "! " pattern) (consult--completion-filter-complement - (substring pattern 2) cands category nil)) - (t (consult--completion-filter pattern cands category highlight)))) - -(defmacro consult--each-line (beg end &rest body) - "Iterate over each line. - -The line beginning/ending BEG/END is bound in BODY." - (declare (indent 2)) - (let ((max (make-symbol "max"))) - `(save-excursion - (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))) - ,@body - (setq ,beg (1+ ,end))))))) - -(defmacro consult--static-if (cond then &rest else) - "If COND yields non-nil at compile time, do THEN, else do ELSE." - (declare (indent 2)) - (if (eval cond 'lexical) then (macroexp-progn else))) - -(defun consult--display-width (string) - "Compute width of STRING taking display and invisible properties into account." - (let ((pos 0) (width 0) (end (length string))) - (while (< pos end) - (let ((nextd (next-single-property-change pos 'display string end)) - (display (get-text-property pos 'display string))) - (if (stringp display) - (setq width (+ width (string-width display)) - pos nextd) - (while (< pos nextd) - (let ((nexti (next-single-property-change pos 'invisible string nextd))) - (unless (get-text-property pos 'invisible string) - (setq width (+ width - ;; bug#47712: Emacs 28 can compute `string-width' of substrings - (consult--static-if (eq 3 (cdr (func-arity #'string-width))) - (string-width string pos nexti) - (string-width - ;; Avoid allocation for the full string. - (if (and (= pos 0) (= nexti end)) - string - (substring-no-properties string pos nexti))))))) - (setq pos nexti)))))) - width)) - -(defun consult--string-hash (strings) - "Create hashtable from STRINGS." - (let ((ht (make-hash-table :test #'equal :size (length strings)))) - (dolist (str strings) - (puthash str t ht)) - ht)) - -(defmacro consult--local-let (binds &rest body) - "Buffer local let BINDS of dynamic variables in BODY." - (declare (indent 1)) - (let ((buffer (make-symbol "buffer")) - (local (mapcar (lambda (x) (cons (make-symbol "local") (car x))) binds))) - `(let ((,buffer (current-buffer)) - ,@(mapcar (lambda (x) `(,(car x) (local-variable-p ',(cdr x)))) local)) - (unwind-protect - (progn - ,@(mapcar (lambda (x) `(make-local-variable ',(car x))) binds) - (let (,@binds) - ,@body)) - (when (buffer-live-p ,buffer) - (with-current-buffer ,buffer - ,@(mapcar (lambda (x) - `(unless ,(car x) - (kill-local-variable ',(cdr x)))) - local))))))) - -(defun consult--abbreviate-directory (dir) - "Return abbreviated directory DIR for use in `completing-read' prompt." - (save-match-data - (let ((adir (abbreviate-file-name dir))) - (if (string-match "/\\([^/]+\\)/\\([^/]+\\)/\\'" adir) - (format "…/%s/%s/" (match-string 1 adir) (match-string 2 adir)) - adir)))) - -(defun consult--directory-prompt (prompt dir) - "Return prompt and directory. - -PROMPT is the prompt prefix. The directory -is appended to the prompt prefix. For projects -only the project name is shown. The `default-directory' -is not shown. Other directories are abbreviated and -only the last two path components are shown. - -If DIR is a string, it is returned. -If DIR is a true value, the user is asked. -Then the `consult-project-function' is tried. -Otherwise the `default-directory' is returned." - (let* ((dir - (cond - ((stringp dir) dir) - (dir - ;; HACK Preserve this-command across `read-directory-name' call, - ;; such that `consult-customize' continues to work. - ;; TODO Find a better and more general solution which preserves `this-command'. - (let ((this-command this-command)) - (read-directory-name "Directory: " nil nil t))) - (t (or (consult--project-root) default-directory)))) - (edir (file-name-as-directory (expand-file-name dir))) - ;; Bind default-directory in order to find the project - (pdir (let ((default-directory edir)) (consult--project-root)))) - (cons - (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)))) - edir))) - -(defun consult--default-project-function (may-prompt) - "Return project root directory. -When no project is found and MAY-PROMPT is non-nil ask the user." - (when-let (proj (project-current may-prompt)) - (cond - ((fboundp 'project-root) (project-root proj)) - ((fboundp 'project-roots) (car (project-roots proj)))))) - -(defun consult--project-root (&optional may-prompt) - "Return project root as absolute path. -When no project is found and MAY-PROMPT is non-nil ask the user." - (when-let (root (and consult-project-function - (funcall consult-project-function may-prompt))) - (expand-file-name root))) - -(defun consult--project-name (dir) - "Return the project name for DIR." - (if (string-match "/\\([^/]+\\)/\\'" dir) - (match-string 1 dir) - dir)) - -(defun consult--format-location (file line &optional str) - "Format location string 'FILE:LINE:STR'." - (setq line (number-to-string line) - str (concat file ":" line (and str ":") str) - 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) - -(defmacro consult--overlay (beg end &rest props) - "Make consult overlay between BEG and END with PROPS." - (let ((ov (make-symbol "ov")) - (puts)) - (while props - (push `(overlay-put ,ov ,(car props) ,(cadr props)) puts) - (setq props (cddr props))) - `(let ((,ov (make-overlay ,beg ,end))) - ,@puts - ,ov))) - -(defun consult--remove-dups (list) - "Remove duplicate strings from LIST." - (delete-dups (copy-sequence list))) - -(defsubst consult--in-range-p (pos) - "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-candidate (selected candidates &rest _) - "Lookup SELECTED in CANDIDATES list and return property `consult--candidate'." - (when-let (found (member selected candidates)) - (get-text-property 0 'consult--candidate (car found)))) - -(defun consult--forbid-minibuffer () - "Raise an error if executed from the minibuffer." - (when (minibufferp) - (user-error "`%s' called inside the minibuffer" this-command))) - -(defun consult--require-minibuffer () - "Raise an error if executed outside the minibuffer." - (unless (minibufferp) - (user-error "`%s' must be called inside the minibuffer" this-command))) - -(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 - ;; order to prevent is hang-up we check the buffer size against - ;; `consult-fontify-max-size'. - (when (and consult-fontify-preserve jit-lock-mode - (< (buffer-size) consult-fontify-max-size)) - (jit-lock-fontify-now))) - -(defun consult--fontify-region (start end) - "Ensure that region between START and END is fontified." - (when (and consult-fontify-preserve jit-lock-mode) - (jit-lock-fontify-now start end))) - -(defmacro consult--with-increased-gc (&rest body) - "Temporarily increase the gc limit in BODY to optimize for throughput." - (let ((overwrite (make-symbol "overwrite"))) - `(let* ((,overwrite (> consult--gc-threshold gc-cons-threshold)) - (gc-cons-threshold (if ,overwrite consult--gc-threshold gc-cons-threshold)) - (gc-cons-percentage (if ,overwrite consult--gc-percentage gc-cons-percentage))) - ,@body))) - -(defun consult--count-lines (pos) - "Move to position POS and return number of lines." - (let ((line 0)) - (while (< (point) pos) - (forward-line) - (when (<= (point) pos) - (setq line (1+ line)))) - (goto-char pos) - line)) - -(defun consult--position-marker (buffer line column) - "Get marker in BUFFER from LINE and COLUMN." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (save-restriction - (save-excursion - (widen) - (goto-char (point-min)) - ;; Location data might be invalid by now! - (ignore-errors - (forward-line (1- line)) - (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." - (setq curr-line (or curr-line -1)) - (let* ((width (length (number-to-string (line-number-at-pos - (point-max) - consult-line-numbers-widen)))) - (fmt-before (propertize (format "%%%dd " width) 'face 'consult-line-number-wrapped)) - (fmt-after (propertize (format "%%%dd " width) 'face 'consult-line-number-prefix))) - (lambda (cand) - (let ((line (cdr (get-text-property 0 'consult-location cand)))) - (list cand (format (if (< line curr-line) fmt-before fmt-after) line) ""))))) - -(defun consult--location-candidate (cand marker line &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)))) - (add-text-properties 0 1 `(consult-location (,marker . ,line) ,@props) cand) - cand) - -;; 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) - "List of text properties to remove from buffer strings.") - -(defsubst consult--buffer-substring (beg end &optional fontify) - "Return buffer substring between BEG and END. -If FONTIFY and `consult-fontify-preserve' are non-nil, first ensure that the -region has been fontified." - (if consult-fontify-preserve - (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) - str) - (buffer-substring-no-properties beg end))) - -(defun consult--region-with-cursor (beg end marker) - "Return region string with a marking at the cursor position. - -BEG is the begin position. -END is the end position. -MARKER is the cursor position." - (let ((str (consult--buffer-substring beg end 'fontify))) - (if (>= marker end) - (concat str #(" " 0 1 (face consult-preview-cursor))) - (put-text-property (- marker beg) (- (1+ marker) beg) - 'face 'consult-preview-cursor str) - str))) - -(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))) - -;;;; Preview support - -(defun consult--filter-find-file-hook (orig &rest hooks) - "Filter `find-file-hook' by `consult-preview-allowed-hooks'. -This function is an advice for `run-hooks'. -ORIG is the original function, HOOKS the arguments." - (if (memq 'find-file-hook hooks) - (cl-letf* (((default-value 'find-file-hook) - (seq-filter (lambda (x) - (memq x consult-preview-allowed-hooks)) - (default-value 'find-file-hook))) - (find-file-hook (default-value 'find-file-hook))) - (apply orig hooks)) - (apply orig hooks))) - -(defun consult--find-file-temporarily (name) - "Open file NAME temporarily for preview." - ;; file-attributes may throw permission denied error - (when-let* ((attrs (ignore-errors (file-attributes name))) - (size (file-attribute-size attrs))) - (if (<= size consult-preview-max-size) - (let* ((vars (delq nil - (mapcar - (pcase-lambda (`(,k . ,v)) - (if (boundp k) - (list k v (default-value k) (symbol-value k)) - (message "consult-preview-variables: The variable `%s' is not bound" k) - nil)) - consult-preview-variables))) - (buf (unwind-protect - (progn - (advice-add #'run-hooks :around #'consult--filter-find-file-hook) - (pcase-dolist (`(,k ,v . ,_) vars) - (set-default k v) - (set k v)) - (find-file-noselect name 'nowarn (> size consult-preview-raw-size))) - (advice-remove #'run-hooks #'consult--filter-find-file-hook) - (pcase-dolist (`(,k ,_ ,d ,v) vars) - (set-default k d) - (set k v))))) - (if (not (ignore-errors (buffer-local-value 'so-long-detected-p buf))) - buf - (kill-buffer buf) - (message "File `%s' has long lines, not previewed" name) - nil)) - (message "File `%s' (%s) is too large for preview" - name (file-size-human-readable size)) - nil))) - -(defun consult--temporary-files () - "Return a function to open files temporarily for preview." - (let ((dir default-directory) - (hook (make-symbol "consult--temporary-files")) - (orig-buffers (buffer-list)) - temporary-buffers) - (fset hook - (lambda (_) - ;; Fully initialize previewed files and keep them alive. - (unless (consult--completion-window-p) - (let (live-files) - (pcase-dolist (`(,file . ,buf) temporary-buffers) - (when-let (wins (and (buffer-live-p buf) - (get-buffer-window-list buf))) - (push (cons file (mapcar - (lambda (win) - (cons win (window-state-get win t))) - wins)) - live-files))) - (pcase-dolist (`(,_ . ,buf) temporary-buffers) - (kill-buffer buf)) - (setq temporary-buffers nil) - (pcase-dolist (`(,file . ,wins) live-files) - (when-let (buf (find-file-noselect file)) - (push buf orig-buffers) - (pcase-dolist (`(,win . ,state) wins) - (setf (car (alist-get 'buffer state)) buf) - (window-state-put state win)))))))) - (lambda (&optional name) - (if name - (let ((default-directory dir)) - (setq name (abbreviate-file-name (expand-file-name name))) - (or - ;; get-file-buffer is only a small optimization here. It - ;; may not find the actual buffer, for directories it - ;; returns nil instead of returning the Dired buffer. - (get-file-buffer name) - (cdr (assoc name temporary-buffers)) - (when-let (buf (consult--find-file-temporarily name)) - ;; Only add new buffer if not already in the list - (unless (or (rassq buf temporary-buffers) (memq buf orig-buffers)) - (add-hook 'window-selection-change-functions hook) - (push (cons name buf) temporary-buffers) - ;; Disassociate buffer from file by setting - ;; `buffer-file-name' 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 - (rename-buffer - (format "Preview:%s" - (file-name-nondirectory (directory-file-name name))) - '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) - ;; early also prevents the major mode initialization. - (let ((hook (make-symbol "consult--temporary-files-disassociate"))) - (fset hook (lambda () - (when (buffer-live-p buf) - (with-current-buffer buf - (remove-hook 'pre-command-hook hook) - (setq buffer-read-only t - buffer-file-name nil))))) - (add-hook 'pre-command-hook hook)) - ;; Only keep a few buffers alive - (while (> (length temporary-buffers) consult-preview-max-count) - (kill-buffer (cdar (last temporary-buffers))) - (setq temporary-buffers (nbutlast temporary-buffers)))) - buf))) - (remove-hook 'window-selection-change-functions hook) - (pcase-dolist (`(,_ . ,buf) temporary-buffers) - (kill-buffer buf)) - (setq temporary-buffers nil))))) - -(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))))) - -(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)) - -(defun consult--jump-1 (pos) - "Go to POS and recenter." - (cond - ((and (markerp pos) (not (marker-buffer pos))) - ;; Only print a message, no error in order to not mess - ;; with the minibuffer update hook. - (message "Buffer is dead")) - (t - ;; 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)) - ;; Widen if we cannot jump to the position (idea from flycheck-jump-to-error) - (unless (= (goto-char pos) (point)) - (widen) - (goto-char pos))))) - -(defun consult--jump (pos) - "Push current position to mark ring, go to POS and recenter." - (when pos - ;; When the marker is in the same buffer, - ;; record previous location such that the user can jump back quickly. - (unless (and (markerp pos) (not (eq (current-buffer) (marker-buffer pos)))) - (push-mark (point) t)) - (consult--jump-1 pos) - (consult--invisible-open-permanently) - (run-hooks 'consult-after-jump-hook)) - nil) - -;; Matched strings are not highlighted as of now. -;; see https://github.com/minad/consult/issues/7 -(defun consult--jump-preview (&optional face) - "The preview function used if selecting from a list of candidate positions. -The function can be used as the `:state' argument of `consult--read'. -FACE is the cursor face." - (let ((face (or face 'consult-preview-cursor)) - (saved-min (point-min-marker)) - (saved-max (point-max-marker)) - (saved-pos (point-marker)) - overlays invisible) - (set-marker-insertion-type saved-max t) ;; Grow when text is inserted - (lambda (action cand) - (when (eq action 'preview) - (mapc #'funcall invisible) - (mapc #'delete-overlay overlays) - (setq invisible nil overlays nil) - (if (not cand) - ;; If position cannot be previewed, return to saved position - (let ((saved-buffer (marker-buffer saved-pos))) - (if (not saved-buffer) - (message "Buffer is dead") - (set-buffer saved-buffer) - (narrow-to-region saved-min saved-max) - (goto-char saved-pos))) - ;; Jump to position - (consult--jump-1 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)))) - (consult--overlay (point) (1+ (point)) - 'face face - 'window (selected-window)))) - (run-hooks 'consult-after-jump-hook)))))) - -(defun consult--jump-state (&optional face) - "The state function used if selecting from a list of candidate positions. -The function can be used as the `:state' argument of `consult--read'. -FACE is the cursor face." - (let ((preview (consult--jump-preview face))) - (lambda (action cand) - (funcall preview action cand) - (when (and cand (eq action 'return)) - (consult--jump cand))))) - -(defmacro consult--define-state (type) - "Define state function for TYPE." - `(defun ,(intern (format "consult--%s-state" type)) () - (let ((preview (,(intern (format "consult--%s-preview" type))))) - (lambda (action cand) - (funcall preview action cand) - (when (and cand (eq action 'return)) - (,(intern (format "consult--%s-action" type)) cand)))))) - -(defun consult--preview-key-normalize (preview-key) - "Normalize PREVIEW-KEY, return alist of keys and debounce times." - (let ((keys) - (debounce 0)) - (setq preview-key (consult--ensure-list preview-key)) - (while preview-key - (if (eq (car preview-key) :debounce) - (setq debounce (cadr preview-key) - preview-key (cddr preview-key)) - (push (cons (car preview-key) debounce) keys) - (pop preview-key))) - keys)) - -(defun consult--preview-key-debounce (preview-key cand) - "Return debounce value of PREVIEW-KEY given the current candidate CAND." - (when (and (consp preview-key) (memq :keys preview-key)) - (setq preview-key (funcall (plist-get preview-key :predicate) cand))) - (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) (cdr x)))) - (setq keys (lookup-key map keys)) - (if (numberp keys) keys any))) - -;; TODO Remove this function after upgrades of :state functions -(defun consult--protected-state-call (fun action cand) - "Call state FUN with ACTION and CAND and protect against errors." - (condition-case err - (funcall fun action cand) - (t (message "consult--read: No preview, the :state function protocol changed: %S" err)))) - -(defun consult--append-local-post-command-hook (fun) - "Append FUN to local `post-command-hook' list." - ;; Symbol indirection because of bug#46407. - (let ((hook (make-symbol "consult--preview-post-command"))) - (fset hook fun) - ;; TODO Emacs 28 has a bug, where the hook--depth-alist is not cleaned up properly - ;; Do not use the broken add-hook here. - ;;(add-hook 'post-command-hook sym 'append 'local) - (setq-local post-command-hook - (append - (remove t post-command-hook) - (list hook) - (and (memq t post-command-hook) '(t)))))) - -(defun consult--with-preview-1 (preview-key state transform candidate fun) - "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) - (consult--minibuffer-with-setup-hook - (if (and state preview-key) - (lambda () - (let ((exit-hook (make-symbol "consult--preview-minibuffer-exit"))) - (fset exit-hook - (lambda () - (when timer - (cancel-timer timer) - (setq timer nil)) - (with-selected-window (or (minibuffer-selected-window) (next-window)) - ;; STEP 3: Reset preview - (when last-preview - (consult--protected-state-call state 'preview nil)) - ;; STEP 4: Notify the preview function of the minibuffer exit - (consult--protected-state-call state 'exit nil)))) - (add-hook 'minibuffer-exit-hook exit-hook nil 'local)) - ;; STEP 1: Setup the preview function - (with-selected-window (or (minibuffer-selected-window) (next-window)) - (consult--protected-state-call state 'setup nil)) - (setq consult--preview-function - (lambda () - (when-let ((cand (funcall candidate))) - (with-selected-window (active-minibuffer-window) - (let ((input (minibuffer-contents-no-properties))) - (with-selected-window (or (minibuffer-selected-window) (next-window)) - (let ((transformed (funcall transform narrow input cand)) - (new-preview (cons input cand))) - (when-let (debounce (consult--preview-key-debounce preview-key transformed)) - (when timer - (cancel-timer timer) - (setq timer nil)) - (unless (equal last-preview new-preview) - (if (> debounce 0) - (let ((win (selected-window))) - (setq timer - (run-at-time - debounce nil - (lambda () - (when (window-live-p win) - (with-selected-window win - ;; STEP 2: Preview candidate - (consult--protected-state-call - state 'preview transformed) - (setq last-preview new-preview))))))) - ;; STEP 2: Preview candidate - (consult--protected-state-call state 'preview transformed) - (setq last-preview new-preview))))))))))) - (consult--append-local-post-command-hook - (lambda () - (setq input (minibuffer-contents-no-properties) - narrow consult--narrow) - (funcall consult--preview-function)))) - (lambda () - (consult--append-local-post-command-hook - (lambda () (setq input (minibuffer-contents-no-properties) - narrow consult--narrow))))) - (unwind-protect - (cons (setq selected (when-let (result (funcall fun)) - (funcall transform narrow input result))) - input) - (when state - ;; STEP 5: The preview function should perform its final action - (consult--protected-state-call state 'return selected)))))) - -(defmacro consult--with-preview (preview-key state transform candidate &rest body) - "Add preview support to BODY. - -STATE is the state function. -TRANSFORM is the transformation function. -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 -sequence with the following arguments: - - 1. 'setup nil After entering the minibuffer (minibuffer-setup-hook). -⎧ 2. 'preview CAND/nil Preview candidate CAND or reset if CAND is nil. -⎪ 'preview CAND/nil -⎪ 'preview CAND/nil -⎪ ... -⎩ 3. 'preview nil Reset preview. - 4. 'exit nil Before exiting the minibuffer (minibuffer-exit-hook). - 5. 'return CAND/nil After leaving the minibuffer, 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 -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 -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 -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 -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 - -(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)))) - -(defun consult-narrow (key) - "Narrow current completion with KEY. - -This command is used internally by the narrowing system of `consult--read'." - (interactive - (list (unless (equal (this-single-command-keys) (consult--widen-key)) - last-command-event))) - (consult--require-minibuffer) - (setq consult--narrow key) - (when consult--narrow-predicate - (setq minibuffer-completion-predicate (and consult--narrow consult--narrow-predicate))) - (when consult--narrow-overlay - (delete-overlay consult--narrow-overlay)) - (when consult--narrow - (setq consult--narrow-overlay - (consult--overlay - (1- (minibuffer-prompt-end)) (minibuffer-prompt-end) - 'before-string - (propertize (format " [%s]" (alist-get consult--narrow - consult--narrow-keys)) - 'face 'consult-narrow-indicator)))) - (run-hooks 'consult--completion-refresh-hook)) - -(defconst consult--narrow-delete - `(menu-item - "" nil :filter - ,(lambda (&optional _) - (when (string= (minibuffer-contents-no-properties) "") - (lambda () - (interactive) - (consult-narrow nil)))))) - -(defconst consult--narrow-space - `(menu-item - "" nil :filter - ,(lambda (&optional _) - (let ((str (minibuffer-contents-no-properties))) - (when-let (pair (or (and (= 1 (length str)) - (assoc (aref str 0) consult--narrow-keys)) - (and (string= str "") - (assoc 32 consult--narrow-keys)))) - (lambda () - (interactive) - (delete-minibuffer-contents) - (consult-narrow (car pair)))))))) - -(defun consult-narrow-help () - "Print narrowing help as a `minibuffer-message'. - -This command can be bound to a key in `consult-narrow-map', -to make it available for commands with narrowing." - (interactive) - (consult--require-minibuffer) - (let ((minibuffer-message-timeout 1000000)) - (minibuffer-message - (mapconcat - (lambda (x) (concat - (propertize (char-to-string (car x)) 'face 'consult-key) " " - (propertize (cdr x) 'face 'consult-help))) - (seq-filter (lambda (x) (/= (car x) 32)) - consult--narrow-keys) - " ")))) - -(defun consult--narrow-setup (settings map) - "Setup narrowing with SETTINGS and keymap MAP." - (if (memq :keys settings) - (setq consult--narrow-predicate (plist-get settings :predicate) - consult--narrow-keys (plist-get settings :keys)) - (setq consult--narrow-predicate nil - consult--narrow-keys settings)) - (when consult-narrow-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 widen (cons "All" #'consult-narrow)))) - -;; Emacs 28: hide in M-X -(put #'consult-narrow-help 'completion-predicate #'ignore) -(put #'consult-narrow 'completion-predicate #'ignore) - -;;;; Splitting completion style - -(defun consult--split-perl (str point) - "Split input STR in async input and filtering part. - -The function returns a list with four elements: The async string, the -completion filter string, the new point position computed from POINT and a -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 - (let ((q (regexp-quote (substring str 0 1)))) - (string-match (concat "^" q "\\([^" q "]*\\)\\(" q "\\)?") str) - `(,(match-string 1 str) - ,(substring str (match-end 0)) - ,(max 0 (- point (match-end 0))) - ;; Force update it two punctuation characters are entered. - ,(match-end 2) - ;; List of highlights - (0 . ,(match-beginning 1)) - ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2))))))) - `(,str "" 0))) - -(defun consult--split-nil (str _point) - "Treat the complete input STR as async input." - `(,str "" 0)) - -(defun consult--split-separator (sep str point) - "Split input STR in async input and filtering part at the first separator SEP. -POINT is the point position." - (setq sep (regexp-quote (char-to-string sep))) - (save-match-data - (if (string-match (format "^\\([^%s]+\\)\\(%s\\)?" sep sep) str) - `(,(match-string 1 str) - ,(substring str (match-end 0)) - ,(max 0 (- point (match-end 0))) - ;; Force update it space is entered. - ,(match-end 2) - ;; List of highlights - (0 . ,(match-end 1))) - `(,str "" 0)))) - -(defun consult--split-setup (split) - "Setup splitting completion style with splitter function SPLIT." - (let* ((styles completion-styles) - (catdef completion-category-defaults) - (catovr completion-category-overrides) - (try (lambda (str table pred point) - (let ((completion-styles styles) - (completion-category-defaults catdef) - (completion-category-overrides catovr) - (parts (funcall split str point))) - (completion-try-completion (cadr parts) table pred (caddr parts))))) - (all (lambda (str table pred point) - (let ((completion-styles styles) - (completion-category-defaults catdef) - (completion-category-overrides catovr) - (parts (funcall split str point))) - (completion-all-completions (cadr parts) table pred (caddr parts)))))) - (setq-local completion-styles-alist (cons `(consult--split ,try ,all "") - completion-styles-alist) - completion-styles '(consult--split) - completion-category-defaults nil - completion-category-overrides nil))) - -;;;; Async support - -(defmacro consult--with-async (bind &rest body) - "Setup asynchronous completion in BODY. - -BIND is the asynchronous function binding." - (declare (indent 1)) - (let ((async (car bind))) - `(let ((,async ,@(cdr bind)) - (new-chunk (max read-process-output-max consult--process-chunk)) - orig-chunk) - (consult--minibuffer-with-setup-hook - ;; Append such that we overwrite the completion style setting of - ;; `fido-mode'. See `consult--async-split' and - ;; `consult--split-setup'. - (:append - (lambda () - (when (functionp ,async) - (setq orig-chunk read-process-output-max - read-process-output-max new-chunk) - (funcall ,async 'setup) - ;; Push input string to request refresh. - ;; We use a symbol in order to avoid adding lambdas to the hook variable. - ;; Symbol indirection because of bug#46407. - (let ((sym (make-symbol "consult--async-after-change"))) - (fset sym (lambda (&rest _) (funcall ,async (minibuffer-contents-no-properties)))) - (run-at-time 0 nil sym) - (add-hook 'after-change-functions sym nil 'local))))) - (let ((,async (if (functionp ,async) ,async (lambda (_) ,async)))) - (unwind-protect - ,(macroexp-progn body) - (funcall ,async 'destroy) - (when (and orig-chunk (eq read-process-output-max new-chunk)) - (setq read-process-output-max orig-chunk)))))))) - -(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. - -'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." - (let (candidates last buffer previewed) - (lambda (action) - (pcase-exhaustive action - ('setup - (setq buffer (current-buffer)) - nil) - ((or (pred stringp) 'destroy) nil) - ('flush (setq candidates nil last nil previewed nil)) - ('refresh - ;; Refresh the UI when the current minibuffer window belongs - ;; to the current asynchronous completion session. - (when-let (win (active-minibuffer-window)) - (when (eq (window-buffer win) buffer) - (with-selected-window win - (run-hooks 'consult--completion-refresh-hook) - ;; Interaction between asynchronous completion tables and - ;; preview: We have to trigger preview immediately when - ;; candidates arrive (Issue #436). - (when (and consult--preview-function candidates (not previewed)) - (setq previewed t) - (funcall consult--preview-function))))) - nil) - ('nil candidates) - ((pred consp) - (setq last (last (if last (setcdr last action) (setq candidates action)))) - candidates))))) - -(defun consult--async-split-style () - "Return the async splitting style function and initial string." - (or (alist-get consult-async-split-style consult-async-split-styles-alist) - (user-error "Splitting style `%s' not found" consult-async-split-style))) - -(defun consult--async-split-initial (initial) - "Return initial string for async command. -INITIAL is the additional initial string." - (concat (plist-get (consult--async-split-style) :initial) initial)) - -(defun consult--async-split-thingatpt (thing) - "Return THING at point with async initial prefix." - (when-let (str (thing-at-point thing)) - (consult--async-split-initial str))) - -(defun consult--async-split (async &optional split) - "Create async function, which splits the input string. -ASYNC is the async sink. -SPLIT is the splitting function." - (unless split - (let ((style (consult--async-split-style))) - (setq split (pcase (plist-get style :type) - ('separator (apply-partially #'consult--split-separator - (plist-get style :separator))) - ('perl #'consult--split-perl) - ('nil #'consult--split-nil) - (type (user-error "Invalid style type `%s'" type)))))) - (lambda (action) - (pcase action - ('setup - (consult--split-setup split) - (funcall async 'setup)) - ((pred stringp) - (pcase-let* ((`(,async-str ,_ ,_ ,force . ,highlights) - (funcall split action 0)) - (async-len (length async-str)) - (input-len (length action)) - (end (minibuffer-prompt-end))) - ;; Highlight punctuation characters - (remove-list-of-text-properties end (+ end input-len) '(face)) - (dolist (hl highlights) - (put-text-property (+ end (car hl)) (+ end (cdr hl)) - 'face 'consult-async-split)) - (funcall async - ;; Pass through if the input is long enough! - (if (or force (>= async-len consult-async-min-input)) - async-str - ;; Pretend that there is no input - "")))) - (_ (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) - "Create process source async function. - -ASYNC is the async function which receives the candidates. -CMD is the command line builder function. -PROPS are optional properties passed to `make-process'." - (let (proc proc-buf last-args indicator count) - (lambda (action) - (pcase action - ("" ;; If no input is provided kill current process - (when proc - (delete-process proc) - (kill-buffer proc-buf) - (setq proc nil proc-buf nil)) - (setq last-args nil)) - ((pred stringp) - (funcall async action) - (let* ((args (funcall cmd action)) - (flush t) - (rest "") - (proc-filter - (lambda (_ out) - (when flush - (setq flush nil) - (funcall async 'flush)) - (let ((lines (split-string out "[\r\n]+"))) - (if (not (cdr lines)) - (setq rest (concat rest (car lines))) - (setcar lines (concat rest (car lines))) - (let* ((len (length lines)) - (last (nthcdr (- len 2) lines))) - (setq rest (cadr last) - count (+ count len -1)) - (setcdr last nil) - (funcall async lines)))))) - (proc-sentinel - (lambda (_ event) - (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 (list rest))) - (consult--async-log - "consult--async-process sentinel: event=%s lines=%d\n" - (string-trim event) count) - (with-current-buffer (get-buffer-create consult--async-log) - (goto-char (point-max)) - (insert ">>>>> stderr >>>>>\n") - (insert-buffer-substring proc-buf) - (insert "<<<<< stderr <<<<<\n"))))) - (unless (equal args last-args) - (setq last-args args) - (when proc - (delete-process proc) - (kill-buffer proc-buf) - (setq proc nil proc-buf nil)) - (when args - (overlay-put indicator 'display #("*" 0 1 (face consult-async-running))) - (consult--async-log "consult--async-process started %S\n" args) - (setq count 0 - proc-buf (generate-new-buffer " *consult-async-stderr*") - proc (apply #'make-process - `(,@props - :connection-type pipe - :name ,(car args) - ;;; XXX tramp bug, the stderr buffer must be empty - :stderr ,proc-buf - :noquery t - :command ,args - :filter ,proc-filter - :sentinel ,proc-sentinel)))))) - nil) - ('destroy - (when proc - (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)) - (lambda (action) - (cond - ((stringp action) - (setq highlight (plist-get (funcall builder action) :highlight)) - (funcall async action)) - ((and (consp action) highlight) - (dolist (str action) - (funcall highlight str)) - (funcall async action)) - (t (funcall async action)))))) - -(defun consult--async-throttle (async &optional throttle debounce) - "Create async function from ASYNC which throttles input. - -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)) - (lambda (action) - (pcase action - ((pred stringp) - (unless (string= action input) - (when timer - (cancel-timer timer) - (setq timer nil)) - (funcall async "") ;; cancel running process - (setq input action) - (unless (string= action "") - (setq timer - (run-at-time - (+ debounce - (if last - (min (- (float-time) last) throttle) - 0)) - nil - (lambda () - (setq last (float-time)) - (funcall async action)))))) - nil) - ('destroy - (when timer (cancel-timer timer)) - (funcall async 'destroy)) - (_ (funcall async action)))))) - -(defun consult--async-refresh-immediate (async) - "Create async function from ASYNC, which refreshes the display. - -The refresh happens immediately when candidates are pushed." - (lambda (action) - (pcase action - ((or (pred consp) 'flush) - (prog1 (funcall async action) - (funcall async 'refresh))) - (_ (funcall async action))))) - -(defun consult--async-refresh-timer (async &optional delay) - "Create async function from ASYNC, which refreshes the display. - -The refresh happens after a DELAY, defaulting to `consult-async-refresh-delay'." - (let ((timer) (refresh) (delay (or delay consult-async-refresh-delay))) - (lambda (action) - (prog1 (funcall async action) - (pcase action - ((or (pred consp) 'flush) - (setq refresh t) - (unless timer - (setq timer (run-at-time - nil delay - (lambda () - (when refresh - (setq refresh nil) - (funcall async 'refresh))))))) - ('destroy (when timer (cancel-timer timer)))))))) - -(defmacro consult--async-transform (async &rest transform) - "Use FUN to TRANSFORM candidates of ASYNC." - (let ((async-var (make-symbol "async")) - (action-var (make-symbol "action"))) - `(let ((,async-var ,async)) - (lambda (,action-var) - (funcall ,async-var (if (consp ,action-var) (,@transform ,action-var) ,action-var)))))) - -(defun consult--async-map (async fun) - "Map candidates of ASYNC by FUN." - (consult--async-transform async mapcar fun)) - -(defun consult--async-filter (async fun) - "Filter candidates of ASYNC by FUN." - (consult--async-transform async seq-filter fun)) - -(defun consult--ensure-list (list) - "Ensure that LIST is a list." - (if (listp list) list (list list))) ;; Emacs 28 ensure-list - -(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)))) - -(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))) - -;;;; 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) - (define-key map [remap minibuffer-complete] #'minibuffer-completion-help) - map) - "Keymap added for commands with asynchronous candidates.") - -(defvar consult-crm-map (make-sparse-keymap) - "Keymap added by `consult-completing-read-multiple'.") - -(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.") - -;;;; Internal API: consult--read - -(defun consult--add-history (async items) - "Add ITEMS to the minibuffer future history. -ASYNC must be non-nil for async completion functions." - (delete-dups - (append - ;; the defaults are at the beginning of the future history - (consult--ensure-list minibuffer-default) - ;; then our custom items - (remove "" (remq nil (consult--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'. - (unless async - (all-completions "" - minibuffer-completion-table - minibuffer-completion-predicate))))) - -(defun consult--setup-keymap (keymap async narrow preview-key) - "Setup minibuffer keymap. - -KEYMAP is a command-specific keymap. -ASYNC must be non-nil for async completion functions. -NARROW are the narrow settings. -PREVIEW-KEY are the preview keys." - (let ((old-map (current-local-map)) - (map (make-sparse-keymap))) - - ;; Add narrow keys - (when narrow - (consult--narrow-setup narrow map)) - - ;; Preview trigger keys - (when (and (consp preview-key) (memq :keys preview-key)) - (setq preview-key (plist-get preview-key :keys))) - (setq preview-key (mapcar #'car (consult--preview-key-normalize preview-key))) - (when preview-key - (dolist (key preview-key) - (unless (or (eq key 'any) (lookup-key old-map key)) - (define-key map key #'ignore)))) - - ;; Put the keymap together - (use-local-map - (make-composed-keymap - (delq nil (list keymap - (and async consult-async-map) - (and narrow consult-narrow-map) - map)) - old-map)))) - -(defsubst consult--tofu-p (char) - "Return non-nil if CHAR is a tofu." - (<= consult--tofu-char char (+ consult--tofu-char consult--tofu-range -1))) - -(defun consult--fry-the-tofus (&rest _) - "Fry the tofus in the minibuffer." - (let* ((min (minibuffer-prompt-end)) - (max (point-max)) - (pos max)) - (while (and (> pos min) (consult--tofu-p (char-before pos))) - (setq pos (1- 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." - (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." - (- (aref cand (1- (length cand))) consult--tofu-char)) - -;; We must disambiguate the lines by adding a prefix such that two lines with -;; the same text can be distinguished. In order to avoid matching the line -;; number, such that the user can search for numbers with `consult-line', we -;; encode the line number as characters outside the unicode range. -;; By doing that, no accidential matching can occur. -(defun consult--tofu-encode (n) - "Return tofu-encoded number N." - (let ((str "")) - (while (progn - (setq str (concat (char-to-string (+ consult--tofu-char - (% n consult--tofu-range))) - str)) - (and (>= n consult--tofu-range) (setq n (/ n consult--tofu-range))))) - (add-text-properties 0 (length str) '(invisible t consult-strip t) str) - str)) - -(defun consult--read-annotate (fun cand) - "Annotate CAND with annotation function FUN." - (pcase (funcall fun cand) - (`(,_ ,_ ,suffix) suffix) - (ann ann))) - -(defun consult--read-affixate (fun cands) - "Affixate CANDS with annotation function FUN." - (mapcar (lambda (cand) - (let ((ann (funcall fun cand))) - (if (consp ann) - ann - (setq ann (or ann "")) - (list cand "" - ;; 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)))))) - cands)) - -(cl-defun consult--read-1 (candidates &key - prompt predicate require-match history default - keymap category initial narrow add-history annotate - state preview-key sort lookup group inherit-input-method) - "See `consult--read' for the documentation of the arguments." - (consult--minibuffer-with-setup-hook - (:append (lambda () - (add-hook 'after-change-functions #'consult--fry-the-tofus nil 'local) - (consult--setup-keymap keymap (functionp candidates) narrow preview-key) - (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. - (let* ((metadata `(metadata - ,@(when category `((category . ,category))) - ,@(when group `((group-function . ,group))) - ,@(when annotate - `((affixation-function - . ,(apply-partially #'consult--read-affixate annotate)) - (annotation-function - . ,(apply-partially #'consult--read-annotate annotate)))) - ,@(unless sort '((cycle-sort-function . identity) - (display-sort-function . identity))))) - (result - (consult--with-preview - preview-key state - (lambda (narrow input cand) - (condition-case nil - (funcall lookup cand (funcall async nil) input narrow) - (wrong-number-of-arguments - ;; TODO Remove the condition-case after upgrades of :lookup functions - (message "consult--read: The :lookup function protocol changed") - (funcall lookup input (funcall async nil) cand)))) - (apply-partially #'run-hook-with-args-until-success - 'consult--completion-candidate-hook) - (completing-read prompt - (lambda (str pred action) - (if (eq action 'metadata) - metadata - (complete-with-action action (funcall async nil) str pred))) - predicate require-match initial - (if (symbolp history) history (cadr history)) - default - inherit-input-method)))) - (pcase-exhaustive history - (`(:input ,var) - (set var (cdr (symbol-value var))) - (add-to-history var (cdr result))) - ((pred symbolp))) - (car result))))) - -(cl-defun consult--read (candidates &rest options &key - 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. - -Keyword OPTIONS: - -PROMPT is the string which is shown as prompt message in the minibuffer. -PREDICATE is a filter function called for each candidate. -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. -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. -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). -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." - ;; supported types - (cl-assert (or (functionp candidates) ;; async table - (obarrayp candidates) ;; obarray - (hash-table-p candidates) ;; hash table - (not candidates) ;; empty list - (stringp (car candidates)) ;; string list - (and (consp (car candidates)) (stringp (caar candidates))) ;; string alist - (and (consp (car candidates)) (symbolp (caar candidates))))) ;; symbol alist - (ignore prompt predicate require-match history default - keymap category initial narrow add-history annotate - state preview-key sort lookup group inherit-input-method) - (apply #'consult--read-1 candidates - (append - (consult--customize-get) - options - (list :prompt "Select: " - :preview-key consult-preview-key - :sort t - :lookup (lambda (selected &rest _) selected))))) - -;;;; Internal API: consult--multi - -(defsubst consult--multi-source (sources cand) - "Lookup source for CAND in SOURCES list." - (aref sources (consult--tofu-get cand))) - -(defun consult--multi-predicate (sources cand) - "Predicate function called for each candidate CAND given SOURCES." - (let* ((src (consult--multi-source sources cand)) - (narrow (plist-get src :narrow)) - (type (or (car-safe narrow) narrow -1))) - (or (eq consult--narrow type) - (not (or consult--narrow (plist-get src :hidden)))))) - -(defun consult--multi-narrow (sources) - "Return narrow list from SOURCES." - (thread-last sources - (mapcar (lambda (src) - (when-let (narrow (plist-get src :narrow)) - (if (consp narrow) - narrow - (when-let (name (plist-get src :name)) - (cons narrow name)))))) - (delq nil) - (delete-dups))) - -(defun consult--multi-annotate (sources align cand) - "Annotate candidate CAND with `consult--multi' type, given SOURCES and ALIGN." - (let* ((src (consult--multi-source sources cand)) - (annotate (plist-get src :annotate)) - (ann (if annotate - (funcall annotate (cdr (get-text-property 0 'multi-category cand))) - (plist-get src :name)))) - (and ann (concat align ann)))) - -(defun consult--multi-group (sources cand transform) - "Return title of candidate CAND or TRANSFORM the candidate given SOURCES." - (if transform - cand - (plist-get (consult--multi-source sources cand) :name))) - -(defun consult--multi-preview-key (sources) - "Return preview keys from SOURCES." - (list :predicate - (lambda (cand) - (if (plist-member (cdr cand) :preview-key) - (plist-get (cdr cand) :preview-key) - consult-preview-key)) - :keys - (delete-dups - (seq-mapcat (lambda (src) - (let ((key (if (plist-member src :preview-key) - (plist-get src :preview-key) - consult-preview-key))) - (consult--ensure-list key))) - sources)))) - -(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)) - (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))))) - -(defun consult--multi-candidates (sources) - "Return `consult--multi' candidates from SOURCES." - (let ((def) (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))) - ;; Preserve existing `multi-category' datum of the candidate. - (if (get-text-property 0 'multi-category cand) - (when face (add-text-properties 0 (length item) face cand)) - ;; Attach `multi-category' datum and face. - (add-text-properties 0 (length item) - `(multi-category (,cat . ,item) ,@face) cand)) - (when (> width max-width) (setq max-width width)) - (push cand candidates)))) - (setq idx (1+ idx))) - (list def (+ 3 max-width) (nreverse candidates)))) - -(defun consult--multi-enabled-sources (sources) - "Return vector of enabled SOURCES." - (vconcat - (seq-filter (lambda (src) - (if-let (pred (plist-get src :enabled)) - (funcall pred) - t)) - (mapcar (lambda (src) - (if (symbolp src) (symbol-value src) src)) - sources)))) - -(defun consult--multi-state (sources) - "State function given SOURCES." - (when-let (states (delq nil (mapcar (lambda (src) - (when-let (fun (plist-get src :state)) - (cons src (funcall fun)))) - sources))) - (let (last-fun) - (pcase-lambda (action `(,cand . ,src)) - (pcase action - ('setup - (pcase-dolist (`(,_ . ,fun) states) - (funcall fun 'setup nil))) - ('exit - (pcase-dolist (`(,_ . ,fun) states) - (funcall fun 'exit nil))) - ('preview - (let ((selected-fun (cdr (assq src states)))) - ;; If the candidate source changed during preview communicate to - ;; the last source, that none of its candidates is previewed anymore. - (when (and last-fun (not (eq last-fun selected-fun))) - (funcall last-fun 'preview nil)) - (setq last-fun selected-fun) - (when selected-fun - (funcall selected-fun 'preview cand)))) - ('return - (let ((selected-fun (cdr (assq src states)))) - ;; Finish all the sources, except the selected one. - (pcase-dolist (`(,_ . ,fun) states) - (unless (eq fun selected-fun) - (funcall fun 'return nil))) - ;; Finish the source with the selected candidate - (when selected-fun - (funcall selected-fun 'return cand))))))))) - -(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 are supported: :require-match, :history, :keymap, :initial, -: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. - -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 -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: - -Required source fields: -* :category - Completion category. -* :items - List of strings to select from or function returning list of strings. - -Optional source fields: -* :name - Name of the source, 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. -* :face - Face used for highlighting the candidates. -* :annotate - Annotation function called for each candidate, returns string. -* :history - Name of history variable to add selected candidate. -* :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." - (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)))))) - (when-let (history (plist-get (cdr selected) :history)) - (add-to-history history (car selected))) - (if (plist-member (cdr selected) :match) - (when-let (fun (plist-get (cdr selected) :new)) - (funcall fun (car selected)) - (plist-put (cdr selected) :match 'new)) - (when-let (fun (plist-get (cdr selected) :action)) - (funcall fun (car selected))) - (setq selected `(,(car selected) :match t ,@(cdr selected)))) - selected)) - -;;;; Internal API: consult--prompt - -(cl-defun consult--prompt-1 (&key prompt history add-history initial default - keymap state preview-key transform inherit-input-method) - "See `consult--prompt' for documentation." - (consult--minibuffer-with-setup-hook - (:append (lambda () - (consult--setup-keymap keymap nil nil preview-key) - (setq-local minibuffer-default-add-function - (apply-partially #'consult--add-history nil add-history)))) - (car (consult--with-preview - preview-key state - (lambda (_narrow inp _cand) (funcall transform inp)) (lambda () t) - (read-from-minibuffer prompt initial nil nil history default inherit-input-method))))) - -(cl-defun consult--prompt (&rest options &key prompt history add-history initial default - keymap state preview-key transform inherit-input-method) - "Read from minibuffer. - -Keyword OPTIONS: - -PROMPT is the string to prompt with. -TRANSFORM is a function which is applied to the current input string. -HISTORY is the symbol of the history variable. -INITIAL is initial input. -DEFAULT is the default selected value. -ADD-HISTORY is a list of items to add to the history. -STATE is the state function, see `consult--with-preview'. -PREVIEW-KEY are the preview keys (nil, 'any, a single key or a list of keys). -KEYMAP is a command-specific keymap." - (ignore prompt history add-history initial default - keymap state preview-key transform inherit-input-method) - (apply #'consult--prompt-1 - (append - (consult--customize-get) - options - (list :prompt "Input: " - :preview-key consult-preview-key - :transform #'identity)))) - -;;;; Functions - -;;;;; Function: consult-completion-in-region - -(defun consult--insertion-preview (start end) - "State function for previewing a candidate in a specific region. -The candidates are previewed in the region from START to END. This function is -used as the `:state' argument for `consult--read' in the `consult-yank' family -of functions and in `consult-completion-in-region'." - (unless (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. - (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))))) - (let (ov) - (lambda (action cand) - (cond - ((and (not cand) ov) - (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))))))) - -;;;###autoload -(defun consult-completion-in-region (start end collection &optional predicate) - "Use minibuffer completion as the UI for `completion-at-point'. - -The function is called with 4 arguments: START END COLLECTION PREDICATE. -The arguments and expected return value are as specified for -`completion-in-region'. Use as a value for `completion-in-region-function'. - -The function can be configured via `consult-customize'. - - (consult-customize consult-completion-in-region - :completion-styles (basic) - :cycle-threshold 3) - -These configuration options are supported: - - * :cycle-threshold - Cycling threshold (def: `completion-cycle-threshold') - * :completion-styles - Use completion styles (def: `completion-styles') - * :require-match - Require matches when completing (def: nil) - * :prompt - The prompt string shown in the minibuffer" - (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 - ;; necessary if `completion-styles' is buffer-local. - ;; NOTE: The completion-styles will be overwritten for recursive editing sessions! - (cs (or (plist-get config :completion-styles) completion-styles)) - (completion-styles cs) - ((default-value 'completion-styles) cs) - (prompt (or (plist-get config :prompt) "Completion: ")) - (require-match (plist-get config :require-match)) - (preview-key (if (plist-member config :preview-key) - (plist-get config :preview-key) - consult-preview-key)) - (initial (buffer-substring-no-properties start end)) - (metadata (completion-metadata initial collection predicate)) - (threshold (or (plist-get config :cycle-threshold) (completion--cycle-threshold metadata))) - (all (completion-all-completions initial collection predicate (length initial))) - ;; Provide `:annotation-function' if `:company-docsig' is specified - (completion-extra-properties - (if-let (fun (and (not (plist-get completion-extra-properties :annotation-function)) - (plist-get completion-extra-properties :company-docsig))) - `(:annotation-function - ,(lambda (cand) - (concat (propertize " " 'display '(space :align-to center)) - (funcall fun cand))) - ,@completion-extra-properties) - completion-extra-properties))) - ;; error if `threshold' is t or the improper list `all' is too short - (if (and threshold - (or (not (consp (ignore-errors (nthcdr threshold all)))) - (and completion-cycling completion-all-sorted-completions))) - (completion--in-region start end collection predicate) - (let* ((limit (car (completion-boundaries initial collection predicate ""))) - (category (completion-metadata-get metadata 'category)) - (buffer (current-buffer)) - (completion - (cond - ((atom all) nil) - ((and (consp all) (atom (cdr all))) - (concat (substring initial 0 limit) (car all))) - (t (car - (consult--with-preview - preview-key - ;; preview state - (consult--insertion-preview start end) - ;; transformation function - (if (eq category 'file) - (cond - ;; Transform absolute file names - ((file-name-absolute-p initial) - (lambda (_narrow _inp cand) - (substitute-in-file-name cand))) - ;; Ensure that ./ prefix is kept for the shell (#356) - ((string-match-p "\\`\\.\\.?/" initial) - (lambda (_narrow _inp cand) - (setq cand (file-relative-name (substitute-in-file-name cand))) - (if (string-match-p "\\`\\.\\.?/" cand) cand (concat "./" cand)))) - ;; Simplify relative file names - (t - (lambda (_narrow _inp cand) - (file-relative-name (substitute-in-file-name cand))))) - (lambda (_narrow _inp cand) cand)) - ;; candidate function - (apply-partially #'run-hook-with-args-until-success - 'consult--completion-candidate-hook) - (consult--local-let ((enable-recursive-minibuffers t)) - (if (eq category 'file) - ;; We use read-file-name, since many completion UIs make it nicer to - ;; navigate the file system this way; and we insert the initial text - ;; directly into the minibuffer to allow the user's completion - ;; styles to expand it as appropriate (particularly useful for the - ;; partial-completion and initials styles, which allow for very - ;; condensed path specification). - (consult--minibuffer-with-setup-hook - (lambda () (insert initial)) - (read-file-name prompt nil initial require-match nil predicate)) - (completing-read prompt - ;; Evaluate completion table in the original buffer. - ;; This is a reasonable thing to do and required - ;; by some completion tables in particular by lsp-mode. - ;; See https://github.com/minad/vertico/issues/61. - (if (functionp collection) - (lambda (&rest args) - (with-current-buffer buffer - (apply collection args))) - collection) - predicate require-match initial))))))))) - (if completion - (progn - ;; completion--replace removes properties! - (completion--replace start end (setq completion (concat completion))) - (when-let (exit (plist-get completion-extra-properties :exit-function)) - (funcall exit completion - ;; If completion is finished and cannot be further completed, - ;; return 'finished. Otherwise return 'exact. - (if (eq (try-completion completion collection predicate) t) - 'finished 'exact))) - t) - (message "No completion") - nil))))) - -;;;;; Function: consult-completing-read-multiple - -(defun consult--crm-selected () - "Return selected candidates from `consult-completing-read-multiple'." - (when (eq minibuffer-history-variable 'consult--crm-history) - (mapcar - (apply-partially #'get-text-property 0 'consult--crm-selected) - (all-completions - "" minibuffer-completion-table - (lambda (cand) - (and (stringp cand) - (get-text-property 0 'consult--crm-selected cand) - (or (not minibuffer-completion-predicate) - (funcall minibuffer-completion-predicate cand)))))))) - -;;;###autoload -(defun consult-completing-read-multiple (prompt table &optional - pred require-match initial-input - hist def inherit-input-method) - "Enhanced replacement for `completing-read-multiple'. -See `completing-read-multiple' for the documentation of the arguments." - (let* ((orig-items (all-completions "" table pred)) - (prefixed-orig-items - (funcall - (if-let (prefix (car consult-crm-prefix)) - (apply-partially #'mapcar (lambda (item) (propertize item 'line-prefix prefix))) - #'identity) - orig-items)) - (format-item - (lambda (item) - ;; Restore original candidate in order to preserve formatting - (setq item (or (car (member item orig-items)) item) - item (propertize item 'consult--crm-selected item - 'line-prefix (cdr consult-crm-prefix))) - (add-face-text-property 0 (length item) 'consult-crm-selected 'append item) - item)) - (separator (or (bound-and-true-p crm-separator) "[ \t]*,[ \t]*")) - (hist-sym (pcase hist - ('nil 'minibuffer-history) - ('t 'consult--crm-history) - (`(,sym . ,_) sym) ;; ignore history position - (_ hist))) - (hist-val (symbol-value hist-sym)) - (selected - (and initial-input - (or - ;; initial-input is multiple items - (string-match-p separator initial-input) - ;; initial-input is a single candidate - (member initial-input orig-items)) - (prog1 - (mapcar format-item - (split-string initial-input separator 'omit-nulls)) - (setq initial-input nil)))) - (consult--crm-history (append (mapcar #'substring-no-properties selected) hist-val)) - (items (append selected - (seq-remove (lambda (x) (member x selected)) - prefixed-orig-items))) - (orig-md (and (functionp table) (cdr (funcall table "" nil 'metadata)))) - (group-fun (alist-get 'group-function orig-md)) - (sort-fun - (lambda (sort) - (pcase (alist-get sort orig-md) - ('identity `((,sort . identity))) - ((and sort (guard sort)) - `((,sort . ,(lambda (cands) - (setq cands (funcall sort cands)) - (nconc - (seq-filter (lambda (x) (member x selected)) cands) - (seq-remove (lambda (x) (member x selected)) cands))))))))) - (md - `(metadata - (group-function - . ,(lambda (cand transform) - (if (get-text-property 0 'consult--crm-selected cand) - (if transform cand "Selected") - (or (and group-fun (funcall group-fun cand transform)) - (if transform cand "Select multiple"))))) - ,@(funcall sort-fun 'cycle-sort-function) - ,@(funcall sort-fun 'display-sort-function) - ,@(seq-filter (lambda (x) (memq (car x) '(annotation-function - affixation-function - category))) - orig-md))) - (overlay) - (command) - (depth (1+ (recursion-depth))) - (hook (make-symbol "consult--crm-pre-command-hook")) - (wrapper (make-symbol "consult--crm-command-wrapper"))) - (fset wrapper - (lambda () - (interactive) - (pcase (catch 'exit - (call-interactively (setq this-command command)) - 'consult--continue) - ('nil - (with-selected-window (active-minibuffer-window) - (let ((item (minibuffer-contents-no-properties))) - (when (equal item "") - (throw 'exit nil)) - (setq selected (if (member item selected) - ;; Multi selections are not possible. - ;; This is probably no problem, since this is rarely desired. - (delete item selected) - (nconc selected (list (funcall format-item item)))) - consult--crm-history (append (mapcar #'substring-no-properties selected) hist-val) - items (append selected - (seq-remove (lambda (x) (member x selected)) - prefixed-orig-items))) - (when overlay - (overlay-put overlay 'display - (when selected - (format " (%s selected): " (length selected))))) - (delete-minibuffer-contents) - (run-hook-with-args 'consult--completion-refresh-hook 'reset)))) - ('consult--continue nil) - (other (throw 'exit other))))) - (fset hook (lambda () - (when (and this-command (= depth (recursion-depth))) - (setq command this-command this-command wrapper)))) - (consult--minibuffer-with-setup-hook - (:append - (lambda () - (when-let (pos (string-match-p "\\(?: (default[^)]+)\\)?: \\'" prompt)) - (setq overlay (make-overlay (+ (point-min) pos) (+ (point-min) (length prompt)))) - (when selected - (overlay-put overlay 'display (format " (%s selected): " (length selected))))) - (use-local-map (make-composed-keymap (list consult-crm-map) (current-local-map))))) - (unwind-protect - (progn - (add-hook 'pre-command-hook hook 90) - (let ((result - (completing-read - prompt - (lambda (str pred action) - (if (eq action 'metadata) - md - (complete-with-action action items str pred))) - nil ;; predicate - require-match - initial-input - 'consult--crm-history - "" ;; default - inherit-input-method))) - (unless (or (equal result "") selected) - (setq selected (split-string result separator 'omit-nulls) - consult--crm-history (append (mapcar #'substring-no-properties selected) hist-val))))) - (remove-hook 'pre-command-hook hook))) - (when (consp def) - (setq def (car def))) - (if (and def (not (equal "" def)) (not selected)) - (split-string def separator 'omit-nulls) - (setq selected (mapcar #'substring-no-properties selected)) - (set hist-sym (append selected (symbol-value hist-sym))) - selected))) - -;;;; Commands - -;;;;; Command: consult-multi-occur - -;; see https://github.com/raxod502/selectrum/issues/226 -;;;###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 () - "Return alist of outline headings and positions." - (consult--forbid-minibuffer) - (let* ((line (line-number-at-pos (point-min) consult-line-numbers-widen)) - (heading-regexp (concat "^\\(?:" - ;; default definition from outline.el - (or (bound-and-true-p outline-regexp) "[*\^L]+") - "\\)")) - (heading-alist (bound-and-true-p outline-heading-alist)) - (level-fun (or (bound-and-true-p outline-level) - (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)) - (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)))) - (push (consult--location-candidate - (consult--buffer-substring (line-beginning-position) - (line-end-position) - 'fontify) - (cons buffer (point)) line - 'consult--outline-level (funcall level-fun)) - candidates) - (unless (eobp) (forward-char 1)))) - (unless candidates - (user-error "No headings")) - (nreverse candidates))) - -;;;###autoload -(defun consult-outline () - "Jump to an outline heading, obtained by matching against `outline-regexp'. - -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--with-increased-gc (consult--outline-candidates))) - (min-level (- (apply #'min (mapcar - (lambda (cand) - (get-text-property 0 'consult--outline-level cand)) - candidates)) - ?1)) - (narrow-pred (lambda (cand) - (<= (get-text-property 0 'consult--outline-level cand) - (+ consult--narrow min-level)))) - (narrow-keys (mapcar (lambda (c) (cons c (format "Level %c" c))) - (number-sequence ?1 ?9)))) - (consult--read - candidates - :prompt "Go to heading: " - :annotate (consult--line-prefix) - :category 'consult-location - :sort nil - :require-match t - :lookup #'consult--line-match - :narrow `(:predicate ,narrow-pred :keys ,narrow-keys) - :history '(:input consult--line-history) - :add-history (thing-at-point 'symbol) - :state (consult--location-state candidates)))) - -;;;;; Command: consult-mark - -(defun consult--mark-candidates (markers) - "Return list of candidates strings for MARKERS." - (consult--forbid-minibuffer) - (let ((candidates) - (current-buf (current-buffer))) - (save-excursion - (dolist (marker markers) - (when-let ((pos (marker-position marker)) - (buf (marker-buffer marker))) - (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'. - (push (consult--location-candidate - (consult--line-with-cursor marker) marker - (line-number-at-pos pos consult-line-numbers-widen)) - candidates))))) - (unless candidates - (user-error "No marks")) - (nreverse (delete-dups candidates)))) - -;;;###autoload -(defun consult-mark (&optional markers) - "Jump to a marker in MARKERS list (defaults to buffer-local `mark-ring'). - -The command supports preview of the currently selected marker position. -The symbol at point is added to the future history." - (interactive) - (consult--read - (consult--with-increased-gc - (consult--mark-candidates - (or markers (cons (mark-marker) mark-ring)))) - :prompt "Go to mark: " - :annotate (consult--line-prefix) - :category 'consult-location - :sort nil - :require-match t - :lookup #'consult--lookup-location - :history '(:input consult--line-history) - :add-history (thing-at-point 'symbol) - :state (consult--jump-state))) - -;;;;; Command: consult-global-mark - -(defun consult--global-mark-candidates (markers) - "Return list of candidates strings for MARKERS." - (consult--forbid-minibuffer) - (let ((candidates)) - (save-excursion - (dolist (marker markers) - (when-let ((pos (marker-position marker)) - (buf (marker-buffer marker))) - (unless (minibufferp buf) - (with-current-buffer buf - (when (consult--in-range-p pos) - (goto-char pos) - ;; `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) - (consult--line-with-cursor marker) - (consult--tofu-encode marker)) - candidates)))))))) - (unless candidates - (user-error "No global marks")) - (nreverse (delete-dups candidates)))) - -;;;###autoload -(defun consult-global-mark (&optional markers) - "Jump to a marker in MARKERS list (defaults to `global-mark-ring'). - -The command supports preview of the currently selected marker position. -The symbol at point is added to the future history." - (interactive) - (consult--read - (consult--with-increased-gc - (consult--global-mark-candidates - (or markers global-mark-ring))) - :prompt "Go to global mark: " - ;; Despite `consult-global-mark' formating the candidates in grep-like - ;; style, we are not using the 'consult-grep category, since the candidates - ;; have location markers attached. - :category 'consult-location - :sort nil - :require-match t - :lookup #'consult--lookup-location - :history '(:input consult--line-history) - :add-history (thing-at-point 'symbol) - :state (consult--jump-state))) - -;;;;; Command: consult-line - -(defun consult--line-candidates (top curr-line) - "Return list of line candidates. -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))) - (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))))))) - -(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 (or (string-blank-p input) - (eq consult-line-point-placement 'line-beginning)) - pos - (let ((beg 0) - (end (length selected))) - ;; Ignore tofu-encoded unique line number suffix - (while (and (> end 0) (consult--tofu-p (aref selected (1- end)))) - (setq end (1- end))) - ;; Find match end position, remove characters from line end until - ;; matching fails - (let ((step 16)) - (while (> step 0) - (while (and (> (- end step) 0) - ;; Use consult-location completion category when - ;; filtering lines. Highlighting is not necessary here, - ;; but it is actually cheaper to highlight a single - ;; candidate, since setting up deferred highlighting is - ;; costly. - (consult--completion-filter input - (list (substring selected 0 (- end step))) - 'consult-location 'highlight)) - (setq end (- end step))) - (setq step (/ step 2)))) - ;; Find match beginning position, remove characters from line beginning - ;; until matching fails - (when (eq consult-line-point-placement 'match-beginning) - (let ((step 16)) - (while (> step 0) - (while (and (< (+ beg step) end) - ;; See comment above, call to `consult--completion-filter'. - (consult--completion-filter input - (list (substring selected (+ beg step) end)) - 'consult-location 'highlight)) - (setq beg (+ beg step))) - (setq step (/ step 2))) - (setq end beg))) - ;; 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-all'. - (ignore-errors - (if (or (not (markerp pos)) (eq (marker-buffer pos) (current-buffer))) - (+ pos end) - ;; Only create a new marker when jumping across buffers, to avoid - ;; creating unnecessary markers, when scrolling through candidates. - ;; Creating markers is not free. - (move-marker - (make-marker) - (+ pos end) - (marker-buffer pos)))))))) - -(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))) - -;;;###autoload -(defun consult-line (&optional initial start) - "Search for a matching line. - -Depending on the setting `consult-line-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) - :prompt (if top "Go to line from top: " "Go to line: ") - :initial initial))) - -;;;;; Command: consult-line-multi - -(defun consult--line-multi-candidates (buffers) - "Collect the line candidates from multiple buffers. -BUFFERS is the list of buffers." - (or (apply #'nconc - (consult--buffer-map buffers - #'consult--line-candidates 'top most-positive-fixnum)) - (user-error "No lines"))) - -;;;###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'." - (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))) - -;;;;; Command: consult-keep-lines - -(defun consult--keep-lines-state (filter) - "State function for `consult-keep-lines' with FILTER function." - (let ((font-lock-orig font-lock-mode) - (hl-line-orig (bound-and-true-p hl-line-mode)) - (point-orig (point)) - lines content-orig replace last-input) - (if (use-region-p) - (save-restriction - ;; Use the same behavior as `keep-lines'. - (let ((rbeg (region-beginning)) - (rend (save-excursion - (goto-char (region-end)) - (unless (or (bolp) (eobp)) - (forward-line 0)) - (point)))) - (consult--fontify-region rbeg rend) - (narrow-to-region rbeg rend) - (consult--each-line beg end - (push (consult--buffer-substring beg end) lines)) - (setq content-orig (buffer-string) - replace (lambda (content &optional pos) - (delete-region rbeg rend) - (insert content) - (goto-char (or pos rbeg)) - (setq rend (+ rbeg (length content))) - (add-face-text-property rbeg rend 'region t))))) - (consult--fontify-all) - (setq content-orig (buffer-string) - replace (lambda (content &optional pos) - (delete-region (point-min) (point-max)) - (insert content) - (goto-char (or pos (point-min))))) - (consult--each-line beg end - (push (consult--buffer-substring beg end) lines))) - (setq lines (nreverse lines)) - (lambda (action input) - ;; Restoring content and point position - (when (and (eq action 'return) last-input) - ;; No undo recording, modification hooks, buffer modified-status - (with-silent-modifications (funcall replace content-orig point-orig))) - ;; Committing or new input provided -> Update - (when (and input ;; Input has been povided - (or - ;; Committing, but not with empty input - (and (eq action 'return) (not (string-match-p "\\`!? ?\\'" input))) - ;; Input has changed - (not (equal input last-input)))) - (let ((filtered-content - (if (string-match-p "\\`!? ?\\'" input) - ;; Special case the empty input for performance. - ;; Otherwise it could happen that the minibuffer is empty, - ;; but the buffer has not been updated. - content-orig - (if (eq action 'return) - (apply #'concat (mapcan (lambda (x) (list x "\n")) - (funcall filter input lines))) - (while-no-input - ;; Heavy computation is interruptible if *not* committing! - ;; Allocate new string candidates since the matching function mutates! - (apply #'concat (mapcan (lambda (x) (list x "\n")) - (funcall filter input (mapcar #'copy-sequence lines))))))))) - (when (stringp filtered-content) - (when font-lock-mode (font-lock-mode -1)) - (when (bound-and-true-p hl-line-mode) (hl-line-mode -1)) - (if (eq action 'return) - (atomic-change-group - ;; Disable modification hooks for performance - (let ((inhibit-modification-hooks t)) - (funcall replace filtered-content))) - ;; No undo recording, modification hooks, buffer modified-status - (with-silent-modifications - (funcall replace filtered-content) - (setq last-input input)))))) - ;; Restore modes - (when (eq action 'return) - (when hl-line-orig (hl-line-mode 1)) - (when font-lock-orig (font-lock-mode 1)))))) - -;;;###autoload -(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 -command obeys narrowing. - -FILTER is the filter function. -INITIAL is the initial input." - (interactive - (list (lambda (pattern cands) - ;; Use consult-location completion category when filtering lines - (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)))))) - -;;;;; Command: consult-focus-lines - -(defun consult--focus-lines-state (filter) - "State function for `consult-focus-lines' with FILTER function." - (let (lines overlays last-input pt-orig pt-min pt-max) - (save-excursion - (save-restriction - (if (not (use-region-p)) - (consult--fontify-all) - (consult--fontify-region (region-beginning) (region-end)) - (narrow-to-region - (region-beginning) - ;; Behave the same as `keep-lines'. - ;; Move to the next line. - (save-excursion - (goto-char (region-end)) - (unless (or (bolp) (eobp)) - (forward-line 0)) - (point)))) - (setq pt-orig (point) pt-min (point-min) pt-max (point-max)) - (let ((i 0)) - (consult--each-line beg end - ;; NOTE: Use "\n" for empty lines, since we need - ;; a string to attach the text property to. - (let ((line (if (eq beg end) (char-to-string ?\n) - (buffer-substring-no-properties beg end)))) - (put-text-property 0 1 'consult--focus-line (cons (cl-incf i) beg) line) - (push line lines))) - (setq lines (nreverse lines))))) - (lambda (action input) - ;; New input provided -> Update - (when (and input (not (equal input last-input))) - (let (new-overlays) - (pcase (while-no-input - (unless (string-match-p "\\`!? ?\\'" input) ;; empty input. - (let* ((inhibit-quit (eq action 'return)) ;; Non interruptible, when quitting! - (not (string-prefix-p "! " input)) - (stripped (string-remove-prefix "! " input)) - (matches (funcall filter stripped lines)) - (old-ind 0) - (block-beg pt-min) - (block-end pt-min)) - (while old-ind - (let ((match (pop matches)) (ind nil) (beg pt-max) (end pt-max) prop) - (when match - (setq prop (get-text-property 0 'consult--focus-line match) - ind (car prop) - beg (cdr prop) - ;; NOTE: Check for empty lines, see above! - end (+ 1 beg (if (equal match "\n") 0 (length match))))) - (unless (eq ind (1+ old-ind)) - (let ((a (if not block-beg block-end)) - (b (if not block-end beg))) - (when (/= a b) - (push (consult--overlay a b 'invisible t) new-overlays))) - (setq block-beg beg)) - (setq block-end end old-ind ind))))) - 'commit) - ('commit - (mapc #'delete-overlay overlays) - (setq last-input input overlays new-overlays)) - (_ (mapc #'delete-overlay new-overlays))))) - (when (eq action 'return) - (cond - ((not input) - (mapc #'delete-overlay overlays) - (goto-char pt-orig)) - ((equal input "") - (consult-focus-lines 'show) - (goto-char pt-orig)) - (t - ;; Sucessfully terminated -> Remember invisible overlays - (setq consult--focus-lines-overlays - (nconc consult--focus-lines-overlays overlays)) - ;; move point past invisible - (goto-char (if-let (ov (and (invisible-p pt-orig) - (seq-find (lambda (ov) (overlay-get ov 'invisible)) - (overlays-at pt-orig)))) - (overlay-end ov) - pt-orig)))))))) - -;;;###autoload -(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. - -FILTER is the filter function. -INITIAL is the initial input." - (interactive - (list current-prefix-arg - (lambda (pattern cands) - ;; Use consult-location completion category when filtering lines - (consult--completion-filter-dispatch - pattern cands 'consult-location nil)))) - (if show - (progn - (mapc #'delete-overlay consult--focus-lines-overlays) - (setq consult--focus-lines-overlays nil) - (message "All lines revealed")) - (consult--forbid-minibuffer) - (consult--with-increased-gc - (consult--prompt - :prompt - (if consult--focus-lines-overlays - "Focus on lines (RET to reveal): " - "Focus on lines: ") - :initial initial - :history 'consult--keep-lines-history - :state (consult--focus-lines-state filter))))) - -;;;;; Command: consult-goto-line - -(defun consult--goto-line-position (str msg) - "Transform input STR to line number. -Print an error message with MSG function." - (if-let (line (and str - (string-match-p "\\`[[:digit:]]+\\'" str) - (string-to-number str))) - (let ((pos (save-excursion - (save-restriction - (when consult-line-numbers-widen - (widen)) - (goto-char (point-min)) - (forward-line (1- line)) - (point))))) - (if (consult--in-range-p pos) - pos - (funcall msg "Line number out of range.") - nil)) - (when (and str (not (string= str ""))) - (funcall msg "Please enter a number.")) - nil)) - -;;;###autoload -(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 -narrowing and the settings `consult-goto-line-numbers' and -`consult-line-numbers-widen'." - (interactive "P") - (if arg - (call-interactively #'goto-line) - (consult--forbid-minibuffer) - (consult--local-let ((display-line-numbers consult-goto-line-numbers) - (display-line-numbers-widen consult-line-numbers-widen)) - (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) - :state - (let ((preview (consult--jump-preview))) - (lambda (action str) - (funcall preview action - (consult--goto-line-position str #'ignore))))) - #'minibuffer-message)) - (consult--jump pos) - t))))) - -;;;;; Command: consult-recent-file - -(defun consult--file-preview () - "Create preview function for files." - (let ((open (consult--temporary-files)) - (preview (consult--buffer-preview))) - (lambda (action cand) - (unless cand - (funcall open)) - (funcall preview action - (and cand - (eq action 'preview) - (funcall open cand)))))) - -(defun consult--file-action (file) - "Open FILE via `consult--buffer-action'." - (consult--buffer-action (find-file-noselect file))) - -(consult--define-state file) - -;;;###autoload -(defun consult-recent-file () - "Find recent file using `completing-read'." - (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"))) - :prompt "Find recent file: " - :sort nil - :require-match t - :category 'file - :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) - "Return name part of MODE." - (replace-regexp-in-string - "global-\\(.*\\)-mode" "\\1" - (replace-regexp-in-string - "\\(-global\\)?-mode\\'" "" - (if (eq mode 'c-mode) - "cc" - (symbol-name mode)) - 'fixedcase) - 'fixedcase)) - -(defun consult--mode-command-candidates (modes) - "Extract commands from MODES. - -The list of features is searched for files belonging to the modes. -From these files, the commands are extracted." - (let* ((buffer (current-buffer)) - (command-filter (consult--regexp-filter (seq-filter #'stringp consult-mode-command-filter))) - (feature-filter (seq-filter #'symbolp consult-mode-command-filter)) - (minor-hash (consult--string-hash minor-mode-list)) - (minor-local-modes (seq-filter (lambda (m) - (and (gethash m minor-hash) - (local-variable-if-set-p m))) - modes)) - (minor-global-modes (seq-filter (lambda (m) - (and (gethash m minor-hash) - (not (local-variable-if-set-p m)))) - modes)) - (major-modes (seq-remove (lambda (m) - (gethash m minor-hash)) - modes)) - (major-paths-hash (consult--string-hash (mapcar #'symbol-file major-modes))) - (minor-local-paths-hash (consult--string-hash (mapcar #'symbol-file minor-local-modes))) - (minor-global-paths-hash (consult--string-hash (mapcar #'symbol-file minor-global-modes))) - (major-name-regexp (regexp-opt (mapcar #'consult--mode-name major-modes))) - (minor-local-name-regexp (regexp-opt (mapcar #'consult--mode-name minor-local-modes))) - (minor-global-name-regexp (regexp-opt (mapcar #'consult--mode-name minor-global-modes))) - (commands)) - (dolist (feature load-history commands) - (when-let (name (alist-get 'provide feature)) - (let* ((path (car feature)) - (file (file-name-nondirectory path)) - (key (cond - ((memq name feature-filter) nil) - ((or (gethash path major-paths-hash) - (string-match-p major-name-regexp file)) - ?m) - ((or (gethash path minor-local-paths-hash) - (string-match-p minor-local-name-regexp file)) - ?l) - ((or (gethash path minor-global-paths-hash) - (string-match-p minor-global-name-regexp file)) - ?g)))) - (when key - (dolist (cmd (cdr feature)) - (let ((sym (cdr-safe cmd))) - (when (and (consp cmd) - (eq (car cmd) 'defun) - (commandp sym) - (not (get sym 'byte-obsolete-info)) - ;; Emacs 28 has a `read-extended-command-predicate' - (if (bound-and-true-p read-extended-command-predicate) - (funcall read-extended-command-predicate sym buffer) - t)) - (let ((name (symbol-name sym))) - (unless (string-match-p command-filter name) - (push (propertize name - 'consult--candidate sym - 'consult--type key) - commands)))))))))))) - -;;;###autoload -(defun consult-mode-command (&rest modes) - "Run a command from any of the given MODES. - -If no MODES are specified, use currently active major and minor modes." - (interactive) - (unless modes - (setq modes (cons major-mode - (seq-filter (lambda (m) - (and (boundp m) (symbol-value m))) - minor-mode-list)))) - (let ((narrow `((?m . ,(format "Major: %s" major-mode)) - (?l . "Local Minor") - (?g . "Global Minor")))) - (command-execute - (consult--read - (consult--mode-command-candidates modes) - :prompt "Mode command: " - :predicate - (lambda (cand) - (let ((key (get-text-property 0 'consult--type cand))) - (if consult--narrow - (= key consult--narrow) - (/= key ?g)))) - :lookup #'consult--lookup-candidate - :group (consult--type-group narrow) - :narrow narrow - :require-match t - :history 'extended-command-history - :category 'command)))) - -;;;;; Command: consult-yank - -(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 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. - (consult--lookup-member - (consult--read - (consult--remove-dups - (or kill-ring (user-error "Kill ring is empty"))) - :prompt "Yank from kill-ring: " - :history t ;; disable history - :sort nil - :category 'kill-ring - :require-match t - :state - (consult--insertion-preview - (point) - ;; If previous command is yank, hide previously yanked string - (or (and (eq last-command 'yank) (mark t)) (point)))) - kill-ring)) - -;; Adapted from the Emacs `yank-from-kill-ring' function. -;;;###autoload -(defun consult-yank-from-kill-ring (string &optional arg) - "Select STRING from the kill ring and insert it. -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 -version supports preview of the selected string." - (interactive (list (consult--read-from-kill-ring) current-prefix-arg)) - (when string - (setq yank-window-start (window-start)) - (push-mark) - (insert-for-yank string) - (setq this-command 'yank) - (when (consp arg) - ;; Swap point and mark like in `yank'. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) (current-buffer))))))) - -(put 'consult-yank-replace 'delete-selection 'yank) -(put 'consult-yank-pop 'delete-selection 'yank) -(put 'consult-yank-from-kill-ring 'delete-selection 'yank) - -;;;###autoload -(defun consult-yank-pop (&optional arg) - "If there is a recent yank act like `yank-pop'. - -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 -version supports preview of the selected string." - (interactive "*p") - (if (eq last-command 'yank) - (yank-pop (or arg 1)) - (call-interactively #'consult-yank-from-kill-ring))) - -;; Adapted from the Emacs yank-pop function. -;;;###autoload -(defun consult-yank-replace (string) - "Select STRING from the kill ring. - -If there was no recent yank, insert the string. -Otherwise replace the just-yanked string with the selected string. - -There exists no equivalent of this command in Emacs 28." - (interactive (list (consult--read-from-kill-ring))) - (when string - (if (not (eq last-command 'yank)) - (consult-yank-from-kill-ring string) - (let ((inhibit-read-only t) - (pt (point)) - (mk (mark t))) - (setq this-command 'yank) - (funcall (or yank-undo-function 'delete-region) (min pt mk) (max pt mk)) - (setq yank-undo-function nil) - (set-marker (mark-marker) pt (current-buffer)) - (insert-for-yank string) - (set-window-start (selected-window) yank-window-start t) - (if (< pt mk) - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) (current-buffer))))))))) - -;;;;; Command: consult-bookmark - -(defun consult--bookmark-preview () - "Create preview function for bookmarks." - (let ((preview (consult--jump-preview)) - (open (consult--temporary-files))) - (lambda (action cand) - (unless cand - (funcall open)) - (funcall - preview action - (when-let (bm (and cand (eq action 'preview) (assoc cand bookmark-alist))) - (let ((handler (or (bookmark-get-handler bm) #'bookmark-default-handler))) - ;; Only preview bookmarks with the default handler. - (if-let* ((file (and (eq handler #'bookmark-default-handler) - (bookmark-get-filename bm))) - (pos (bookmark-get-position bm)) - (buf (funcall open file))) - (set-marker (make-marker) pos buf) - (message "No preview for %s" handler) - nil))))))) - -(defun consult--bookmark-action (bm) - "Open BM via `consult--buffer-action'." - (bookmark-jump bm consult--buffer-display)) - -(consult--define-state bookmark) - -(defun consult--bookmark-candidates () - "Return bookmark candidates." - (bookmark-maybe-load-default-file) - (let ((narrow (mapcar (pcase-lambda (`(,y ,_ ,x)) (cons x y)) - consult-bookmark-narrow))) - (mapcar (lambda (cand) - (propertize (car cand) - 'consult--type - (alist-get - (or (bookmark-get-handler cand) #'bookmark-default-handler) - narrow))) - bookmark-alist))) - -;;;###autoload -(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 -variable `consult-bookmark-narrow' for the narrowing configuration." - (interactive - (list - (let ((narrow (mapcar (pcase-lambda (`(,x ,y ,_)) (cons x y)) - consult-bookmark-narrow))) - (consult--read - (consult--bookmark-candidates) - :prompt "Bookmark: " - :state (consult--bookmark-preview) - :category 'bookmark - :history 'bookmark-history - ;; Add default names to future history. - ;; Ignore errors such that `consult-bookmark' can be used in - ;; buffers which are not backed by a file. - :add-history (ignore-errors (bookmark-prop-get (bookmark-make-record) 'defaults)) - :group (consult--type-group narrow) - :narrow (consult--type-narrow narrow))))) - (bookmark-maybe-load-default-file) - (if (assoc name bookmark-alist) - (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 -(defun consult-complex-command () - "Select and evaluate command from the command history. - -This command can act as a drop-in replacement for `repeat-complex-command'." - (interactive) - (let* ((history (or (delete-dups (mapcar #'prin1-to-string command-history)) - (user-error "There are no previous complex commands"))) - (cmd (read (consult--read - history - :prompt "Command: " - :default (car history) - :sort nil - :history t ;; disable history - :category 'expression)))) - ;; Taken from `repeat-complex-command' - (add-to-history 'command-history cmd) - (apply #'funcall-interactively - (car cmd) - (mapcar (lambda (e) (eval e t)) (cdr cmd))))) - -;;;;; Command: consult-history - -(declare-function ring-elements "ring") -(defun consult--current-history (&optional history) - "Return the normalized HISTORY or the history relevant to the current buffer. - -If the minibuffer is active, returns the minibuffer history, -otherwise the history corresponding to the mode is returned. -There is a special case for `repeat-complex-command', -for which the command history is used." - (cond - (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-:"! - ((eq last-command 'repeat-complex-command) - (setq history (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) - (if (eq minibuffer-history-variable t) - (user-error "Minibuffer history is disabled for `%s'" this-command) - (setq history (symbol-value minibuffer-history-variable)))) - ;; Otherwise we use a mode-specific history, see `consult-mode-histories'. - (t (when-let (found - (or (seq-find (lambda (ring) - (and (derived-mode-p (car ring)) - (boundp (cdr ring)))) - consult-mode-histories) - (user-error - "No history configured for `%s', see `consult-mode-histories'" - major-mode))) - (setq history (symbol-value (cdr found)))))) - (consult--remove-dups (if (ring-p history) (ring-elements history) history))) - -;; This command has been adopted from https://github.com/oantolin/completing-history/. -;;;###autoload -(defun consult-history (&optional history) - "Insert string from HISTORY of current buffer. - -In order to select from a specific HISTORY, pass the history variable -as argument." - (interactive) - (let ((str (consult--local-let ((enable-recursive-minibuffers t)) - (consult--read - (or (consult--current-history history) - (user-error "History is empty")) - :prompt "History: " - :history t ;; disable history - :category ;; Report command category for M-x history - (and (minibufferp) - (eq minibuffer-history-variable 'extended-command-history) - 'command) - :sort nil - :state (consult--insertion-preview (point) (point)))))) - (when (minibufferp) - (delete-minibuffer-contents)) - (insert (substring-no-properties str)))) - -;;;;; Command: consult-isearch-history - -(defun consult-isearch-forward (&optional reverse) - "Continue isearch forward optionally in REVERSE." - (interactive) - (consult--require-minibuffer) - (setq isearch-new-forward (not reverse) isearch-new-nonincremental nil) - (funcall (or (command-remapping #'exit-minibuffer) #'exit-minibuffer))) - -(defun consult-isearch-backward (&optional reverse) - "Continue isearch backward optionally in REVERSE." - (interactive) - (consult-isearch-forward (not reverse))) - -;; Emacs 28: hide in M-X -(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'.") - -(defun consult--isearch-history-candidates () - "Return isearch history candidates." - ;; NOTE: Do not throw an error on empty history, - ;; in order to allow starting a search. - ;; We do not :require-match here! - (let ((history (if (eq t search-default-mode) - (append regexp-search-ring search-ring) - (append search-ring regexp-search-ring)))) - (cons - (delete-dups - (mapcar - (lambda (cand) - ;; The search type can be distinguished via text properties. - (let* ((props (plist-member (text-properties-at 0 cand) - 'isearch-regexp-function)) - (type (pcase (cadr props) - ((and 'nil (guard (not props))) ?r) - ('nil ?l) - ('word-search-regexp ?w) - ('isearch-symbol-regexp ?s) - ('char-fold-to-regexp ?c) - (_ ?u)))) - ;; Disambiguate history items. The same string could - ;; occur with different search types. - (consult--tofu-append cand type))) - history)) - (if history - (+ 4 (apply #'max (mapcar #'length history))) - 0)))) - -(defconst consult--isearch-history-narrow - '((?c . "Char") - (?u . "Custom") - (?l . "Literal") - (?r . "Regexp") - (?s . "Symbol") - (?w . "Word"))) - -;;;###autoload -(defun consult-isearch-history () - "Read a search string with completion from the Isearch history. - -This replaces the current search string if Isearch is active, and -starts a new Isearch session otherwise." - (interactive) - (consult--forbid-minibuffer) - (let* ((isearch-message-function 'ignore) ;; Avoid flicker in echo area - (inhibit-redisplay t) ;; Avoid flicker in mode line - (candidates (consult--isearch-history-candidates)) - (align (propertize " " 'display `(space :align-to (+ left ,(cdr candidates)))))) - (unless isearch-mode (isearch-mode t)) - (with-isearch-suspended - (setq isearch-new-string - (consult--read - (car candidates) - :prompt "I-search: " - :category 'consult-isearch - :history t ;; disable history - :sort nil - :initial isearch-string - :keymap consult-isearch-history-map - :annotate - (lambda (cand) - (concat align (alist-get (consult--tofu-get cand) consult--isearch-history-narrow))) - :group - (lambda (cand transform) - (if transform - cand - (alist-get (consult--tofu-get cand) consult--isearch-history-narrow))) - :lookup - (lambda (selected candidates &rest _) - (if-let (found (member selected candidates)) - (substring (car found) 0 -1) - selected)) - :state - (lambda (action cand) - (when (and (eq action 'preview) cand) - (setq isearch-string cand) - (isearch-update-from-string-properties cand) - (isearch-update))) - :narrow - (list :predicate - (lambda (cand) (= (consult--tofu-get cand) consult--narrow)) - :keys consult--isearch-history-narrow)) - isearch-new-message - (mapconcat 'isearch-text-char-description isearch-new-string ""))) - ;; Setting `isearch-regexp' etc only works outside of `with-isearch-suspended'. - (unless (plist-member (text-properties-at 0 isearch-string) 'isearch-regexp-function) - (setq isearch-regexp t - isearch-regexp-function nil)))) - -;;;;; Command: consult-minor-mode-menu - -(defun consult--minor-mode-candidates () - "Return list of minor-mode candidate strings." - (mapcar - (pcase-lambda (`(,name . ,sym)) - (propertize - name - 'consult--candidate sym - 'consult--minor-mode-narrow - (logior - (lsh (if (local-variable-if-set-p sym) ?l ?g) 8) - (if (and (boundp sym) (symbol-value sym)) ?i ?o)) - 'consult--minor-mode-group - (concat - (if (local-variable-if-set-p sym) "Local " "Global ") - (if (and (boundp sym) (symbol-value sym)) "On" "Off")))) - (nconc - ;; according to describe-minor-mode-completion-table-for-symbol - ;; the minor-mode-list contains *all* minor modes - (mapcar (lambda (sym) (cons (symbol-name sym) sym)) minor-mode-list) - ;; take the lighters from minor-mode-alist - (delq nil - (mapcar (pcase-lambda (`(,sym ,lighter)) - (when (and lighter (not (equal "" lighter))) - (setq lighter (string-trim (format-mode-line lighter))) - (unless (string-blank-p lighter) - (cons lighter sym)))) - minor-mode-alist))))) - -(defconst consult--minor-mode-menu-narrow - '((?l . "Local") - (?g . "Global") - (?i . "On") - (?o . "Off"))) - -;;;###autoload -(defun consult-minor-mode-menu () - "Enable or disable minor mode. - -This is an alternative to `minor-mode-menu-from-indicator'." - (interactive) - (call-interactively - (consult--read - (consult--minor-mode-candidates) - :prompt "Minor mode: " - :require-match t - :category 'minor-mode - :group - (lambda (cand transform) - (if transform cand (get-text-property 0 'consult--minor-mode-group cand))) - :narrow - (list :predicate - (lambda (cand) - (let ((narrow (get-text-property 0 'consult--minor-mode-narrow cand))) - (or (= (logand narrow 255) consult--narrow) - (= (lsh narrow -8) consult--narrow)))) - :keys - consult--minor-mode-menu-narrow) - :lookup #'consult--lookup-candidate - :history 'consult--minor-mode-menu-history))) - -;;;;; Command: consult-theme - -;;;###autoload -(defun consult-theme (theme) - "Disable current themes and enable THEME from `consult-themes'. - -The command supports previewing the currently selected theme." - (interactive - (list - (let ((avail-themes - (seq-filter (lambda (x) (or (not consult-themes) - (memq x consult-themes))) - (cons 'default (custom-available-themes)))) - (saved-theme - (car custom-enabled-themes))) - (consult--read - (mapcar #'symbol-name avail-themes) - :prompt "Theme: " - :require-match t - :category 'theme - :history 'consult--theme-history - :lookup (lambda (selected &rest _) - (setq selected (and selected (intern-soft selected))) - (or (and selected (car (memq selected avail-themes))) - saved-theme)) - :state (lambda (action theme) - (pcase action - ('return (consult-theme (or theme saved-theme))) - ((and 'preview (guard theme)) (consult-theme theme)))) - :default (symbol-name (or saved-theme 'default)))))) - (when (eq theme 'default) (setq theme nil)) - (unless (eq theme (car custom-enabled-themes)) - (mapc #'disable-theme custom-enabled-themes) - (when theme - (if (custom-theme-p theme) - (enable-theme theme) - (load-theme theme :no-confirm))))) - -;;;;; Command: consult-buffer - -(defun consult--buffer-sort-alpha (buffers) - "Sort BUFFERS alphabetically, but push down starred buffers." - (sort buffers - (lambda (x y) - (setq x (buffer-name x) y (buffer-name y)) - (let ((a (and (> (length x) 0) (eq (aref x 0) ?*))) - (b (and (> (length y) 0) (eq (aref y 0) ?*)))) - (if (eq a b) - (string< x y) - (not a)))))) - -(defun consult--buffer-sort-visibility (buffers) - "Sort BUFFERS by visibility." - (let ((hidden) - (current (current-buffer))) - (consult--keep! buffers - (unless (eq it current) - (if (get-buffer-window it 'visible) - it - (push it hidden) - nil))) - (nconc (nreverse hidden) buffers (list (current-buffer))))) - -(defun consult--normalize-directory (dir) - "Normalize directory DIR. -DIR can be project, nil or a path." - (cond - ((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. -PROMPT is the prompt format string. -QUERY is passed to `consult--buffer-query'." - (let* ((dir (plist-get query :directory)) - (ndir (consult--normalize-directory dir)) - (buffers (apply #'consult--buffer-query :directory ndir query)) - (count (length buffers))) - (cons (format "%s (%d buffer%s%s): " prompt count - (if (= count 1) "" "s") - (cond - ((and ndir (eq dir 'project)) - (format ", Project %s" (consult--project-name ndir))) - (ndir (concat ", " (consult--abbreviate-directory ndir))) - (t ""))) - buffers))) - -(cl-defun consult--buffer-query (&key sort directory mode as predicate (filter t) - include (exclude consult-buffer-filter)) - "Buffer query function. -DIRECTORY can either be project or a path. -SORT can be visibility, alpha or nil. -FILTER can be either t, nil or invert. -EXCLUDE is a list of regexps. -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 - ;; function supports filtering by various criteria which are used throughout - ;; Consult. - (let ((root (consult--normalize-directory directory)) - (buffers (buffer-list))) - (when sort - (setq buffers (funcall (intern (format "consult--buffer-sort-%s" sort)) buffers))) - (when (or filter mode as root) - (let ((mode (consult--ensure-list mode)) - (exclude-re (consult--regexp-filter exclude)) - (include-re (consult--regexp-filter include))) - (consult--keep! buffers - (and - (or (not mode) - (apply #'provided-mode-derived-p - (buffer-local-value 'major-mode it) mode)) - (pcase-exhaustive filter - ('nil t) - ((or 't 'invert) - (eq (eq filter t) - (and - (or (not exclude) - (not (string-match-p exclude-re (buffer-name it)))) - (or (not include) - (not (not (string-match-p include-re (buffer-name it))))))))) - (or (not root) - (when-let (dir (buffer-local-value 'default-directory it)) - (string-prefix-p root - (if (and (/= 0 (length dir)) (eq (aref dir 0) ?/)) - dir - (expand-file-name dir))))) - (or (not predicate) (funcall predicate it)) - (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))) - -(defun consult--buffer-preview () - "Buffer preview function." - ;; Only preview in current window and other window. - ;; Preview in frames and tabs is not possible since these don't get cleaned up. - (if (memq consult--buffer-display - '(switch-to-buffer switch-to-buffer-other-window)) - (let ((orig-buf (current-buffer)) other-win) - (lambda (action cand) - (when (eq action 'preview) - (when (and (eq consult--buffer-display #'switch-to-buffer-other-window) - (not other-win)) - (switch-to-buffer-other-window orig-buf) - (setq other-win (selected-window))) - (let ((win (or other-win (selected-window)))) - (when (window-live-p win) - (with-selected-window win - (cond - ((and cand (get-buffer cand)) - (switch-to-buffer cand 'norecord)) - ((buffer-live-p orig-buf) - (switch-to-buffer orig-buf 'norecord))))))))) - #'ignore)) - -(defun consult--buffer-action (buffer &optional norecord) - "Switch to BUFFER via `consult--buffer-display' function. -If NORECORD is non-nil, do not record the buffer switch in the buffer list." - (funcall consult--buffer-display buffer norecord)) - -(consult--define-state buffer) - -(defvar consult--source-bookmark - `(:name "Bookmark" - :narrow ?m - :category bookmark - :face consult-bookmark - :history bookmark-history - :items ,#'bookmark-all-names - :state ,#'consult--bookmark-state) - "Bookmark candidate source for `consult-buffer'.") - -(defvar consult--source-project-buffer - `(:name "Project Buffer" - :narrow (?p . "Project") - :hidden t - :category buffer - :face consult-buffer - :history buffer-name-history - :state ,#'consult--buffer-state - :enabled ,(lambda () consult-project-function) - :items - ,(lambda () - (when-let (root (consult--project-root)) - (consult--buffer-query :sort 'visibility - :directory root - :as #'buffer-name)))) - "Project buffer candidate source for `consult-buffer'.") - -(defvar consult--source-project-recent-file - `(:name "Project File" - :narrow (?p . "Project") - :hidden t - :category file - :face consult-file - :history file-name-history - :state ,#'consult--file-state - :new - ,(lambda (file) - (consult--file-action - (expand-file-name file (consult--project-root)))) - :enabled - ,(lambda () - (and consult-project-function - recentf-mode)) - :items - ,(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)))))) - "Project file candidate source for `consult-buffer'.") - -(defvar consult--source-hidden-buffer - `(:name "Hidden Buffer" - :narrow 32 - :hidden t - :category buffer - :face consult-buffer - :history buffer-name-history - :action ,#'consult--buffer-action - :items - ,(lambda () (consult--buffer-query :sort 'visibility - :filter 'invert - :as #'buffer-name))) - "Hidden buffer candidate source for `consult-buffer'.") - -(defvar consult--source-buffer - `(:name "Buffer" - :narrow ?b - :category buffer - :face consult-buffer - :history buffer-name-history - :state ,#'consult--buffer-state - :default t - :items - ,(lambda () (consult--buffer-query :sort 'visibility - :as #'buffer-name))) - "Buffer candidate source for `consult-buffer'.") - -(defvar consult--source-recent-file - `(:name "File" - :narrow ?f - :category file - :face consult-file - :history file-name-history - :state ,#'consult--file-state - :new ,#'consult--file-action - :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))))) - "Recent file candidate source for `consult-buffer'.") - -;;;###autoload -(defun consult-buffer (&optional sources) - "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), -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 -configuration of the virtual buffer sources." - (interactive) - (let ((selected (consult--multi (or sources consult-buffer-sources) - :require-match - (confirm-nonexistent-file-or-buffer) - :prompt "Switch to: " - :history 'consult--buffer-history - :sort nil))) - ;; For non-matching candidates, fall back to buffer creation. - (unless (plist-get (cdr selected) :match) - (consult--buffer-action (car selected))))) - -;; Populate `consult-project-buffer-sources'. -(setq consult-project-buffer-sources - (list - `(:hidden nil :narrow ?b ,@consult--source-project-buffer) - `(:hidden nil :narrow ?f ,@consult--source-project-recent-file))) - -(defmacro consult--with-project (&rest body) - "Ensure that BODY is executed with a project root." - ;; We have to work quite hard here to ensure that the project root is - ;; only overriden at the current recursion level. When entering a - ;; recursive minibuffer session, we should be able to still switch the - ;; project. But who does that? Working on the first level on project A - ;; and on the second level on project B and on the third level on project C? - ;; You mustn't be afraid to dream a little bigger, darling. - `(let ((consult-project-function - (let ((root (or (consult--project-root t) (user-error "No project found"))) - (depth (recursion-depth)) - (orig consult-project-function)) - (lambda (may-prompt) - (if (= depth (recursion-depth)) - root - (funcall orig may-prompt)))))) - ,@body)) - -;;;###autoload -(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." - (interactive) - (consult--with-project - (consult-buffer consult-project-buffer-sources))) - -;;;###autoload -(defun consult-buffer-other-window () - "Variant of `consult-buffer' which opens in other window." - (interactive) - (let ((consult--buffer-display #'switch-to-buffer-other-window)) - (consult-buffer))) - -;;;###autoload -(defun consult-buffer-other-frame () - "Variant of `consult-buffer' which opens in other frame." - (interactive) - (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)) - (lambda (action) - (cond - ((stringp action) - (setq highlight (plist-get (funcall builder action) :highlight)) - (funcall async action)) - ((consp action) - (let (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)) - (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) - (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)) - (push str result))))) - (funcall async (nreverse result)))) - (t (funcall async action)))))) - -(defun consult--grep-position (cand &optional find-file) - "Return the grep position marker for CAND. -FIND-FILE is the file open function, defaulting to `find-file'." - (when cand - (let* ((file-end (next-single-property-change 0 'face cand)) - (line-end (next-single-property-change (+ 1 file-end) 'face cand)) - (col (next-single-property-change (+ 1 line-end) 'face cand)) - (file (substring-no-properties cand 0 file-end)) - (line (string-to-number (substring-no-properties cand (+ 1 file-end) line-end)))) - (setq col (if col (- col line-end 1) 0)) - (consult--position-marker - (funcall (or find-file #'find-file) file) - line col)))) - -(defun consult--grep-state () - "Grep state function." - (let ((open (consult--temporary-files)) - (jump (consult--jump-state))) - (lambda (action cand) - (unless cand - (funcall open)) - (funcall jump action (consult--grep-position - cand - (and (not (eq action 'exit)) 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 (prompt builder dir initial) - "Run grep in DIR. - -BUILDER is the command builder. -PROMPT is the prompt string. -INITIAL is inital input." - (let* ((prompt-dir (consult--directory-prompt prompt dir)) - (default-directory (cdr prompt-dir))) - (consult--read - (consult--async-command builder - (consult--grep-format builder) - :file-handler t) ;; allow tramp - :prompt (car prompt-dir) - :lookup #'consult--lookup-member - :state (consult--grep-state) - :initial (consult--async-split-initial initial) - :add-history (consult--async-split-thingatpt 'symbol) - :require-match t - :category 'consult-grep - :group #'consult--grep-group - :history '(:input consult--grep-history) - :sort nil))) - -(defun consult--grep-lookahead-p (&rest cmd) - "Return t if grep CMD supports lookahead." - (with-temp-buffer - (insert "xaxbx") - (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-regexp-type (cmd) - "Return regexp type supported by grep CMD." - (or consult--grep-regexp-type - (setq consult--grep-regexp-type - (if (consult--grep-lookahead-p cmd "-P") 'pcre 'extended)))) - -(defun consult--grep-builder (input) - "Build command line given INPUT." - (pcase-let* ((cmd (split-string-and-unquote consult-grep-args)) - (type (consult--grep-regexp-type (car cmd))) - (`(,arg . ,opts) (consult--command-split input)) - (`(,re . ,hl) (funcall consult--regexp-compiler arg type - (member "--ignore-case" cmd)))) - (when re - (list :command - (append cmd - (list (if (eq type 'pcre) "--perl-regexp" "--extended-regexp") - "-e" (consult--join-regexps re type)) - opts) - :highlight hl)))) - -;;;###autoload -(defun consult-grep (&optional dir initial) - "Search with `grep' for files in DIR where the content matches a regexp. - -The initial input is given by the INITIAL argument. - -The input string is split, the first part of the string (grep input) is -passed to the asynchronous grep process and the second part of the string is -passed to the completion-style filtering. - -The input string is split at a punctuation character, which is given as the -first character of the input string. The format is similar to Perl-style -regular expressions, e.g., /regexp/. Furthermore command line options can be -passed to grep, specified behind --. The overall prompt input has the form -`#async-input -- grep-opts#filter-string'. - -Note that the grep input string is transformed from Emacs regular expressions -to Posix regular expressions. Always enter Emacs regular expressions at the -prompt. `consult-grep' behaves like builtin Emacs search commands, e.g., -Isearch, which take Emacs regular expressions. Furthermore the asynchronous -input split into words, each word must match separately and in any order. See -`consult--regexp-compiler' for the inner workings. In order to disable -transformations of the grep input, adjust `consult--regexp-compiler' -accordingly. - -Here we give a few example inputs: - -#alpha beta : Search for alpha and beta in any order. -#alpha.*beta : Search for alpha before beta. -#\\(alpha\\|beta\\) : Search for alpha or beta (Note Emacs syntax!) -#word -- -C3 : Search for word, include 3 lines as context -#first#second : Search for first, quick filter for second. - -The symbol at point is added to the future history. If `consult-grep' -is called interactively with a prefix argument, the user can specify -the directory to search in. By default the project directory is used -if `consult-project-function' is defined and returns non-nil. -Otherwise the `default-directory' is searched." - (interactive "P") - (consult--grep "Grep" #'consult--grep-builder dir initial)) - -;;;;; Command: consult-git-grep - -(defun consult--git-grep-builder (input) - "Build command line given CONFIG and INPUT." - (pcase-let* ((cmd (split-string-and-unquote consult-git-grep-args)) - (`(,arg . ,opts) (consult--command-split input)) - (`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended - (member "--ignore-case" cmd)))) - (when re - (list :command - (append cmd - (cdr (mapcan (lambda (x) (list "--and" "-e" x)) re)) - opts) - :highlight hl)))) - -;;;###autoload -(defun consult-git-grep (&optional dir initial) - "Search with `git grep' for files in DIR where the content matches a regexp. -The initial input is given by the INITIAL argument. See `consult-grep' -for more details." - (interactive "P") - (consult--grep "Git-grep" #'consult--git-grep-builder dir initial)) - -;;;;; Command: consult-ripgrep - -(defvar consult--ripgrep-regexp-type nil) -(defun consult--ripgrep-regexp-type (cmd) - "Return regexp type supported by ripgrep CMD." - (or consult--ripgrep-regexp-type - (setq consult--ripgrep-regexp-type - (if (consult--grep-lookahead-p cmd "-P") 'pcre 'extended)))) - -(defun consult--ripgrep-builder (input) - "Build command line given INPUT." - (pcase-let* ((cmd (split-string-and-unquote consult-ripgrep-args)) - (type (consult--ripgrep-regexp-type (car cmd))) - (`(,arg . ,opts) (consult--command-split input)) - (`(,re . ,hl) (funcall consult--regexp-compiler arg type - (if (member "--smart-case" cmd) - (let ((case-fold-search nil)) - ;; Case insensitive if there are no uppercase letters - (not (string-match-p "[[:upper:]]" input))) - (member "--ignore-case" cmd))))) - (when re - (list :command - (append cmd - (and (eq type 'pcre) '("-P")) - (list "-e" (consult--join-regexps re type)) - opts) - :highlight hl)))) - -;;;###autoload -(defun consult-ripgrep (&optional dir initial) - "Search with `rg' for files in DIR where the content matches a regexp. -The initial input is given by the INITIAL argument. See `consult-grep' -for more details." - (interactive "P") - (consult--grep "Ripgrep" #'consult--ripgrep-builder dir initial)) - -;;;;; Command: consult-find - -(defun consult--find (prompt builder initial) - "Run find command in current directory. - -The function returns the selected file. -The filename at point is added to the future history. - -BUILDER is the command builder. -PROMPT is the prompt. -INITIAL is inital input." - (consult--read - (consult--async-command builder - (consult--async-map (lambda (x) (string-remove-prefix "./" x))) - (consult--async-highlight builder) - :file-handler t) ;; allow tramp - :prompt prompt - :sort nil - :require-match t - :initial (consult--async-split-initial initial) - :add-history (consult--async-split-thingatpt 'filename) - :category 'file - :history '(:input consult--find-history))) - -(defvar consult--find-regexp-type nil) -(defun consult--find-regexp-type (cmd) - "Return regexp type supported by find CMD." - (or consult--find-regexp-type - (setq consult--find-regexp-type - (if (eq 0 (call-process-shell-command - (concat cmd " -regextype emacs -version"))) - 'emacs 'basic)))) - -(defun consult--find-builder (input) - "Build command line given INPUT." - (pcase-let* ((cmd (split-string-and-unquote consult-find-args)) - (type (consult--find-regexp-type (car cmd))) - (`(,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)))) - -;;;###autoload -(defun consult-find (&optional dir initial) - "Search for files in DIR matching input regexp given INITIAL input. - -The find process is started asynchronously, similar to `consult-grep'. -See `consult-grep' for more details regarding the asynchronous search." - (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)))) - -;;;;; Command: consult-locate - -(defun consult--locate-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 (split-string-and-unquote consult-locate-args) - (list arg) opts) - :highlight (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 -details regarding the asynchronous search." - (interactive) - (find-file (consult--find "Locate: " #'consult--locate-builder initial))) - -;;;;; Command: consult-man - -(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 (split-string-and-unquote consult-man-args) - (list arg) opts) - :highlight (cdr (consult--default-regexp-compiler input 'basic t)))))) - -(defun consult--man-format (lines) - "Format man candidates from LINES." - (let ((candidates)) - (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))))) - (nreverse candidates))) - -;;;###autoload -(defun consult-man (&optional initial) - "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 -the asynchronous search." - (interactive) - (man (consult--read - (consult--async-command #'consult--man-builder - (consult--async-transform consult--man-format) - (consult--async-highlight #'consult--man-builder)) - :prompt "Manual entry: " - :require-match t - :lookup #'consult--lookup-cdr - :initial (consult--async-split-initial initial) - :add-history (consult--async-split-thingatpt 'symbol) - :history '(:input consult--man-history)))) - -;;;; Preview at point in completions buffers - -(define-minor-mode consult-preview-at-point-mode - "Preview minor mode for *Completions* buffers. -When moving around in the *Completions* buffer, the candidate at point is -automatically previewed." - :init-value nil :group 'consult - (if consult-preview-at-point-mode - (add-hook 'post-command-hook #'consult-preview-at-point nil 'local) - (remove-hook 'post-command-hook #'consult-preview-at-point 'local))) - -(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))) - (funcall fun))) - -;;;; Integration with the default completion system - -(defun consult--default-completion-mb-candidate () - "Return current minibuffer candidate from default completion system or Icomplete." - (when (and (minibufferp) - (eq completing-read-function #'completing-read-default)) - (let ((content (minibuffer-contents-no-properties))) - ;; When the current minibuffer content matches a candidate, return it! - (if (test-completion content - minibuffer-completion-table - minibuffer-completion-predicate) - content - ;; Return the full first candidate of the sorted completion list. - (when-let ((completions (completion-all-sorted-completions))) - (concat - (substring content 0 (or (cdr (last completions)) 0)) - (car completions))))))) - -(defun consult--default-completion-list-candidate () - "Return current candidate at point from completions buffer." - (let (beg end) - (when (and - (derived-mode-p 'completion-list-mode) - ;; Logic taken from `choose-completion'. - ;; TODO Upstream a `completion-list-get-candidate' function. - (cond - ((and (not (eobp)) (get-text-property (point) 'mouse-face)) - (setq end (point) beg (1+ (point)))) - ((and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) - (setq end (1- (point)) beg (point))))) - (setq beg (previous-single-property-change beg 'mouse-face) - end (or (next-single-property-change end 'mouse-face) (point-max))) - (or (get-text-property beg 'completion--string) - (buffer-substring-no-properties beg end))))) - -;; Announce now that consult has been loaded -(provide 'consult) - -;;;; Integration with other completion systems - -(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)) - -;;; consult.el ends here diff --git a/elpa/consult-0.19.signed b/elpa/consult-0.19.signed @@ -0,0 +1 @@ +Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-09-09T23:05:02+0200 using RSA +\ No newline at end of file diff --git a/elpa/consult-0.19/CHANGELOG.org b/elpa/consult-0.19/CHANGELOG.org @@ -0,0 +1,224 @@ +#+title: consult.el - Changelog +#+author: Daniel Mendler +#+language: en + +* Version 0.19 (2022-09-09) + +- Bugfixes +- Allow =consult-flymake= to work across all buffers in a project +- Remove deprecated =consult-completing-read-multiple= +- =consult-grep/git-grep/ripgrep=: Add =--fixed-strings= support +- =consult-grep=: Respect =grep-find-ignored-directories/files= +- =consult-org-heading=: Add tags to completion candidates +- Add =consult-preview-excluded-files= +- =consult-themes=: Support regexps + +* Version 0.18 (2022-05-25) + +- Bugfixes +- Removed obsolete =consult-recent-file-filter= and =consult-preview-excluded-hooks= +- Deprecate =consult-completing-read-multiple=. See #567 for details. +- Add =consult--source-modified-buffer= + +* Version 0.17 (2022-04-22) + +- Bugfixes +- Drop Emacs 26 support. +- =consult-goto-line=: Use =goto-line-history= on Emacs 28. +- =consult-customize=: Evaluate settings at runtime. This change makes it possible + to use =thing-at-point= to overwrite the =:initial= and =:add-history= settings. +- Rename =consult--read-config= to =consult--customize-alist= and change the format. + The configuration is an alist. The car must be a command symbol. The cdr must + be a plist of keys and expressions, where the expressions evaluate to the + actual configuration values. +- Mode hooks in previewed file buffers are delayed. The buffer is only fully + initialized when leaving the minibuffer for recursive editing. +- Increase =consult-preview-raw-size=. +- Replace =consult-preview-excluded-hooks= by =consult-preview-allowed-hooks=. +- Add =consult-preview-variables= to bind variables for file preview. +- BREAKING API CHANGE of =consult--read=, =consult--prompt=, =consult--multi=: The + state function protocol changed. The function gets notified of more completion + state changes. See the docstring of =consult--with-preview= for details. +- BREAKING API CHANGE of =consult--read=: The lookup function protocol changed. + The function must now accept four or more arguments. +- Remove unused =consult-preview-map=. +- Remove unnecessary =consult-recent-file-filter=. Use =recentf-exclude= instead. +- =consult--multi= sources can have a =:new= function to create candidates. + When narrowed to a source, new candidates will be created by calling the + respective =:new= function. +- =consult--multi= returns =:match= information. =:match= can be nil, t, or new, + depending on if the candidate does not exist, exists or has been created. +- =consult-locate= treats the input literally to take advantage of the db index. + +* Version 0.16 (2022-03-08) + +- Bug fixes +- Deprecate =consult-project-root-function= in favor of =consult-project-function=. +- Preconfigure =consult-project-function= with a default function based + on project.el. +- Add =consult-project-buffer=, a variant of =consult-buffer= restricted to the + current project. +- Add =consult-register-prefix= option. +- Introduced a generic and extensible =consult-register= implementation. +- Lazy marker creation in =consult-line/outline= (performance improvements) + +* Version 0.15 (2022-01-31) + +- Bugfixes +- =consult-xref=: Prettify the group titles, use =xref--group-name-for-display= + if available. +- =consult-focus-lines=: Thanks to @jdtsmith, the command is much faster and + actually useable in large files. +- Added Mct integration, auto refreshing of asynchronous Consult commands. + +* Version 0.14 (2021-12-31) + +- Bugfixes +- Add =consult-recent-file-filter= +- Rename =consult--source-(project-)file= to =consult-source-(project-)recent-file= +- =consult-keep-lines= makes read-only buffers temporarily writable if confirmed + +* Version 0.13 (2021-11-12) + +- Bugfixes +- =consult-register=: Add support for file register values. +- Rename =consult-isearch= to =consult-isearch-history=. The command is a history + browsing command and not a replacement for Isearch. +- =consult-grep= support -[ABC] grep options +- Add =consult-grep-context= face + +* Version 0.12 (2021-10-11) + +- Bugfixes +- Removed obsolete =consult-project-imenu= and =consult-x-command= variables +- =consult-grep=: Use ~--null~ argument to support file names with colons + +* Version 0.11 (2021-08-18) + +- Bugfixes only + +* Version 0.10 (2021-08-11) + +- =consult-mark=, =consult-global-mark=: Add optional marker list argument +- =consult-completing-read-multiple=: New function +- Rename =consult-project-imenu= to =consult-imenu-multi= +- Add =consult-line-multi= to search multiple buffers +- Removed obsolete =consult-yank=, =consult-async-default-split=, =consult-config= +- =consult-ripgrep=: Use =--smart-case= +- =consult-grep/git-grep=: Use =--ignore-case= +- Deprecate =consult-<cmd>-command= in favor of =consult-<cmd>-config.= +- =consult-find=: Use regular expressions instead of globbing/wildcards by default. + Due to the changes to =consult-find= it is not possible anymore to configure + =fd= as backend for =consult-find=. A replacement is documented in the wiki. +- =consult-find/locate/man=: Add highlighting to the matching file/man page names. +- =consult-grep/git-grep/ripgrep/find/locate=: Add support for multiple unordered + patterns. Each of the input patterns must be matched. For example, + =consult-find= transforms the input "first second third" to "first -and second + -and third". +- =consult-grep/git-grep/ripgrep=: Compute the highlighting based on the input, + instead of relying on the ANSI-escaped output. This works better with multiple + patterns, but may occasionally produce false highlighting. +- Deprecate =consult-x-command= configuration variables in favor of =consult-x-args=. + The variables have been renamed since the configuration format changed. +- =consult-async-split-styles-alist=: Remove the =space= splitting style, since + it has been obsoleted by the support for multiple unordered patterns. + +* Version 0.9 (2021-06-22) + +- Add =consult-preview-excluded-hooks= +- =consult--read/consult--prompt=: Add =:inherit-input-method= argument +- Add debouncing support for preview + +* Version 0.8 (2021-05-30) + +- Async commands: Do not fix vertical height in Selectrum. +- =consult-imenu=: Deduplicate items (some imenu backends generate duplicates). +- =consult-org-heading=: Deduplicate items. +- =consult-buffer-filter=: Hide more buffers. +- =consult-line=: Matching line preview overlay only in the selected window. +- =consult-yank/completion-in-region=: Insertion preview only in selected window. +- =consult-yank=: Rename to =consult-yank-from-kill-ring= (Emacs 28 naming). +- =consult-yank= commands: =delete-selection-mode= support, added properties. +- =consult-preview-at-point=, =consult-preview-at-point-mode=: New command and + minor mode to preview candidate at point in =*Completions*= buffer. +- Add =consult-async-split-style= and =consult-async-split-styles-alist=. +- =consult-async-default-split=: Obsoleted in favor of =consult-async-split-style=. +- Deprecate =consult-config= in favor of new =consult-customize= macro. +- =consult-buffer=: Enable previews for files and bookmarks by default. +- =consult-buffer=/=consult--multi=: Add support for =:preview-key= per source. +- =consult-buffer=: Push visible buffers down in the buffer list. +- =consult-flycheck=: Moved to separate repository prior to ELPA submission. +- Submitted Consult to ELPA. + +* Version 0.7 (2021-04-29) + +- Bugfixes +- =consult-buffer=: Respect =confirm-nonexistent-file-or-buffer= +- =consult-widen-key=: Change default setting to twice the =consult-narrow-key= +- =consult-flycheck=: Sort errors first +- Added support for the Vertico completion system +- Consult adds disambiguation suffixes as suffix instead of as prefix now + for the commands =consult-line=, =consult-buffer=, etc. + This enables support for the =basic= completion style and TAB completion. +- =consult--read=: The =:title= function must accept two arguments now, + the candidate string and a flag. If the flag is nil, the function should + return the title of the candidate, otherwise the function should return the + transformed candidate. +- =consult-grep= and related commands: Strip the file name if grouping is used. +- =consult-find/grep=: Ensure that the commands work with Tramp +- =consult-outline=: Add narrowing +- Added =consult-org-heading= and =consult-org-agenda= +- =consult-line=: Highlight visual line during jump preview +- =consult-line=: Start search at current line, add configuration variable + =consult-start-from-top=. The starting point can be toggled by the prefix + argument =C-u=. + +* Version 0.6 (2021-03-02) + +- Bugfixes +- =consult-keep/focus-lines=: Align behavior on regions with built-in =keep-lines=. +- =consult-buffer=: Enable file sources only when =recentf-mode= is enabled +- =consult--multi=: Add =:default= flag, use flag for =consult--source-buffer= +- Add =consult-grep-max-columns= to prevent performance issues for long lines +- Add =consult-fontify-preserve= customization variable +- =consult-line=: Quits Isearch, when started from an Isearch session +- =consult-register-load=: Align prefix argument handling with =insert-register= +- 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-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= + and =xref-show-definitions-function=. +- Added support for the candidate grouping function =x-group-function= + +* Version 0.5 (2021-02-09) + +- Bugfixes +- =consult-keep/focus-lines=: If region is active, operate only on the region. +- =consult-register-format=: Do not truncate register strings. +- =consult-buffer= multi sources: Ensure that original buffer is + shown, when the currently selected source does not perform preview. +- Add =consult-preview-raw-size= +- Expose preview functionality for multi-source bookmarks/files +- Multi sources: Add =:enabled=, =:state= and =:action= fields +- =consult-imenu=: Add faces depending on item types + +* Version 0.4 (2021-02-01) + +- Bugfixes +- Introduce multi sources, reimplement =consult-buffer= with multi sources +- =consult-isearch=: Add preview highlighting +- =consult-line=: Use =isearch-string= when invoked from running isearch + +* Version 0.3 (2021-01-28) + +- Bugfixes +- New command =consult-isearch= +- New functions =consult-register-format=, =consult-register-window=, + removed =consult-register-preview= + +* Version 0.2 (2021-01-16) + +- Initial stable release diff --git a/elpa/consult-0.19/LICENSE b/elpa/consult-0.19/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + 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 <http://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + <program> Copyright (C) <year> <name of author> + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +<http://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/elpa/consult-0.19/README-elpa b/elpa/consult-0.19/README-elpa @@ -0,0 +1,1540 @@ + ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ + CONSULT.EL - CONSULTING COMPLETING-READ + ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ + + +Table of Contents +───────────────── + +1. Available commands +.. 1. Virtual Buffers +.. 2. Editing +.. 3. Register +.. 4. Navigation +.. 5. Search +.. 6. Grep and Find +.. 7. Compilation +.. 8. Histories +.. 9. Modes +.. 10. Org Mode +.. 11. Miscellaneous +2. Special features +.. 1. Live previews +.. 2. Narrowing and grouping +.. 3. Asynchronous search +.. 4. Multiple sources +.. 5. Embark integration +3. Configuration +.. 1. Use-package example +.. 2. Custom variables +.. 3. Fine-tuning +4. Recommended packages +5. Bug reports +6. Contributions +7. Acknowledgments +8. Indices +.. 1. Function index +.. 2. Concept index + + +Consult provides practical commands based on the Emacs completion +function [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 +preview], [grouping and narrowing]. Please take a look at the [full list +of commands]. + +Consult is fully compatible with completion systems based on the +standard Emacs `completing-read' API, notably the default completion +system, [Vertico], [Mct], [Icomplete] and [Selectrum]. + +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 the main advantages of the package. Consult fits well +into existing setups and it helps you to create a full completion +environment out of small and independent components. Note that, if you +use [Ivy] or [Helm], you probably don't need Consult, since both +packages bring their own Consult-like functionality. + +You can combine the complementary packages [Marginalia], [Embark] and +[Orderless] with 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 selected candidate in the minibuffer +or at point in normal buffers. For example, when selecting from a list +of files, Embark offers an action to delete the file. Additionally +Embark offers a facility to collect completion candidates in a collect +buffer. The section [Embark integration] documents in greater detail how +Consult and Embark work together. + +Table of Contents +───────────────── + +1. Available commands +.. 1. Virtual Buffers +.. 2. Editing +.. 3. Register +.. 4. Navigation +.. 5. Search +.. 6. Grep and Find +.. 7. Compilation +.. 8. Histories +.. 9. Modes +.. 10. Org Mode +.. 11. Miscellaneous +2. Special features +.. 1. Live previews +.. 2. Narrowing and grouping +.. 3. Asynchronous search +.. 4. Multiple sources +.. 5. Embark integration +3. Configuration +.. 1. Use-package example +.. 2. Custom variables +.. 3. Fine-tuning +4. Recommended packages +5. Bug reports +6. Contributions +7. Acknowledgments +8. Indices +.. 1. Function index +.. 2. Concept index + + +[completing-read] +<https://www.gnu.org/software/emacs/manual/html_node/elisp/Minibuffer-Completion.html> + +[live preview] See section 2.1 + +[grouping and narrowing] See section 2.2 + +[full list of commands] See section 1 + +[Vertico] <https://github.com/minad/vertico> + +[Mct] <https://github.com/protesilaos/mct> + +[Icomplete] +<https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html> + +[Selectrum] <https://github.com/radian-software/selectrum> + +[Ivy] <https://github.com/abo-abo/swiper#ivy> + +[Helm] <https://github.com/emacs-helm/helm> + +[Marginalia] <https://github.com/minad/marginalia/> + +[Embark] <https://github.com/oantolin/embark/> + +[Orderless] <https://github.com/oantolin/orderless> + +[Embark integration] See section 2.5 + + +1 Available commands +════════════════════ + + Most Consult commands follow the meaningful naming scheme + `consult-<thing>'. Many commands implement a little known but + convenient Emacs feature called "future history", which guesses what + input the user wants. At a command prompt type `M-n' and typically + Consult will insert the symbol or thing at point into the input. + + *TIP:* If you have [Marginalia] annotators activated, type `M-x + ^consult' to see 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. + + +[Marginalia] <https://github.com/minad/marginalia> + +1.1 Virtual Buffers +─────────────────── + + • `consult-buffer' (`-other-window', `-other-frame'): Enhanced version + of `switch-to-buffer' with support for virtual buffers. Supports + live preview of buffers and narrowing to the virtual buffer + types. You can type `f SPC' in order to narrow to recent + files. Press `SPC' to show ephemeral buffers. Supported narrowing + keys: + • b Buffers + • SPC Hidden buffers + • * Modified buffers + • f Files (Requires `recentf-mode') + • m Bookmarks + • p Project + • Custom [other sources] configured in `consult-buffer-sources'. + • `consult-project-buffer': Variant of `consult-buffer' restricted to + buffers and recent files of the current project. You can add custom + sources to `consult-project-buffer-sources'. The command may prompt + you for a project if you invoke it from outside a project. + • `consult-bookmark': Select or create bookmark. To select bookmarks + you might use the `consult-buffer' as an alternative, which can + include a bookmark virtual buffer source. Note that + `consult-bookmark' supports preview of bookmarks and narrowing. + • `consult-recent-file': Select from recent files with preview. You + might prefer the powerful `consult-buffer' instead, which can + include recent files as a virtual buffer source. The `recentf-mode' + enables tracking of recent files. + + +[other sources] See section 2.4 + + +1.2 Editing +─────────── + + • `consult-yank-from-kill-ring': Enhanced version of `yank' to select + an item from the `kill-ring'. The selected text previewed as overlay + in the buffer. + • `consult-yank-pop': Enhanced version of `yank-pop' with + DWIM-behavior, which either replaces the last `yank' by cycling + through the `kill-ring', or if there has not been a last `yank' + consults the `kill-ring'. The selected text previewed as overlay in + the buffer. + • `consult-yank-replace': Like `consult-yank-pop', but always replaces + the last `yank' with an item from the `kill-ring'. + • `consult-kmacro': Select macro from the macro ring and execute it. + + +1.3 Register +──────────── + + • `consult-register': Select from list of registers. The command + supports narrowing to register types and preview of marker + positions. This command is useful to search the register + contents. For quick access use the commands `consult-register-load', + `consult-register-store' or the built-in Emacs register commands. + • `consult-register-format': Set `register-preview-function' to this + function for an enhanced register formatting. See the [example + configuration]. + • `consult-register-window': Replace `register-preview' with this + function for a better register window. See the [example + configuration]. + • `consult-register-load': Utility command to quickly load a register. + The command either jumps to the register value or inserts it. + • `consult-register-store': Improved UI to store registers depending + on the current context with an action menu. With an active region, + store/append/prepend the contents, optionally deleting the region + when a prefix argument is given. With a numeric prefix argument, + store/add the number. Otherwise store point, frameset, window or + kmacro. Usage examples: + ‣ `M-' x': If no region is active, store point in register `x'. If + a region is active, store the region in register `x'. + ‣ `M-' M-w x': Store window configuration in register `x'. + ‣ `C-u 100 M-' x': Store number in register `x'. + + +[example configuration] See section 3.1 + + +1.4 Navigation +────────────── + + • `consult-goto-line': Jump to line number enhanced with live preview. + This is a drop-in replacement for `goto-line'. + • `consult-mark': Jump to a marker in the `mark-ring'. Supports live + preview and recursive editing. + • `consult-global-mark': Jump to a marker in the `global-mark-ring'. + Supports live preview and recursive editing. + • `consult-outline': Jump to a heading of the outline. Supports + narrowing to a heading level, live preview and recursive editing. + • `consult-imenu': Jump to imenu item in the current buffer. Supports + live preview, recursive editing and narrowing. + • `consult-imenu-multi': Jump to imenu item in project buffers, with + the same major mode as the current buffer. Supports live preview, + recursive editing and narrowing. This feature has been inspired by + [imenu-anywhere]. + + +[imenu-anywhere] <https://github.com/vspinu/imenu-anywhere> + + +1.5 Search +────────── + + • `consult-line': Enter search string and select from matching lines. + Supports live preview and recursive editing. The symbol at point and + the 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-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 Embark collect buffer further, relying + on the same completion filtering as `completing-read'. If the input + begins with the negation operator, i.e., `! SPC', the filter matches + the complement. If a region is active, the region restricts the + filtering. + • `consult-focus-lines': Temporarily hide lines by filtering them + using the current completion style. Call with `C-u' prefix argument + in order to show the hidden lines again. If the input begins with + the negation operator, i.e., `! SPC', the filter matches the + complement. In contrast to `consult-keep-lines' this function does + not edit the buffer. If a region is active, the region restricts the + filtering. + + +1.6 Grep and Find +───────────────── + + • `consult-grep', `consult-ripgrep', `consult-git-grep': Search for + regular expression in files. Consult invokes Grep asynchronously, + while you enter the search term. After at least + `consult-async-min-input' characters, the search gets + started. Consult splits the input string into two parts, if the + first character is a punctuation character, like `#'. For example + `#regexps#filter-string', is split at the second `#'. The string + `regexps' is passed to Grep. Note that Consult transforms Emacs + regular expressions to expressions understand by the search + program. Always use Emacs regular expressions at the prompt. If you + enter multiple regular expressions separated by space only lines + matching all regular expressions are shown. In order to match space + literally, escape the space with a backslash. The `filter-string' is + passed to the /fast/ Emacs filtering to further narrow down the list + of matches. This is particularly useful if you are using an advanced + completion style like orderless. `consult-grep' supports preview. If + the `consult-project-function' returns non-nil, `consult-grep' + searches the current project directory. Otherwise the + `default-directory' is searched. If `consult-grep' is invoked with + prefix argument `C-u M-s g', you can specify the directory manually. + • `consult-find', `consult-locate': Find file by matching the path + against a regexp. Like for `consult-grep,' either the project root + or the current directory is the root directory for the search. The + input string is treated similarly to `consult-grep', where the first + part is passed to find, and the second part is used for Emacs + filtering. + + +1.7 Compilation +─────────────── + + • `consult-compile-error': Jump to a compilation error. Supports live + preview narrowing and recursive editing. + • `consult-flymake': Jump to flymake diagnostic. Supports live preview + and recursive editing. The command supports narrowing. Press `e + SPC', `w SPC', `n SPC' to only show errors, warnings and notes + respectively. + • `consult-xref': Integration with xref. This function can be set as + `xref-show-xrefs-function' and `xref-show-definitions-function'. + + +1.8 Histories +───────────── + + • `consult-complex-command': Select a command from the + `command-history'. This command is a `completing-read' version of + `repeat-complex-command' and is also a replacement for the + `command-history' command from chistory.el. + • `consult-history': Insert a string from the current buffer history, + for example the Eshell or Comint history. You can also invoke this + command from the minibuffer. In that case `consult-history' uses the + history stored in the `minibuffer-history-variable'. If you prefer + `completion-at-point', take a look at `cape-history' from the [Cape] + package. + • `consult-isearch-history': During an Isearch session, this command + picks a search string from history and continues the search with the + newly selected string. Outside of Isearch, the command allows you to + pick a string from the history and starts a new + Isearch. `consult-isearch-history' acts as a drop-in replacement for + `isearch-edit-string'. + + +[Cape] <https://github.com/minad/cape> + + +1.9 Modes +───────── + + • `consult-minor-mode-menu': Enable/disable minor mode. Supports + narrowing to on/off/local/global modes by pressing `i/o/l/g SPC' + respectively. + • `consult-mode-command': Run a command from the currently active + minor or major modes. Supports narrowing to + local-minor/global-minor/major mode via the keys `l/g/m'. + + +1.10 Org Mode +───────────── + + • `consult-org-heading': Similar to `consult-outline', for Org + buffers. Supports narrowing by heading level, priority and TODO + state, as well as live preview and recursive editing. + • `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. + + +1.11 Miscellaneous +────────────────── + + • `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 mode which previews the candidate at point in the + `*Completions*' buffer. This mode is relevant if you use [Mct] or + the default `*Completions*' UI. + • `consult-completion-in-region': In case you don't use [Corfu] as + your in-buffer completion UI, this function can be set as + `completion-in-region-function'. Then your minibuffer completion UI + (e.g., Vertico or Icomplete) will be used for + `completion-at-point'. Note that Selectrum provides its own variant + of `consult-completion-in-region'. If you use Mct, you may want to + try `mct-region-mode' instead. + ┌──── + │ ;; Use `consult-completion-in-region' if Vertico is enabled. + │ ;; Otherwise use the default `completion--in-region' function. + │ (setq completion-in-region-function + │ (lambda (&rest args) + │ (apply (if vertico-mode + │ #'consult-completion-in-region + │ #'completion--in-region) + │ args))) + └──── + 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 either the [Corfu] or the [Company] package. There is a + technical limitation of `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 minibuffer, the server does not receive the updated + input. LSP completion works with Corfu or Company though, which + perform the completion directly in the original buffer. + + +[Mct] <https://git.sr.ht/~protesilaos/mct> + +[Corfu] <https://github.com/minad/corfu> + +[Company] <https://github.com/company-mode/company-mode> + + +2 Special features +══════════════════ + + Consult enhances `completing-read' with live previews of candidates, + additional narrowing capabilities to candidate groups and + asynchronously generated candidate lists. The internal `consult--read' + function, which is used by most Consult commands, is a thin wrapper + around `completing-read' and provides the special functionality. In + order to support multiple candidate sources there exists the + high-level function `consult--multi'. The architecture of Consult + allows it to work with different completion systems in the backend, + while still offering advanced features. + + +2.1 Live previews +───────────────── + + Some Consult commands support live previews. For example when you + scroll through the items of `consult-line', the buffer will scroll to + the corresponding position. It is possible to jump back and forth + between the minibuffer and the buffer to perform recursive editing + while the search is ongoing. + + Consult enables previews by default. You can disable them by adjusting + the `consult-preview-key' variable. Furthermore it is possible to + specify keybindings which trigger the preview manually as shown in the + [example configuration]. The default setting of `consult-preview-key' + is `any' which means that Consult triggers the preview /immediately/ + on any key press when the selected candidate changes. You can + configure each command individually with its own `:preview-key'. The + 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-."))' + • Disabled `nil' + + A safe recommendation is to leave automatic immediate previews enabled + in general and disable the automatic preview only for commands where + the preview may be expensive due to file loading. Internally, Consult + uses the value of `this-command' to determine the `:preview-key' + customized. This means that if you wrap a `consult-*' command within + your own function or command, you will also need to add the name of + /your custom command/ to the `consult-customize' call in order for it + 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 + └──── + + In this case one may wonder what the difference is between using an + Embark action on the current candidate in comparison to a manually + triggered preview. The main difference is that the files opened by + manual preview are closed again after the completion + session. Furthermore during preview some functionality is disabled to + improve the performance, see for example the customization variables + `consult-preview-allowed-hooks' and `consult-preview-variables'. Files + larger than `consult-preview-raw-size' are previewed literally without + syntax highlighting and without changing the major mode. Delaying the + preview is also useful for `consult-theme', since the theme preview is + slow. The delay results in a smoother UI experience. + + ┌──── + │ ;; Preview on any key press, but delay 0.5s + │ (consult-customize consult-theme :preview-key '(:debounce 0.5 any)) + │ ;; 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)) + └──── + + +[example configuration] See section 3.1 + + +2.2 Narrowing and grouping +────────────────────────── + + Consult has special support for candidate groups. If the completion UI + supports the grouping functionality, the UI separates the groups with + thin lines and shows group titles. Grouping is useful if the list of + candidates consists of candidates of multiple types or candidates from + [multiple sources], like the `consult-buffer' command, which shows + both buffers and recently opened files. Note that you can disable the + group titles by setting the `:group' property of the corresponding + command to nil using the `consult-customize' macro. + + By entering a narrowing prefix or by pressing a narrowing key it is + possible to restrict the completion candidates to a certain candidate + group. When you use the `consult-buffer' command, you can enter the + prefix `b SPC' to restrict list of candidates to buffers only. If you + press `DEL' afterwards, the full candidate list will be shown + again. Furthermore a narrowing prefix key and a widening key can be + configured which can be pressed to achieve the same effect, see the + configuration variables `consult-narrow-key' and `consult-widen-key'. + + After pressing `consult-narrow-key', the possible narrowing keys can + be shown by pressing `C-h'. When pressing `C-h' after some prefix key, + the `prefix-help-command' 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 [example + configuration]. If [which-key] is installed, the narrowing keys are + automatically shown in the which-key window after pressing the + `consult-narrow-key'. + + +[multiple sources] See section 2.4 + +[example configuration] See section 3.1 + +[which-key] <https://github.com/justbur/emacs-which-key> + + +2.3 Asynchronous search +─────────────────────── + + Consult has support for asynchronous generation of candidate + lists. This feature is used for search commands like `consult-grep', + where the list of matches is generated dynamically while the user is + typing a regular expression. The grep process is executed in the + background. When modifying the regular expression, the background + process is terminated and a new process is started with the modified + regular expression. + + The matches, which have been found, can then be narrowed using the + installed Emacs completion-style. This can be powerful if you are + using for example the `orderless' completion style. + + This two-level filtering is possible by splitting the input + string. Part of the input string is treated as input to grep and part + of the input is used for filtering. There are multiple splitting + styles available, configured in `consult-async-split-styles-alist': + `nil', `comma', `semicolon' and `perl'. The default splitting style is + configured with the variable `consult-async-split-style'. + + With the `comma' and `semicolon' splitting styles, the first word + before the comma or semicolon is passed to grep, the remaining string + is used for filtering. The `nil' splitting style does not perform any + splitting, the whole input is passed to grep. + + The `perl' splitting style splits the input string at a punctuation + character, using a similar syntax as Perl regular expressions. + + Examples: + + • `#defun': Search for "defun" using grep. + • `#consult embark': Search for both "consult" and "embark" using grep + in any order. + • `#first.*second': Search for "first" followed by "second" using + grep. + • `#\(consult\|embark\)': Search for "consult" or "embark" using + grep. Note the usage of Emacs-style regular expressions. + • `#defun#consult': Search for "defun" using grep, filter with the + word "consult". + • `/defun/consult': It is also possible to use other punctuation + characters. + • `#to#': Force searching for "to" using grep, since the grep pattern + must be longer than `consult-async-min-input' characters by default. + • `#defun -- --invert-match#': Pass argument `--invert-match' to grep. + + Asynchronous processes like `find' and `grep' create an error log + buffer `_*consult-async*' (note the leading space), which is useful + for troubleshooting. The prompt has a small indicator showing the + process status: + + • `:' the usual prompt colon, before input is provided. + • `*' with warning face, the process is running. + • `:' with success face, success, process exited with an error code of + zero. + • `!' with error face, failure, process exited with a nonzero error + code. + • `;' with error face, interrupted, for example if more input is + provided. + + +2.4 Multiple sources +──────────────────── + + Multiple synchronous candidate sources can be combined. This feature + is used by the `consult-buffer' command to present buffer-like + candidates in a single menu for quick access. By default + `consult-buffer' includes buffers, bookmarks, recent files and + project-specific buffers and files. It is possible to configure the + list of sources via the `consult-buffer-sources' variable. Arbitrary + custom sources can be defined. + + As an example, the bookmark source is defined as follows: + + ┌──── + │ (defvar consult--source-bookmark + │ `(:name "Bookmark" + │ :narrow ?m + │ :category bookmark + │ :face consult-bookmark + │ :history bookmark-history + │ :items ,#'bookmark-all-names + │ :action ,#'consult--bookmark-action)) + └──── + + Required source fields: + • `:category' Completion category. + • `:items' List of strings to select from or function returning list + of strings. A list of cons cells is not supported. + + Optional source fields: + • `:name' Name of the source, used for narrowing, group titles and + annotations. + • `:narrow' Narrowing character or `(character . string)' pair. + • `:preview-key' Preview key or keys which trigger preview. + • `:enabled' Function which must return t if the source is enabled. + • `:hidden' When t candidates of this source are hidden by default. + • `:face' Face used for highlighting the candidates. + • `:annotate' Annotation function called for each candidate, returns + string. + • `:history' Name of history variable to add selected candidate. + • `: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. + + The `:state' and `:action' fields of the sources deserve a longer + explanation. The `:action' function takes a single argument and is + only called after selection with the selected candidate, if the + selection has not been aborted. This functionality is provided for + convenience and easy definition of sources. The `:state' field is more + general. The `:state' function is a constructor function without + arguments, which can perform some setup necessary for the preview. It + must return a closure which takes an ACTION and a CANDIDATE + argument. See the docstring of `consult--with-preview' for more + details about the ACTION argument. + + By default, `consult-buffer' previews buffers, bookmarks and + files. Loading recent files or bookmarks can result in expensive + operations. However it is possible to configure a manual preview as + follows. + + ┌──── + │ (consult-customize + │ consult--source-bookmark consult--source-recent-file + │ consult--source-project-recent-file :preview-key (kbd "M-.")) + └──── + + 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 + <https://github.com/minad/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))))) + └──── + + Another useful source lists all Org buffers and lets you create new + ones. One can create similar sources for other major modes, e.g., for + Eshell. + + ┌──── + │ (defvar org-source + │ (list :name "Org Buffer" + │ :category 'buffer + │ :narrow ?o + │ :face 'consult-buffer + │ :history 'buffer-name-history + │ :state #'consult--buffer-state + │ :new + │ (lambda (name) + │ (with-current-buffer (get-buffer-create name) + │ (insert "#+title: " name "\n\n") + │ (org-mode) + │ (consult--buffer-action (current-buffer)))) + │ :items + │ (lambda () + │ (mapcar #'buffer-name + │ (seq-filter + │ (lambda (x) + │ (eq (buffer-local-value 'major-mode x) 'org-mode)) + │ (buffer-list)))))) + │ + │ (add-to-list 'consult-buffer-sources 'org-source 'append) + └──── + + For more details, see the documentation of `consult-buffer' and of the + internal `consult--multi' API. The `consult--multi' function can be + used to create new multi-source commands, but is part of the internal + API as of now, since some details may still change. + + +2.5 Embark integration +────────────────────── + + *NOTE*: Install the `embark-consult' package from MELPA, which + provides Consult-specific Embark actions and the Occur buffer export. + + Embark is a versatile package which offers context dependent actions, + comparable to a context menu. See the [Embark manual] for an extensive + description of its capabilities. + + Actions are commands which can operate on the currently selected + candidate (or target in Embark terminology). When completing files, + for example the `delete-file' command is offered. With Embark you can + execute arbitrary commands on the currently selected candidate via + `M-x'. + + Furthermore Embark provides the `embark-collect' command, which + collects candidates and presents them in an Embark collect buffer, + where further actions can be applied to them. A related feature is the + `embark-export' command, which exports candidate lists to a buffer of + a special type. For example in the case of file completion, a Dired + buffer is opened. + + In the context of Consult, particularly exciting is the possibility to + export the matching lines from `consult-line', `consult-outline', + `consult-mark' and `consult-global-mark'. The matching lines are + exported to an Occur buffer where 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, if the [wgrep] package is installed. These three + workflows are symmetric. + + ⁃ `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. + ⁃ `consult-find' -> `embark-export' to `dired-mode' buffer -> + `wdired-change-to-wdired-mode' for editing. + + +[Embark manual] <https://github.com/oantolin/embark> + +[wgrep] <https://github.com/mhayashi1120/Emacs-wgrep> + + +3 Configuration +═══════════════ + + Consult can be installed from [ELPA] or [MELPA] via the Emacs built-in + package manager. Alternatively it can be directly installed from the + development repository via other non-standard package managers. + + There is the [Consult wiki], where additional configuration examples + can be contributed. + + *IMPORTANT:* It is strongly recommended that you enable [lexical + binding] in your configuration. Consult relies on lambdas and lexical + closures. For this reason many Consult-related snippets require + lexical binding. + + +[ELPA] <http://elpa.gnu.org/packages/consult.html> + +[MELPA] <https://melpa.org/#/consult> + +[Consult wiki] <https://github.com/minad/consult/wiki> + +[lexical binding] +<https://www.gnu.org/software/emacs/manual/html_node/elisp/Lexical-Binding.html> + +3.1 Use-package example +─────────────────────── + + The Consult package only provides commands and does not add any + keybindings or modes. Therefore the package is non-intrusive but + requires a little setup 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. The + configuration shown here relies on the `use-package' macro, which is a + convenient tool to manage package configurations. + + *NOTE:* There is the [Consult wiki], where you can contribute + additional configuration examples. + + ┌──── + │ ;; Example configuration for Consult + │ (use-package consult + │ ;; Replace bindings. Lazily loaded due by `use-package'. + │ :bind (;; C-c bindings (mode-specific-map) + │ ("C-c h" . consult-history) + │ ("C-c m" . consult-mode-command) + │ ("C-c k" . consult-kmacro) + │ ;; 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 + │ ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window + │ ("C-x 5 b" . consult-buffer-other-frame) ;; orig. switch-to-buffer-other-frame + │ ("C-x r b" . consult-bookmark) ;; orig. bookmark-jump + │ ("C-x p b" . consult-project-buffer) ;; orig. project-switch-to-buffer + │ ;; Custom M-# bindings for fast register access + │ ("M-#" . consult-register-load) + │ ("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated) + │ ("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 + │ ("M-g g" . consult-goto-line) ;; orig. goto-line + │ ("M-g M-g" . consult-goto-line) ;; orig. goto-line + │ ("M-g o" . consult-outline) ;; Alternative: consult-org-heading + │ ("M-g m" . consult-mark) + │ ("M-g k" . consult-global-mark) + │ ("M-g i" . consult-imenu) + │ ("M-g I" . consult-imenu-multi) + │ ;; M-s bindings (search-map) + │ ("M-s d" . consult-find) + │ ("M-s D" . consult-locate) + │ ("M-s g" . consult-grep) + │ ("M-s G" . consult-git-grep) + │ ("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 + │ ("M-s e" . consult-isearch-history) + │ :map isearch-mode-map + │ ("M-e" . consult-isearch-history) ;; orig. isearch-edit-string + │ ("M-s e" . consult-isearch-history) ;; orig. isearch-edit-string + │ ("M-s l" . consult-line) ;; needed by consult-line to detect isearch + │ ("M-s L" . consult-line-multi) ;; needed by consult-line to detect isearch + │ ;; Minibuffer history + │ :map minibuffer-local-map + │ ("M-s" . consult-history) ;; orig. next-matching-history-element + │ ("M-r" . consult-history)) ;; orig. previous-matching-history-element + │ + │ ;; Enable automatic preview at point in the *Completions* buffer. This is + │ ;; relevant when you use the default completion UI. + │ :hook (completion-list-mode . consult-preview-at-point-mode) + │ + │ ;; The :init configuration is always executed (Not lazy) + │ :init + │ + │ ;; Optionally configure the register formatting. This improves the register + │ ;; preview for `consult-register', `consult-register-load', + │ ;; `consult-register-store' and the Emacs built-ins. + │ (setq register-preview-delay 0.5 + │ register-preview-function #'consult-register-format) + │ + │ ;; Optionally tweak the register preview window. + │ ;; This adds thin lines, sorting and hides the mode line of the window. + │ (advice-add #'register-preview :override #'consult-register-window) + │ + │ ;; Use Consult to select xref locations with preview + │ (setq xref-show-xrefs-function #'consult-xref + │ xref-show-definitions-function #'consult-xref) + │ + │ ;; Configure other variables and modes in the :config section, + │ ;; after lazily loading the package. + │ :config + │ + │ ;; 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>"))) + │ ;; 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-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-.")) + │ + │ ;; Optionally configure the narrowing key. + │ ;; Both < and C-+ work reasonably well. + │ (setq consult-narrow-key "<") ;; (kbd "C-+") + │ + │ ;; Optionally make narrowing help available in the minibuffer. + │ ;; You may want to use `embark-prefix-help-command' or which-key instead. + │ ;; (define-key consult-narrow-map (vconcat consult-narrow-key "?") #'consult-narrow-help) + │ + │ ;; 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) + │ ;; (setq consult-project-function (lambda (_) (vc-root-dir))) + │ ;;;; 4. locate-dominating-file + │ ;; (setq consult-project-function (lambda (_) (locate-dominating-file "." ".git"))) + │ ) + └──── + + +[Consult wiki] <https://github.com/minad/consult/wiki> + + +3.2 Custom variables +──────────────────── + + *TIP:* If you have [Marginalia] installed, type `M-x + customize-variable RET ^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. + + ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ + Variable Description + ───────────────────────────────────────────────────────────────────────────────────────── + consult-after-jump-hook Functions to call after jumping to a location + consult-async-input-debounce Input debounce for asynchronous commands + consult-async-input-throttle Input throttle for asynchronous commands + consult-async-min-input Minimum numbers of letters needed for async process + consult-async-refresh-delay Refresh delay for asynchronous commands + consult-async-split-style Splitting style used for async commands + consult-async-split-styles-alist Available splitting styles used for async commands + consult-bookmark-narrow Narrowing configuration for `consult-bookmark' + consult-buffer-filter Filter for `consult-buffer' + consult-buffer-sources List of virtual buffer sources + consult-find-args Command line arguments for find + consult-fontify-max-size Buffers larger than this limit are not fontified + consult-fontify-preserve Preserve fontification for line-based commands. + consult-git-grep-args Command line arguments for git-grep + consult-goto-line-numbers Show line numbers for `consult-goto-line' + consult-grep-max-columns Maximal number of columns of the matching lines + consult-grep-args Command line arguments for grep + consult-imenu-config Mode-specific configuration for `consult-imenu' + consult-line-numbers-widen Show absolute line numbers when narrowing is active. + consult-line-point-placement Placement of the point used by `consult-line' + consult-line-start-from-top Start the `consult-line' search from the top + consult-locate-args Command line arguments for locate + consult-man-args Command line arguments for man + consult-mode-command-filter Filter for `consult-mode-command' + consult-mode-histories Mode-specific history variables + consult-narrow-key Narrowing prefix key during completion + consult-preview-key Keys which triggers preview + consult-preview-allowed-hooks List of `find-file' hooks to enable during preview + consult-preview-excluded-files Regexps matched against file names during preview + consult-preview-max-count Maximum number of files to keep open during preview + consult-preview-max-size Files larger than this size are not previewed + consult-preview-raw-size Files larger than this size are previewed in raw form + consult-preview-variables Alist of variables to bind during preview + consult-project-buffer-sources List of virtual project buffer sources + consult-project-function Function which returns current project root + consult-register-prefix Prefix string for register keys during completion + 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 + ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ + + +[Marginalia] <https://github.com/minad/marginalia> + + +3.3 Fine-tuning of individual commands +────────────────────────────────────── + + *NOTE:* Consult supports fine-grained customization of individual + commands. This configuration feature exists for experienced users with + special requirements. There is the [Consult wiki], where we collect + further configuration examples. + + Commands and buffer sources allow flexible, individual customization + by using the `consult-customize' macro. You can override any option + passed to the internal `consult--read' API. The [Consult wiki] already + contains a numerous useful configuration examples. Note that since + `consult--read' is part of the internal API, options could be removed, + replaced or renamed in future versions of the package. + + Useful options are: + • `:prompt' set the prompt string + • `:preview-key' set the preview key, default is `consult-preview-key' + • `:initial' set the initial input + • `:default' set the default value + • `:history' set the history variable symbol + • `:add-history' add items to the future history, for example symbol + at point + • `:sort' enable or disable sorting + • `:group' set to nil to disable candidate grouping and titles. + • `:inherit-input-method' set to non-nil to inherit the input method. + + ┌──── + │ (consult-customize + │ ;; 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-.") + │ ;; 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>"))) + └──── + + The configuration values are evaluated at runtime, just before the + completion session is started. Therefore you can use for example + `thing-at-point' to adjust the initial input or the future history. + + ┌──── + │ (consult-customize + │ consult-line + │ :add-history (seq-some #'thing-at-point '(region symbol))) + │ + │ (defalias 'consult-line-thing-at-point 'consult-line) + │ + │ (consult-customize + │ consult-line-thing-at-point + │ :initial (thing-at-point 'symbol)) + └──── + + Generally it is possible to modify commands for your individual needs + by the following techniques: + + 1. Use `consult-customize' in order to change the command or source + settings. + 2. Create your own wrapper function which passes modified arguments to + the Consult functions. + 3. Create your own buffer [multi sources] for `consult-buffer'. + 4. Create advices to modify some internal behavior. + 5. Write or propose a patch. + + +[Consult wiki] <https://github.com/minad/consult/wiki> + +[multi sources] See section 2.4 + + +4 Recommended packages +══════════════════════ + + I use and recommend this combination of packages: + + • consult: This package + • [vertico]: Fast and minimal vertical completion system + • [marginalia]: Annotations for the completion candidates + • [embark and embark-consult]: Action commands, which can act on the + completion candidates + • [orderless]: Completion style which offers flexible candidate + filtering + + 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! + + • The builtin completion UI, which pops up the `*Completions*' buffer. + • The builtin `icomplete-vertical-mode' in Emacs 28. + • [selectrum by Radon Rosborough]: Alternative vertical UI, + predecessor of Vertico. + • [mct by Protesilaos Stavrou]: Minibuffer and Completions in Tandem, + which builds on the default completion UI (development + [discontinued]). + + You can integrated 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. + + • [consult-ag]: Support for the [Silver Searcher] in the style of + `consult-grep'. + • [consult-company]: Completion at point using the [Company] backends. + • [consult-dir]: Directory jumper using Consult multi sources. + • [consult-dash]: Consult interface to [Dash documentation] + • [consult-eglot]: Integration with Eglot (LSP client). + • [consult-flycheck]: Additional Flycheck integration. + • [consult-flyspell]: Additional Flyspell integration. + • [consult-ls-git]: List files from git via Consult. + • [consult-lsp]: Integration with Lsp-mode (LSP client). + • [consult-notmuch]: Access the [Notmuch] email system using Consult. + • [consult-notes]: Searching notes with Consult. + • [consult-org-roam]: Integration with [Org-roam]. + • [consult-project-extra]: Additional project.el extras and buffer + sources. + • [consult-projectile]: Additional [Projectile] integration and buffer + sources. + • [consult-recoll]: Access the [Recoll] desktop full-text search using + Consult. + • [consult-spotify]: Access the Spotify API and control your local + music player. + • [consult-yasnippet]: Integration with Yasnippet. + • [affe]: Asynchronous Fuzzy Finder for Emacs based on Consult. + + Not directly related to Consult, but maybe still of interest are the + following packages. These packages should work well with Consult, + follow a similar spirit or offer functionality based on + `completing-read'. + + • [corfu]: Completion systems for `completion-at-point' using small + popups (Alternative to [Company]). + • [cape]: Completion At Point Extensions, which can be used with + `consult-completion-in-region' and [Corfu]. + • [bookmark-view]: Store window configuration as bookmarks, possible + integration with `consult-buffer'. + • [citar]: Versatile package for citation insertion and bibliography + management. + • [devdocs]: Emacs viewer for [DevDocs] with a convenient completion + interface. + • [flyspell-correct]: Apply spelling corrections by selecting via + `completing-read'. + • [wgrep]: Editing of grep buffers, use together with `consult-grep' + via `embark-export'. + • [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. + + +[vertico] <https://github.com/minad/vertico> + +[marginalia] <https://github.com/minad/marginalia> + +[embark and embark-consult] <https://github.com/oantolin/embark> + +[orderless] <https://github.com/oantolin/orderless> + +[selectrum by Radon Rosborough] +<https://github.com/radian-software/selectrum> + +[mct by Protesilaos Stavrou] <https://git.sr.ht/~protesilaos/mct> + +[discontinued] +<https://protesilaos.com/codelog/2022-04-14-emacs-discontinue-mct/> + +[consult-ag] <https://github.com/yadex205/consult-ag> + +[Silver Searcher] <https://github.com/ggreer/the_silver_searcher> + +[consult-company] <https://github.com/mohkale/consult-company> + +[Company] <https://github.com/company-mode/company-mode> + +[consult-dir] <https://github.com/karthink/consult-dir> + +[consult-dash] <https://codeberg.org/ravi/consult-dash> + +[Dash documentation] <https://github.com/dash-docs-el/dash-docs> + +[consult-eglot] <https://github.com/mohkale/consult-eglot> + +[consult-flycheck] <https://github.com/minad/consult-flycheck> + +[consult-flyspell] <https://gitlab.com/OlMon/consult-flyspell> + +[consult-ls-git] <https://github.com/rcj/consult-ls-git> + +[consult-lsp] <https://github.com/gagbo/consult-lsp> + +[consult-notmuch] <https://codeberg.org/jao/consult-notmuch> + +[Notmuch] <https://notmuchmail.org/> + +[consult-notes] <https://github.com/mclear-tools/consult-notes> + +[consult-org-roam] <https://github.com/jgru/consult-org-roam> + +[Org-roam] <https://github.com/org-roam/org-roam> + +[consult-project-extra] +<https://github.com/Qkessler/consult-project-extra/> + +[consult-projectile] <https://gitlab.com/OlMon/consult-projectile/> + +[Projectile] <https://github.com/bbatsov/projectile> + +[consult-recoll] <https://codeberg.org/jao/consult-recoll> + +[Recoll] <https://www.lesbonscomptes.com/recoll/> + +[consult-spotify] <https://codeberg.org/jao/espotify> + +[consult-yasnippet] <https://github.com/mohkale/consult-yasnippet> + +[affe] <https://github.com/minad/affe> + +[corfu] <https://github.com/minad/corfu> + +[cape] <https://github.com/minad/cape> + +[Corfu] <https://github.com/minad/corfu> + +[bookmark-view] <https://github.com/minad/bookmark-view> + +[citar] <https://github.com/bdarcus/citar> + +[devdocs] <https://github.com/astoff/devdocs.el> + +[DevDocs] <https://devdocs.io/> + +[flyspell-correct] <https://github.com/d12frosted/flyspell-correct> + +[wgrep] <https://github.com/mhayashi1120/Emacs-wgrep> + +[all-the-icons-completion] +<https://github.com/iyefrat/all-the-icons-completion> + + +5 Bug reports +═════════════ + + 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 + `vertico-mode', `mct-mode', `selectrum-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 `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' 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 in the minimal + configuration snippet. + + Minimal setup with Vertico for `emacs -Q': + ┌──── + │ (package-initialize) + │ (require 'consult) + │ (require 'vertico) + │ (vertico-mode) + │ (setq completion-styles '(substring basic)) + └──── + + Minimal setup with the default completion system for `emacs -Q': + ┌──── + │ (package-initialize) + │ (require 'consult) + │ (setq completion-styles '(substring basic)) + └──── + + Please provide the necessary important information with your bug + report: + + • The minimal configuration snippet used to reproduce the issue. + • Your completion UI (Default completion, Vertico, Mct, Selectrum or + Icomplete). + • A stack trace in case the bug triggers an exception. + • Your Emacs version, since bugs may be fixed or introduced in newer + versions. + • Your operating system, since Emacs behavior varies between Linux, + Mac and Windows. + • The package manager, e.g., straight.el or package.el, used to + install the Emacs packages, in order to exclude update issues. Did + you install Consult as part of the Doom or Spacemacs Emacs + distributions? + • Do you use Evil or other packages which apply deep changes? Consult + does not provide Evil integration out of the box, but there is some + support in [evil-collection]. + + When evaluating Consult-related code snippets you should enable + [lexical binding]. Consult often relies on lambdas and lexical + closures. + + +[evil-collection] <https://github.com/emacs-evil/evil-collection> + +[lexical binding] +<https://www.gnu.org/software/emacs/manual/html_node/elisp/Lexical-Binding.html> + + +6 Contributions +═══════════════ + + Consult is a community effort, please participate in the discussions. + Contributions are welcome, but you may want to discuss potential + contributions first. Since this package is part of [GNU ELPA] + contributions require a copyright assignment to the FSF. + + If you have a proposal, take a look at the [Consult issue tracker] and + the [Consult wishlist]. There have been many prior feature + discussions. Please search through the issue tracker, maybe your issue + or feature request has already been discussed. You can contribute to + the [Consult wiki], in case you want to share small configuration or + command snippets. + + +[GNU ELPA] <http://elpa.gnu.org/packages/consult.html> + +[Consult issue tracker] <https://github.com/consult/issues> + +[Consult wishlist] <https://github.com/minad/consult/issues/6> + +[Consult wiki] <https://github.com/minad/consult/wiki> + + +7 Acknowledgments +═════════════════ + + This package took inspiration from [Counsel] by Oleh Krehel. Some of + the Consult commands originated in the Counsel package or the + [Selectrum wiki]. The commands have been rewritten and greatly + enhanced in comparison to the original versions. + + Code contributions: + • [Omar Antolín Camarena] + • [Sergey Kostyaev] + • [okamsn] + • [Clemens Radermacher] + • [Tom Fitzhenry] + • [jakanakaevangeli] + • [Iñigo Serna] + • [Adam Spiers] + • [Omar Polo] + • [Augusto Stoffel] + • [Fox Kiester] + • [Tecosaur] + • [Mohamed Abdelnour] + • [Sylvain Rousseau] + • [J.D. Smith] + • [Mohsin Kaleem] + + Advice and useful discussions: + • [Clemens Radermacher] + • [Omar Antolín Camarena] + • [Protesilaos Stavrou] + • [Steve Purcell] + • [Adam Porter] + • [Manuel Uberti] + • [Tom Fitzhenry] + • [Howard Melman] + • [Stefan Monnier] + • [Dmitry Gutov] + • [Itai Y. Efrat] + • [Bruce d'Arcus] + • [J.D. Smith] + • [Enrique Kessler Martínez] + + Authors of supplementary `consult-*' packages: + + • [Jose A Ortega Ruiz] ([consult-notmuch], [consult-recoll], + [consult-spotify]) + • [Gerry Agbobada] ([consult-lsp]) + • [Karthik Chikmagalur] ([consult-dir]) + • [Mohsin Kaleem] ([consult-company], [consult-eglot], + [consult-yasnippet]) + • [Marco Pawłowski] ([consult-flyspell], [consult-projectile]) + • [Enrique Kessler Martínez] ([consult-project-extra]) + • [Jan Gru] ([consult-org-roam]) + • [Kanon Kakuno] ([consult-ag]) + • [Robin Joy] ([consult-ls-git]) + • [Ravi R Kiran] [(consult-dash]) + • [Colin McLear] ([consult-notes]) + + +[Counsel] <https://github.com/abo-abo/swiper#counsel> + +[Selectrum wiki] +<https://github.com/radian-software/selectrum/wiki/Useful-Commands> + +[Omar Antolín Camarena] <https://github.com/oantolin/> + +[Sergey Kostyaev] <https://github.com/s-kostyaev/> + +[okamsn] <https://github.com/okamsn/> + +[Clemens Radermacher] <https://github.com/clemera/> + +[Tom Fitzhenry] <https://github.com/tomfitzhenry/> + +[jakanakaevangeli] <https://github.com/jakanakaevangeli> + +[Iñigo Serna] <https://hg.serna.eu> + +[Adam Spiers] <https://github.com/aspiers/> + +[Omar Polo] <https://github.com/omar-polo> + +[Augusto Stoffel] <https://github.com/astoff> + +[Fox Kiester] <https://github.com/noctuid> + +[Tecosaur] <https://github.com/tecosaur> + +[Mohamed Abdelnour] <https://github.com/mohamed-abdelnour> + +[Sylvain Rousseau] <https://github.com/thisirs> + +[J.D. Smith] <https://github.com/jdtsmith> + +[Mohsin Kaleem] <https://github.com/mohkale> + +[Protesilaos Stavrou] <https://protesilaos.com> + +[Steve Purcell] <https://github.com/purcell/> + +[Adam Porter] <https://github.com/alphapapa/> + +[Manuel Uberti] <https://github.com/manuel-uberti/> + +[Howard Melman] <https://github.com/hmelman/> + +[Stefan Monnier] <https://github.com/monnier/> + +[Dmitry Gutov] <https://github.com/dgutov/> + +[Itai Y. Efrat] <https://github.com/iyefrat> + +[Bruce d'Arcus] <https://github.com/bdarcus> + +[Enrique Kessler Martínez] <https://github.com/Qkessler> + +[Jose A Ortega Ruiz] <https://codeberg.org/jao/> + +[consult-notmuch] <https://codeberg.org/jao/consult-notmuch> + +[consult-recoll] <https://codeberg.org/jao/consult-recoll> + +[consult-spotify] <https://codeberg.org/jao/espotify> + +[Gerry Agbobada] <https://github.com/gagbo/> + +[consult-lsp] <https://github.com/gagbo/consult-lsp> + +[Karthik Chikmagalur] <https://github.com/karthink> + +[consult-dir] <https://github.com/karthink/consult-dir> + +[consult-company] <https://github.com/mohkale/consult-company> + +[consult-eglot] <https://github.com/mohkale/consult-eglot> + +[consult-yasnippet] <https://github.com/mohkale/consult-yasnippet> + +[Marco Pawłowski] <https://gitlab.com/OlMon> + +[consult-flyspell] <https://gitlab.com/OlMon/consult-flyspell> + +[consult-projectile] <https://gitlab.com/OlMon/consult-projectile> + +[consult-project-extra] +<https://github.com/Qkessler/consult-project-extra> + +[Jan Gru] <https://github.com/jgru> + +[consult-org-roam] <https://github.com/jgru/consult-org-roam> + +[Kanon Kakuno] <https://github.com/yadex205> + +[consult-ag] <https://github.com/yadex205/consult-ag> + +[Robin Joy] <https://github.com/rcj> + +[consult-ls-git] <https://github.com/rcj/consult-ls-git> + +[Ravi R Kiran] <https://codeberg.org/ravi> + +[(consult-dash] <https://codeberg.org/ravi/consult-dash> + +[Colin McLear] <https://github.com/mclearc> + +[consult-notes] <https://github.com/mclear-tools/consult-notes> + + +8 Indices +═════════ + +8.1 Function index +────────────────── + + +8.2 Concept index +───────────────── diff --git a/elpa/consult-0.19/README.org b/elpa/consult-0.19/README.org @@ -0,0 +1,1211 @@ +#+title: consult.el - Consulting completing-read +#+author: Daniel Mendler +#+language: en +#+export_file_name: consult.texi +#+texinfo_dir_category: Emacs misc features +#+texinfo_dir_title: Consult: (consult). +#+texinfo_dir_desc: Useful commands built on completing-read. + +#+html: <a href="https://www.gnu.org/software/emacs/"><img alt="GNU Emacs" src="https://github.com/minad/corfu/blob/screenshots/emacs.svg?raw=true"/></a> +#+html: <a href="http://elpa.gnu.org/packages/consult.html"><img alt="GNU ELPA" src="https://elpa.gnu.org/packages/consult.svg"/></a> +#+html: <a href="http://elpa.gnu.org/devel/consult.html"><img alt="GNU-devel ELPA" src="https://elpa.gnu.org/devel/consult.svg"/></a> +#+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-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 is fully compatible with completion systems based on the standard Emacs +=completing-read= API, notably the default completion system, [[https://github.com/minad/vertico][Vertico]], [[https://github.com/protesilaos/mct][Mct]], +[[https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html][Icomplete]] and [[https://github.com/radian-software/selectrum][Selectrum]]. + +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 +the main advantages of the package. Consult fits well into existing setups and +it helps you to create a full completion environment out of small and +independent components. Note that, if you use [[https://github.com/abo-abo/swiper#ivy][Ivy]] or [[https://github.com/emacs-helm/helm][Helm]], you probably don't +need Consult, since both packages bring their own Consult-like functionality. + +You can combine the complementary packages [[https://github.com/minad/marginalia/][Marginalia]], [[https://github.com/oantolin/embark/][Embark]] and [[https://github.com/oantolin/orderless][Orderless]] with +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 +selected candidate in the minibuffer or at point in normal buffers. For example, +when selecting from a list of files, Embark offers an action to delete the file. +Additionally Embark offers a facility to collect completion candidates in a +collect buffer. The section [[#embark-integration][Embark integration]] documents in greater detail how +Consult and Embark work together. + +#+toc: headlines 8 + +* Screenshots :noexport: + +#+caption: consult-grep +[[https://github.com/minad/consult/blob/screenshots/consult-grep.gif?raw=true]] +Fig. 1: Command =consult-git-grep= + +#+caption: consult-imenu +[[https://github.com/minad/consult/blob/screenshots/consult-imenu.png?raw=true]] +Fig. 2: Command =consult-imenu= + +#+caption: consult-line +[[https://github.com/minad/consult/blob/screenshots/consult-line.png?raw=true]] +Fig. 3: Command =consult-line= + +* Available commands +:properties: +:custom_id: available-commands +:description: Navigation, search, editing commands and more +:end: +#+cindex: commands + +Most Consult commands follow the meaningful naming scheme =consult-<thing>=. +Many commands implement a little known but convenient Emacs feature called +"future history", which guesses what input the user wants. At a command prompt +type =M-n= and typically Consult will insert the symbol or thing at point into +the input. + +*TIP:* If you have [[https://github.com/minad/marginalia][Marginalia]] annotators activated, type =M-x ^consult= to see +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. + +** Virtual Buffers +:properties: +:description: Buffers, bookmarks and recent files +:end: +#+cindex: virtual buffers + +#+findex: consult-buffer +#+findex: consult-buffer-other-window +#+findex: consult-buffer-other-frame +#+findex: consult-project-buffer +#+findex: consult-recent-file +#+findex: consult-bookmark +- =consult-buffer= (=-other-window=, =-other-frame=): Enhanced version + of =switch-to-buffer= with support for virtual buffers. Supports live preview + of buffers and narrowing to the virtual buffer types. You can type =f SPC= in + order to narrow to recent files. Press =SPC= to show ephemeral buffers. + Supported narrowing keys: + - b Buffers + - SPC Hidden buffers + - * Modified buffers + - f Files (Requires =recentf-mode=) + - m Bookmarks + - p Project + - Custom [[#multiple-sources][other sources]] configured in =consult-buffer-sources=. +- =consult-project-buffer=: Variant of =consult-buffer= restricted to buffers and + recent files of the current project. You can add custom sources to + =consult-project-buffer-sources=. The command may prompt you for a project if + you invoke it from outside a project. +- =consult-bookmark=: Select or create bookmark. To select bookmarks you might use the + =consult-buffer= as an alternative, which can include a bookmark virtual buffer + source. Note that =consult-bookmark= supports preview of bookmarks and + narrowing. +- =consult-recent-file=: Select from recent files with preview. + You might prefer the powerful =consult-buffer= instead, which can include + recent files as a virtual buffer source. The =recentf-mode= enables tracking of + recent files. + +** Editing +:properties: +:description: Commands useful for editing +:end: +#+cindex: editing + +#+findex: consult-yank-pop +#+findex: consult-yank-from-kill-ring +#+findex: consult-yank-replace +#+findex: consult-kmacro +- =consult-yank-from-kill-ring=: Enhanced version of =yank= to select an item + from the =kill-ring=. The selected text previewed as overlay in the buffer. +- =consult-yank-pop=: Enhanced version of =yank-pop= with DWIM-behavior, which + either replaces the last =yank= by cycling through the =kill-ring=, or if there + has not been a last =yank= consults the =kill-ring=. The selected text previewed + as overlay in the buffer. +- =consult-yank-replace=: Like =consult-yank-pop=, but always replaces the last + =yank= with an item from the =kill-ring=. +- =consult-kmacro=: Select macro from the macro ring and execute it. + +** Register +:properties: +:description: Searching through registers and fast access +:end: +#+cindex: register + +#+findex: consult-register +#+findex: consult-register-load +#+findex: consult-register-store +#+findex: consult-register-format +#+findex: consult-register-window +- =consult-register=: Select from list of registers. The command + supports narrowing to register types and preview of marker positions. This + command is useful to search the register contents. For quick access use the + commands =consult-register-load=, =consult-register-store= or the built-in Emacs + register commands. +- =consult-register-format=: Set =register-preview-function= to this function for + an enhanced register formatting. See the [[#use-package-example][example configuration]]. +- =consult-register-window=: Replace =register-preview= with this function for a + better register window. See the [[#use-package-example][example configuration]]. +- =consult-register-load=: Utility command to quickly load a register. + The command either jumps to the register value or inserts it. +- =consult-register-store=: Improved UI to store registers depending on the current + context with an action menu. With an active region, store/append/prepend the + contents, optionally deleting the region when a prefix argument is given. + With a numeric prefix argument, store/add the number. Otherwise store point, + frameset, window or kmacro. Usage examples: + * =M-' x=: If no region is active, store point in register =x=. + If a region is active, store the region in register =x=. + * =M-' M-w x=: Store window configuration in register =x=. + * =C-u 100 M-' x=: Store number in register =x=. + +** Navigation +:properties: +:description: Mark rings, outlines and imenu +:end: +#+cindex: navigation + +#+findex: consult-goto-line +#+findex: consult-mark +#+findex: consult-global-mark +#+findex: consult-outline +#+findex: consult-imenu +#+findex: consult-imenu-multi +- =consult-goto-line=: Jump to line number enhanced with live preview. + This is a drop-in replacement for =goto-line=. +- =consult-mark=: Jump to a marker in the =mark-ring=. Supports live + preview and recursive editing. +- =consult-global-mark=: Jump to a marker in the =global-mark-ring=. + Supports live preview and recursive editing. +- =consult-outline=: Jump to a heading of the outline. Supports narrowing + to a heading level, live preview and recursive editing. +- =consult-imenu=: Jump to imenu item in the current buffer. Supports + live preview, recursive editing and narrowing. +- =consult-imenu-multi=: Jump to imenu item in project buffers, with + the same major mode as the current buffer. Supports live preview, + recursive editing and narrowing. This feature has been inspired by + [[https://github.com/vspinu/imenu-anywhere][imenu-anywhere]]. + +** Search +:properties: +:description: Line search, grep and file search +:end: +#+cindex: search + +#+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. + Supports live preview and recursive editing. The symbol at point and the + 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-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 + Embark collect buffer further, relying on the same completion filtering as + ~completing-read~. If the input begins with the negation operator, i.e., ~! SPC~, + the filter matches the complement. If a region is active, the region restricts + the filtering. +- =consult-focus-lines=: Temporarily hide lines by filtering them using the + current completion style. Call with =C-u= prefix argument in order to show the + hidden lines again. If the input begins with the negation operator, i.e., ~! + SPC~, the filter matches the complement. In contrast to =consult-keep-lines= this + function does not edit the buffer. If a region is active, the region restricts + the filtering. + +** Grep and Find +:properties: +:description: Searching through the filesystem +:end: +#+cindex: grep +#+cindex: find +#+cindex: locate + +#+findex: consult-grep +#+findex: consult-ripgrep +#+findex: consult-git-grep +#+findex: consult-find +#+findex: consult-locate +- =consult-grep=, =consult-ripgrep=, =consult-git-grep=: Search for regular expression + in files. Consult invokes Grep asynchronously, while you enter the search + term. After at least =consult-async-min-input= characters, the search gets + started. Consult splits the input string into two parts, if the first + character is a punctuation character, like =#=. For example + =#regexps#filter-string=, is split at the second =#=. The string =regexps= is + passed to Grep. Note that Consult transforms Emacs regular expressions to + expressions understand by the search program. Always use Emacs regular + expressions at the prompt. If you enter multiple regular expressions + separated by space only lines matching all regular expressions are shown. In + order to match space literally, escape the space with a backslash. The + =filter-string= is passed to the /fast/ Emacs filtering to further narrow down + the list of matches. This is particularly useful if you are using an advanced + completion style like orderless. =consult-grep= supports preview. If the + =consult-project-function= returns non-nil, =consult-grep= searches the + current project directory. Otherwise the =default-directory= is searched. If + =consult-grep= is invoked with prefix argument =C-u M-s g=, you can specify the + directory manually. +- =consult-find=, =consult-locate=: Find file by matching the path against a regexp. + Like for =consult-grep,= either the project root or the current directory is the + root directory for the search. The input string is treated similarly to + =consult-grep=, where the first part is passed to find, and the second part is + used for Emacs filtering. + +** Compilation +:properties: +:description: Jumping to references and compilation errors +:end: +#+cindex: compilation errors + +#+findex: consult-compile-error +#+findex: consult-flymake +#+findex: consult-xref +- =consult-compile-error=: Jump to a compilation error. Supports live preview + narrowing and recursive editing. +- =consult-flymake=: Jump to flymake diagnostic. Supports live preview and + recursive editing. The command supports narrowing. Press =e SPC=, =w SPC=, =n SPC= + to only show errors, warnings and notes respectively. +- =consult-xref=: Integration with xref. This function can be set as + =xref-show-xrefs-function= and =xref-show-definitions-function=. + +** Histories +:properties: +:description: Navigating histories +:end: +#+cindex: history + +#+findex: consult-complex-command +#+findex: consult-history +#+findex: consult-isearch-history +- =consult-complex-command=: Select a command from the + =command-history=. This command is a =completing-read= version of + =repeat-complex-command= and is also a replacement for the =command-history= + command from chistory.el. +- =consult-history=: Insert a string from the current buffer history, for example + the Eshell or Comint history. You can also invoke this command from the + minibuffer. In that case =consult-history= uses the history stored in the + =minibuffer-history-variable=. If you prefer =completion-at-point=, take a look at + =cape-history= from the [[https://github.com/minad/cape][Cape]] package. +- =consult-isearch-history=: During an Isearch session, this command picks a + search string from history and continues the search with the newly selected + string. Outside of Isearch, the command allows you to pick a string from the + history and starts a new Isearch. =consult-isearch-history= acts as a drop-in + replacement for =isearch-edit-string=. + +** Modes +:properties: +:description: Toggling minor modes and executing commands +:end: +#+cindex: minor mode +#+cindex: major mode + +#+findex: consult-minor-mode-menu +#+findex: consult-mode-command +- =consult-minor-mode-menu=: Enable/disable minor mode. Supports + narrowing to on/off/local/global modes by pressing =i/o/l/g SPC= + respectively. +- =consult-mode-command=: Run a command from the currently active minor or major + modes. Supports narrowing to local-minor/global-minor/major mode via the keys + =l/g/m=. + +** Org Mode +:properties: +:description: Org-specific commands +:end: + +#+findex: consult-org-heading +#+findex: consult-org-agenda +- =consult-org-heading=: Similar to =consult-outline=, for Org + buffers. Supports narrowing by heading level, priority and TODO + state, as well as live preview and recursive editing. +- =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. + +** 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 + mode which previews the candidate at point in the =*Completions*= buffer. This + mode is relevant if you use [[https://git.sr.ht/~protesilaos/mct][Mct]] or the default =*Completions*= UI. +- =consult-completion-in-region=: In case you don't use [[https://github.com/minad/corfu][Corfu]] as your in-buffer + completion UI, this function can be set as =completion-in-region-function=. Then + your minibuffer completion UI (e.g., Vertico or Icomplete) will be used for + =completion-at-point=. Note that Selectrum provides its own variant of + =consult-completion-in-region=. If you use Mct, you may want to try + =mct-region-mode= instead. + #+begin_src emacs-lisp + ;; Use `consult-completion-in-region' if Vertico is enabled. + ;; Otherwise use the default `completion--in-region' function. + (setq completion-in-region-function + (lambda (&rest args) + (apply (if vertico-mode + #'consult-completion-in-region + #'completion--in-region) + args))) + #+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 + either the [[https://github.com/minad/corfu][Corfu]] or the [[https://github.com/company-mode/company-mode][Company]] package. There is a technical limitation of + =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 + minibuffer, the server does not receive the updated input. LSP completion + works with Corfu or Company though, which perform the completion directly in + the original buffer. + +* Special features +:properties: +:description: Enhancements over built-in `completing-read' +:end: + +Consult enhances =completing-read= with live previews of candidates, additional +narrowing capabilities to candidate groups and asynchronously generated +candidate lists. The internal =consult--read= function, which is used by most +Consult commands, is a thin wrapper around =completing-read= and provides the +special functionality. In order to support multiple candidate sources there +exists the high-level function =consult--multi=. The architecture of Consult +allows it to work with different completion systems in the backend, while still +offering advanced features. + +** Live previews +:properties: +:description: Preview the currently selected candidate +:custom_id: live-previews +:end: +#+cindex: preview + +Some Consult commands support live previews. For example when you scroll through +the items of =consult-line=, the buffer will scroll to the corresponding position. +It is possible to jump back and forth between the minibuffer and the buffer to +perform recursive editing while the search is ongoing. + +Consult enables previews by default. You can disable them by adjusting the +=consult-preview-key= variable. Furthermore it is possible to specify keybindings +which trigger the preview manually as shown in the [[#use-package-example][example configuration]]. The +default setting of =consult-preview-key= is =any= which means that Consult triggers +the preview /immediately/ on any key press when the selected candidate changes. +You can configure each command individually with its own =:preview-key=. The +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-."))= +- Disabled =nil= + +A safe recommendation is to leave automatic immediate previews enabled in +general and disable the automatic preview only for commands where the preview +may be expensive due to file loading. Internally, Consult uses the +value of =this-command= to determine the =:preview-key= +customized. This means that if you wrap a =consult-*= command within +your own function or command, you will also need to add the name of +/your custom command/ to the =consult-customize= call in order for it +to be considered. + +#+begin_src emacs-lisp + (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 +#+end_src + +In this case one may wonder what the difference is between using an Embark +action on the current candidate in comparison to a manually triggered preview. +The main difference is that the files opened by manual preview are closed again +after the completion session. Furthermore during preview some functionality is +disabled to improve the performance, see for example the customization variables +=consult-preview-allowed-hooks= and =consult-preview-variables=. Files larger than +=consult-preview-raw-size= are previewed literally without syntax highlighting and +without changing the major mode. Delaying the preview is also useful for +=consult-theme=, since the theme preview is slow. The delay results in a smoother +UI experience. + +#+begin_src emacs-lisp + ;; Preview on any key press, but delay 0.5s + (consult-customize consult-theme :preview-key '(:debounce 0.5 any)) + ;; 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)) +#+end_src + +** Narrowing and grouping +:properties: +:description: Restricting the completion to a candidate group +:custom_id: narrowing-and-grouping +:end: +#+cindex: narrowing + +Consult has special support for candidate groups. If the completion UI supports +the grouping functionality, the UI separates the groups with thin lines and +shows group titles. Grouping is useful if the list of candidates consists of +candidates of multiple types or candidates from [[#multiple-sources][multiple sources]], like the +=consult-buffer= command, which shows both buffers and recently opened files. Note +that you can disable the group titles by setting the =:group= property of the +corresponding command to nil using the =consult-customize= macro. + +By entering a narrowing prefix or by pressing a narrowing key it is possible to +restrict the completion candidates to a certain candidate group. When you use +the =consult-buffer= command, you can enter the prefix =b SPC= to restrict list of +candidates to buffers only. If you press =DEL= afterwards, the full candidate list +will be shown again. Furthermore a narrowing prefix key and a widening key can +be configured which can be pressed to achieve the same effect, see the +configuration variables =consult-narrow-key= and =consult-widen-key=. + +After pressing =consult-narrow-key=, the possible narrowing keys can be shown by +pressing =C-h=. When pressing =C-h= after some prefix key, the =prefix-help-command= +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 +configuration]]. If [[https://github.com/justbur/emacs-which-key][which-key]] is installed, the narrowing keys are automatically +shown in the which-key window after pressing the =consult-narrow-key=. + +** Asynchronous search +:properties: +:description: Filtering asynchronously generated candidate lists +:end: +#+cindex: asynchronous search + +Consult has support for asynchronous generation of candidate lists. This feature +is used for search commands like =consult-grep=, where the list of matches is +generated dynamically while the user is typing a regular expression. The grep +process is executed in the background. When modifying the regular expression, +the background process is terminated and a new process is started with the +modified regular expression. + +The matches, which have been found, can then be narrowed using the installed +Emacs completion-style. This can be powerful if you are using for example the +=orderless= completion style. + +This two-level filtering is possible by splitting the input string. Part of the +input string is treated as input to grep and part of the input is used for +filtering. There are multiple splitting styles available, configured in +~consult-async-split-styles-alist~: =nil=, =comma=, =semicolon= and =perl=. The default +splitting style is configured with the variable ~consult-async-split-style~. + +With the =comma= and =semicolon= splitting styles, the first word before the comma +or semicolon is passed to grep, the remaining string is used for filtering. The +=nil= splitting style does not perform any splitting, the whole input is passed to +grep. + +The =perl= splitting style splits the input string at a punctuation character, +using a similar syntax as Perl regular expressions. + +Examples: + +- =#defun=: Search for "defun" using grep. +- =#consult embark=: Search for both "consult" and "embark" using grep in any order. +- =#first.*second=: Search for "first" followed by "second" using grep. +- =#\(consult\|embark\)=: Search for "consult" or "embark" using grep. Note the + usage of Emacs-style regular expressions. +- =#defun#consult=: Search for "defun" using grep, filter with the word + "consult". +- =/defun/consult=: It is also possible to use other punctuation + characters. +- =#to#=: Force searching for "to" using grep, since the grep pattern + must be longer than =consult-async-min-input= characters by default. +- =#defun -- --invert-match#=: Pass argument =--invert-match= to grep. + +Asynchronous processes like =find= and =grep= create an error log buffer +=_*consult-async*= (note the leading space), which is useful for +troubleshooting. The prompt has a small indicator showing the process status: + +- =:= the usual prompt colon, before input is provided. +- =*= with warning face, the process is running. +- =:= with success face, success, process exited with an error code of zero. +- =!= with error face, failure, process exited with a nonzero error code. +- =;= with error face, interrupted, for example if more input is provided. + +** Multiple sources +:properties: +:description: Combining candidates from different sources +:custom_id: multiple-sources +:end: +#+cindex: multiple sources + +Multiple synchronous candidate sources can be combined. This feature is used by +the =consult-buffer= command to present buffer-like candidates in a single menu +for quick access. By default =consult-buffer= includes buffers, bookmarks, recent +files and project-specific buffers and files. It is possible to configure the +list of sources via the =consult-buffer-sources= variable. Arbitrary custom +sources can be defined. + +As an example, the bookmark source is defined as follows: + +#+begin_src emacs-lisp +(defvar consult--source-bookmark + `(:name "Bookmark" + :narrow ?m + :category bookmark + :face consult-bookmark + :history bookmark-history + :items ,#'bookmark-all-names + :action ,#'consult--bookmark-action)) +#+end_src + +Required source fields: +- =:category= Completion category. +- =:items= List of strings to select from or function returning list of strings. + A list of cons cells is not supported. + +Optional source fields: +- =:name= Name of the source, used for narrowing, group titles and annotations. +- =:narrow= Narrowing character or =(character . string)= pair. +- =:preview-key= Preview key or keys which trigger preview. +- =:enabled= Function which must return t if the source is enabled. +- =:hidden= When t candidates of this source are hidden by default. +- =:face= Face used for highlighting the candidates. +- =:annotate= Annotation function called for each candidate, returns string. +- =:history= Name of history variable to add selected candidate. +- =: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. + +The =:state= and =:action= fields of the sources deserve a longer explanation. The +=:action= function takes a single argument and is only called after selection with +the selected candidate, if the selection has not been aborted. This +functionality is provided for convenience and easy definition of sources. The +=:state= field is more general. The =:state= function is a constructor function +without arguments, which can perform some setup necessary for the preview. It +must return a closure which takes an ACTION and a CANDIDATE argument. See the +docstring of =consult--with-preview= for more details about the ACTION argument. + +By default, =consult-buffer= previews buffers, bookmarks and files. Loading recent +files or bookmarks can result in expensive operations. However it is possible to +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-.")) +#+end_src + +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 https://github.com/minad/bookmark-view/. + +#+begin_src emacs-lisp +;; 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))))) +#+end_src + +Another useful source lists all Org buffers and lets you create new ones. One +can create similar sources for other major modes, e.g., for Eshell. + +#+begin_src emacs-lisp + (defvar org-source + (list :name "Org Buffer" + :category 'buffer + :narrow ?o + :face 'consult-buffer + :history 'buffer-name-history + :state #'consult--buffer-state + :new + (lambda (name) + (with-current-buffer (get-buffer-create name) + (insert "#+title: " name "\n\n") + (org-mode) + (consult--buffer-action (current-buffer)))) + :items + (lambda () + (mapcar #'buffer-name + (seq-filter + (lambda (x) + (eq (buffer-local-value 'major-mode x) 'org-mode)) + (buffer-list)))))) + + (add-to-list 'consult-buffer-sources 'org-source 'append) +#+end_src + +For more details, see the documentation of =consult-buffer= and of the +internal =consult--multi= API. The =consult--multi= function can be used to +create new multi-source commands, but is part of the internal API as of now, +since some details may still change. + +** Embark integration +:properties: +:description: Actions, Grep/Occur-buffer export +:custom_id: embark-integration +:end: +#+cindex: embark + +*NOTE*: Install the =embark-consult= package from MELPA, which provides +Consult-specific Embark actions and the Occur buffer export. + +Embark is a versatile package which offers context dependent actions, comparable +to a context menu. See the [[https://github.com/oantolin/embark][Embark manual]] for an extensive description of its +capabilities. + +Actions are commands which can operate on the currently selected candidate (or +target in Embark terminology). When completing files, for example the +=delete-file= command is offered. With Embark you can execute arbitrary commands +on the currently selected candidate via =M-x=. + +Furthermore Embark provides the =embark-collect= command, which collects +candidates and presents them in an Embark collect buffer, where further actions +can be applied to them. A related feature is the =embark-export= command, which +exports candidate lists to a buffer of a special type. For example in the case +of file completion, a Dired buffer is opened. + +In the context of Consult, particularly exciting is the possibility to export +the matching lines from =consult-line=, =consult-outline=, =consult-mark= and +=consult-global-mark=. The matching lines are exported to an Occur buffer where +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, +if the [[https://github.com/mhayashi1120/Emacs-wgrep][wgrep]] package is installed. These three workflows are symmetric. + ++ =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. ++ =consult-find= -> =embark-export= to =dired-mode= buffer -> =wdired-change-to-wdired-mode= for editing. + +* Configuration +:properties: +:description: Example configuration and customization variables +:end: + +Consult can be installed from [[http://elpa.gnu.org/packages/consult.html][ELPA]] or [[https://melpa.org/#/consult][MELPA]] via the Emacs built-in package +manager. Alternatively it can be directly installed from the development +repository via other non-standard package managers. + +There is the [[https://github.com/minad/consult/wiki][Consult wiki]], where additional configuration examples can be +contributed. + +*IMPORTANT:* It is strongly recommended that you enable [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Lexical-Binding.html][lexical binding]] in your +configuration. Consult relies on lambdas and lexical closures. For this reason +many Consult-related snippets require lexical binding. + +** Use-package example +:properties: +:description: Configuration example based on use-package +:custom_id: use-package-example +:end: +#+cindex: use-package + +The Consult package only provides commands and does not add any keybindings or +modes. Therefore the package is non-intrusive but requires a little setup +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. +The configuration shown here relies on the =use-package= macro, which is a +convenient tool to manage package configurations. + +*NOTE:* There is the [[https://github.com/minad/consult/wiki][Consult wiki]], where you can contribute additional +configuration examples. + +#+begin_src emacs-lisp + ;; Example configuration for Consult + (use-package consult + ;; Replace bindings. Lazily loaded due by `use-package'. + :bind (;; C-c bindings (mode-specific-map) + ("C-c h" . consult-history) + ("C-c m" . consult-mode-command) + ("C-c k" . consult-kmacro) + ;; 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 + ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window + ("C-x 5 b" . consult-buffer-other-frame) ;; orig. switch-to-buffer-other-frame + ("C-x r b" . consult-bookmark) ;; orig. bookmark-jump + ("C-x p b" . consult-project-buffer) ;; orig. project-switch-to-buffer + ;; Custom M-# bindings for fast register access + ("M-#" . consult-register-load) + ("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated) + ("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 + ("M-g g" . consult-goto-line) ;; orig. goto-line + ("M-g M-g" . consult-goto-line) ;; orig. goto-line + ("M-g o" . consult-outline) ;; Alternative: consult-org-heading + ("M-g m" . consult-mark) + ("M-g k" . consult-global-mark) + ("M-g i" . consult-imenu) + ("M-g I" . consult-imenu-multi) + ;; M-s bindings (search-map) + ("M-s d" . consult-find) + ("M-s D" . consult-locate) + ("M-s g" . consult-grep) + ("M-s G" . consult-git-grep) + ("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 + ("M-s e" . consult-isearch-history) + :map isearch-mode-map + ("M-e" . consult-isearch-history) ;; orig. isearch-edit-string + ("M-s e" . consult-isearch-history) ;; orig. isearch-edit-string + ("M-s l" . consult-line) ;; needed by consult-line to detect isearch + ("M-s L" . consult-line-multi) ;; needed by consult-line to detect isearch + ;; Minibuffer history + :map minibuffer-local-map + ("M-s" . consult-history) ;; orig. next-matching-history-element + ("M-r" . consult-history)) ;; orig. previous-matching-history-element + + ;; Enable automatic preview at point in the *Completions* buffer. This is + ;; relevant when you use the default completion UI. + :hook (completion-list-mode . consult-preview-at-point-mode) + + ;; The :init configuration is always executed (Not lazy) + :init + + ;; Optionally configure the register formatting. This improves the register + ;; preview for `consult-register', `consult-register-load', + ;; `consult-register-store' and the Emacs built-ins. + (setq register-preview-delay 0.5 + register-preview-function #'consult-register-format) + + ;; Optionally tweak the register preview window. + ;; This adds thin lines, sorting and hides the mode line of the window. + (advice-add #'register-preview :override #'consult-register-window) + + ;; Use Consult to select xref locations with preview + (setq xref-show-xrefs-function #'consult-xref + xref-show-definitions-function #'consult-xref) + + ;; Configure other variables and modes in the :config section, + ;; after lazily loading the package. + :config + + ;; 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>"))) + ;; 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-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-.")) + + ;; Optionally configure the narrowing key. + ;; Both < and C-+ work reasonably well. + (setq consult-narrow-key "<") ;; (kbd "C-+") + + ;; Optionally make narrowing help available in the minibuffer. + ;; You may want to use `embark-prefix-help-command' or which-key instead. + ;; (define-key consult-narrow-map (vconcat consult-narrow-key "?") #'consult-narrow-help) + + ;; 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) + ;; (setq consult-project-function (lambda (_) (vc-root-dir))) + ;;;; 4. locate-dominating-file + ;; (setq consult-project-function (lambda (_) (locate-dominating-file "." ".git"))) + ) +#+end_src + +** Custom variables +:properties: +:description: Short description of all customization settings +:end: +#+cindex: customization + +*TIP:* If you have [[https://github.com/minad/marginalia][Marginalia]] installed, type =M-x customize-variable RET +^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. + +| Variable | Description | +|----------------------------------+-------------------------------------------------------| +| consult-after-jump-hook | Functions to call after jumping to a location | +| consult-async-input-debounce | Input debounce for asynchronous commands | +| consult-async-input-throttle | Input throttle for asynchronous commands | +| consult-async-min-input | Minimum numbers of letters needed for async process | +| consult-async-refresh-delay | Refresh delay for asynchronous commands | +| consult-async-split-style | Splitting style used for async commands | +| consult-async-split-styles-alist | Available splitting styles used for async commands | +| consult-bookmark-narrow | Narrowing configuration for =consult-bookmark= | +| consult-buffer-filter | Filter for =consult-buffer= | +| consult-buffer-sources | List of virtual buffer sources | +| consult-find-args | Command line arguments for find | +| consult-fontify-max-size | Buffers larger than this limit are not fontified | +| consult-fontify-preserve | Preserve fontification for line-based commands. | +| consult-git-grep-args | Command line arguments for git-grep | +| consult-goto-line-numbers | Show line numbers for =consult-goto-line= | +| consult-grep-max-columns | Maximal number of columns of the matching lines | +| consult-grep-args | Command line arguments for grep | +| consult-imenu-config | Mode-specific configuration for =consult-imenu= | +| consult-line-numbers-widen | Show absolute line numbers when narrowing is active. | +| consult-line-point-placement | Placement of the point used by =consult-line= | +| consult-line-start-from-top | Start the =consult-line= search from the top | +| consult-locate-args | Command line arguments for locate | +| consult-man-args | Command line arguments for man | +| consult-mode-command-filter | Filter for =consult-mode-command= | +| consult-mode-histories | Mode-specific history variables | +| consult-narrow-key | Narrowing prefix key during completion | +| consult-preview-key | Keys which triggers preview | +| consult-preview-allowed-hooks | List of =find-file= hooks to enable during preview | +| consult-preview-excluded-files | Regexps matched against file names during preview | +| consult-preview-max-count | Maximum number of files to keep open during preview | +| consult-preview-max-size | Files larger than this size are not previewed | +| consult-preview-raw-size | Files larger than this size are previewed in raw form | +| consult-preview-variables | Alist of variables to bind during preview | +| consult-project-buffer-sources | List of virtual project buffer sources | +| consult-project-function | Function which returns current project root | +| consult-register-prefix | Prefix string for register keys during completion | +| 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 | + +** Fine-tuning of individual commands +:properties: +:alt_title: Fine-tuning +:description: Fine-grained configuration for special requirements +:end: + +*NOTE:* Consult supports fine-grained customization of individual commands. This +configuration feature exists for experienced users with special requirements. +There is the [[https://github.com/minad/consult/wiki][Consult wiki]], where we collect further configuration examples. + +Commands and buffer sources allow flexible, individual customization by using +the =consult-customize= macro. You can override any option passed to the internal +=consult--read= API. The [[https://github.com/minad/consult/wiki][Consult wiki]] already contains a numerous useful +configuration examples. Note that since =consult--read= is part of the internal +API, options could be removed, replaced or renamed in future versions of the +package. + +Useful options are: +- =:prompt= set the prompt string +- =:preview-key= set the preview key, default is =consult-preview-key= +- =:initial= set the initial input +- =:default= set the default value +- =:history= set the history variable symbol +- =:add-history= add items to the future history, for example symbol at point +- =:sort= enable or disable sorting +- =:group= set to nil to disable candidate grouping and titles. +- =:inherit-input-method= set to non-nil to inherit the input method. + +#+begin_src emacs-lisp + (consult-customize + ;; 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-.") + ;; 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>"))) +#+end_src + +The configuration values are evaluated at runtime, just before the completion +session is started. Therefore you can use for example =thing-at-point= to adjust +the initial input or the future history. + +#+begin_src emacs-lisp + (consult-customize + consult-line + :add-history (seq-some #'thing-at-point '(region symbol))) + + (defalias 'consult-line-thing-at-point 'consult-line) + + (consult-customize + consult-line-thing-at-point + :initial (thing-at-point 'symbol)) +#+end_src + +Generally it is possible to modify commands for your individual needs by the +following techniques: + +1. Use =consult-customize= in order to change the command or source settings. +2. Create your own wrapper function which passes modified arguments to the Consult functions. +3. Create your own buffer [[#multiple-sources][multi sources]] for =consult-buffer=. +4. Create advices to modify some internal behavior. +5. Write or propose a patch. + +* Recommended packages +:properties: +:description: Related packages recommended for installation +:end: + +I use and recommend this combination of packages: + +- consult: This package +- [[https://github.com/minad/vertico][vertico]]: Fast and minimal vertical completion system +- [[https://github.com/minad/marginalia][marginalia]]: Annotations for the completion candidates +- [[https://github.com/oantolin/embark][embark and embark-consult]]: Action commands, which can act on the completion candidates +- [[https://github.com/oantolin/orderless][orderless]]: Completion style which offers flexible candidate filtering + +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! + +- The builtin completion UI, which pops up the =*Completions*= buffer. +- The builtin =icomplete-vertical-mode= in Emacs 28. +- [[https://github.com/radian-software/selectrum][selectrum by Radon Rosborough]]: Alternative vertical UI, predecessor of Vertico. +- [[https://git.sr.ht/~protesilaos/mct][mct by Protesilaos Stavrou]]: Minibuffer and Completions in Tandem, which builds + on the default completion UI (development [[https://protesilaos.com/codelog/2022-04-14-emacs-discontinue-mct/][discontinued]]). + +You can integrated 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 [[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/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://gitlab.com/OlMon/consult-flyspell][consult-flyspell]]: Additional Flyspell integration. +- [[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. +- [[https://github.com/mclear-tools/consult-notes][consult-notes]]: Searching notes with Consult. +- [[https://github.com/jgru/consult-org-roam][consult-org-roam]]: Integration with [[https://github.com/org-roam/org-roam][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 [[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://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/minad/affe][affe]]: Asynchronous Fuzzy Finder for Emacs based on Consult. + +Not directly related to Consult, but maybe still of interest are the following +packages. These packages should work well with Consult, follow a similar spirit or +offer functionality based on ~completing-read~. + +- [[https://github.com/minad/corfu][corfu]]: Completion systems for =completion-at-point= using small popups (Alternative to [[https://github.com/company-mode/company-mode][Company]]). +- [[https://github.com/minad/cape][cape]]: Completion At Point Extensions, which can be used with =consult-completion-in-region= and [[https://github.com/minad/corfu][Corfu]]. +- [[https://github.com/minad/bookmark-view][bookmark-view]]: Store window configuration as bookmarks, possible integration with =consult-buffer=. +- [[https://github.com/bdarcus/citar][citar]]: Versatile package for citation insertion and bibliography management. +- [[https://github.com/astoff/devdocs.el][devdocs]]: Emacs viewer for [[https://devdocs.io/][DevDocs]] with a convenient completion interface. +- [[https://github.com/d12frosted/flyspell-correct][flyspell-correct]]: Apply spelling corrections by selecting via =completing-read=. +- [[https://github.com/mhayashi1120/Emacs-wgrep][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 +:end: + +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 + =vertico-mode=, =mct-mode=, =selectrum-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 + =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= + 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 + in the minimal configuration snippet. + +Minimal setup with Vertico for =emacs -Q=: +#+begin_src emacs-lisp +(package-initialize) +(require 'consult) +(require 'vertico) +(vertico-mode) +(setq completion-styles '(substring basic)) +#+end_src + +Minimal setup with the default completion system for =emacs -Q=: +#+begin_src emacs-lisp +(package-initialize) +(require 'consult) +(setq completion-styles '(substring basic)) +#+end_src + +Please provide the necessary important information with your bug report: + +- The minimal configuration snippet used to reproduce the issue. +- Your completion UI (Default completion, Vertico, Mct, Selectrum or Icomplete). +- A stack trace in case the bug triggers an exception. +- Your Emacs version, since bugs may be fixed or introduced in newer versions. +- Your operating system, since Emacs behavior varies between Linux, Mac and + Windows. +- The package manager, e.g., straight.el or package.el, used to install + the Emacs packages, in order to exclude update issues. Did you install + Consult as part of the Doom or Spacemacs Emacs distributions? +- Do you use Evil or other packages which apply deep changes? + 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]]. + +When evaluating Consult-related code snippets you should enable [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Lexical-Binding.html][lexical binding]]. +Consult often relies on lambdas and lexical closures. + +* Contributions +:properties: +:description: Feature requests and pull requests +:end: + +Consult is a community effort, please participate in the discussions. +Contributions are welcome, but you may want to discuss potential contributions +first. Since this package is part of [[http://elpa.gnu.org/packages/consult.html][GNU ELPA]] contributions require a copyright +assignment to the FSF. + +If you have a proposal, take a look at the [[https://github.com/consult/issues][Consult issue tracker]] and the [[https://github.com/minad/consult/issues/6][Consult +wishlist]]. There have been many prior feature discussions. Please search through +the issue tracker, maybe your issue or feature request has already been +discussed. You can contribute to the [[https://github.com/minad/consult/wiki][Consult wiki]], in case you want to share +small configuration or command snippets. + +* Acknowledgments +:properties: +:description: Contributors and Sources of Inspiration +:end: + +This package took inspiration from [[https://github.com/abo-abo/swiper#counsel][Counsel]] by Oleh Krehel. Some of the Consult +commands originated in the Counsel package or the [[https://github.com/radian-software/selectrum/wiki/Useful-Commands][Selectrum wiki]]. The commands +have been rewritten and greatly enhanced in comparison to the original versions. + +Code contributions: +- [[https://github.com/oantolin/][Omar Antolín Camarena]] +- [[https://github.com/s-kostyaev/][Sergey Kostyaev]] +- [[https://github.com/okamsn/][okamsn]] +- [[https://github.com/clemera/][Clemens Radermacher]] +- [[https://github.com/tomfitzhenry/][Tom Fitzhenry]] +- [[https://github.com/jakanakaevangeli][jakanakaevangeli]] +- [[https://hg.serna.eu][Iñigo Serna]] +- [[https://github.com/aspiers/][Adam Spiers]] +- [[https://github.com/omar-polo][Omar Polo]] +- [[https://github.com/astoff][Augusto Stoffel]] +- [[https://github.com/noctuid][Fox Kiester]] +- [[https://github.com/tecosaur][Tecosaur]] +- [[https://github.com/mohamed-abdelnour][Mohamed Abdelnour]] +- [[https://github.com/thisirs][Sylvain Rousseau]] +- [[https://github.com/jdtsmith][J.D. Smith]] +- [[https://github.com/mohkale][Mohsin Kaleem]] + +Advice and useful discussions: +- [[https://github.com/clemera/][Clemens Radermacher]] +- [[https://github.com/oantolin/][Omar Antolín Camarena]] +- [[https://protesilaos.com][Protesilaos Stavrou]] +- [[https://github.com/purcell/][Steve Purcell]] +- [[https://github.com/alphapapa/][Adam Porter]] +- [[https://github.com/manuel-uberti/][Manuel Uberti]] +- [[https://github.com/tomfitzhenry/][Tom Fitzhenry]] +- [[https://github.com/hmelman/][Howard Melman]] +- [[https://github.com/monnier/][Stefan Monnier]] +- [[https://github.com/dgutov/][Dmitry Gutov]] +- [[https://github.com/iyefrat][Itai Y. Efrat]] +- [[https://github.com/bdarcus][Bruce d'Arcus]] +- [[https://github.com/jdtsmith][J.D. Smith]] +- [[https://github.com/Qkessler][Enrique Kessler Martínez]] + +Authors of supplementary =consult-*= packages: + +- [[https://codeberg.org/jao/][Jose A Ortega Ruiz]] ([[https://codeberg.org/jao/consult-notmuch][consult-notmuch]], [[https://codeberg.org/jao/consult-recoll][consult-recoll]], [[https://codeberg.org/jao/espotify][consult-spotify]]) +- [[https://github.com/gagbo/][Gerry Agbobada]] ([[https://github.com/gagbo/consult-lsp][consult-lsp]]) +- [[https://github.com/karthink][Karthik Chikmagalur]] ([[https://github.com/karthink/consult-dir][consult-dir]]) +- [[https://github.com/mohkale][Mohsin Kaleem]] ([[https://github.com/mohkale/consult-company][consult-company]], [[https://github.com/mohkale/consult-eglot][consult-eglot]], [[https://github.com/mohkale/consult-yasnippet][consult-yasnippet]]) +- [[https://gitlab.com/OlMon][Marco Pawłowski]] ([[https://gitlab.com/OlMon/consult-flyspell][consult-flyspell]], [[https://gitlab.com/OlMon/consult-projectile][consult-projectile]]) +- [[https://github.com/Qkessler][Enrique Kessler Martínez]] ([[https://github.com/Qkessler/consult-project-extra][consult-project-extra]]) +- [[https://github.com/jgru][Jan Gru]] ([[https://github.com/jgru/consult-org-roam][consult-org-roam]]) +- [[https://github.com/yadex205][Kanon Kakuno]] ([[https://github.com/yadex205/consult-ag][consult-ag]]) +- [[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]]) + +#+html: <!-- + +* Indices +:properties: +:description: Indices of concepts and functions +:end: + +** Function index +:properties: +:description: List of all Consult commands +:index: fn +:end: + +** Concept index +:properties: +:description: List of all Consult-specific concepts +:index: cp +:end: + +#+html: --> diff --git a/elpa/consult-0.19/consult-autoloads.el b/elpa/consult-0.19/consult-autoloads.el @@ -0,0 +1,451 @@ +;;; consult-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + + +;;; Generated autoloads from consult.el + +(autoload 'consult-completion-in-region "consult" "\ +Use minibuffer completion as the UI for `completion-at-point'. + +The function is called with 4 arguments: START END COLLECTION PREDICATE. +The arguments and expected return value are as specified for +`completion-in-region'. Use as a value for `completion-in-region-function'. + +The function can be configured via `consult-customize'. + + (consult-customize consult-completion-in-region + :completion-styles (basic) + :cycle-threshold 3) + +These configuration options are supported: + + * :cycle-threshold - Cycling threshold (def: `completion-cycle-threshold') + * :completion-styles - Use completion styles (def: `completion-styles') + * :require-match - Require matches when completing (def: nil) + * :prompt - The prompt string shown in the minibuffer + +(fn START END COLLECTION &optional PREDICATE)" nil nil) +(autoload 'consult-multi-occur "consult" "\ +Improved version of `multi-occur' based on `completing-read-multiple'. + +See `multi-occur' for the meaning of the arguments BUFS, REGEXP and NLINES. + +(fn BUFS REGEXP &optional NLINES)" t nil) +(autoload 'consult-outline "consult" "\ +Jump to an outline heading, obtained by matching against `outline-regexp'. + +This command supports narrowing to a heading level and candidate preview. +The symbol at point is added to the future history." t nil) +(autoload 'consult-mark "consult" "\ +Jump to a marker in MARKERS list (defaults to buffer-local `mark-ring'). + +The command supports preview of the currently selected marker position. +The symbol at point is added to the future history. + +(fn &optional MARKERS)" t nil) +(autoload 'consult-global-mark "consult" "\ +Jump to a marker in MARKERS list (defaults to `global-mark-ring'). + +The command supports preview of the currently selected marker position. +The symbol at point is added to the future history. + +(fn &optional MARKERS)" t nil) +(autoload 'consult-line "consult" "\ +Search for a matching line. + +Depending on the setting `consult-line-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. + +(fn &optional INITIAL START)" t nil) +(autoload 'consult-line-multi "consult" "\ +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'. + +(fn QUERY &optional INITIAL)" t nil) +(autoload 'consult-keep-lines "consult" "\ +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 +command obeys narrowing. + +FILTER is the filter function. +INITIAL is the initial input. + +(fn &optional FILTER INITIAL)" t nil) +(autoload 'consult-focus-lines "consult" "\ +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. + +FILTER is the filter function. +INITIAL is the initial input. + +(fn &optional SHOW FILTER INITIAL)" t nil) +(autoload 'consult-goto-line "consult" "\ +Read line number and jump to the line with preview. + +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'. + +(fn &optional ARG)" t nil) +(autoload 'consult-recent-file "consult" "\ +Find recent file using `completing-read'." t nil) +(autoload 'consult-file-externally "consult" "\ +Open FILE externally using the default application of the system. + +(fn FILE)" t nil) +(autoload 'consult-mode-command "consult" "\ +Run a command from any of the given MODES. + +If no MODES are specified, use currently active major and minor modes. + +(fn &rest MODES)" t nil) +(autoload 'consult-yank-from-kill-ring "consult" "\ +Select STRING from the kill ring and insert it. +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 +version supports preview of the selected string. + +(fn STRING &optional ARG)" t nil) +(autoload 'consult-yank-pop "consult" "\ +If there is a recent yank act like `yank-pop'. + +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 +version supports preview of the selected string. + +(fn &optional ARG)" t nil) +(autoload 'consult-yank-replace "consult" "\ +Select STRING from the kill ring. + +If there was no recent yank, insert the string. +Otherwise replace the just-yanked string with the selected string. + +There exists no equivalent of this command in Emacs 28. + +(fn STRING)" t nil) +(autoload 'consult-bookmark "consult" "\ +If bookmark NAME exists, open it, otherwise create a new bookmark with NAME. + +The command supports preview of file bookmarks and narrowing. See the +variable `consult-bookmark-narrow' for the narrowing configuration. + +(fn NAME)" t nil) +(autoload 'consult-apropos "consult" "\ +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'." t nil) +(autoload 'consult-complex-command "consult" "\ +Select and evaluate command from the command history. + +This command can act as a drop-in replacement for `repeat-complex-command'." t nil) +(autoload 'consult-history "consult" "\ +Insert string from HISTORY of current buffer. +In order to select from a specific HISTORY, pass the history variable +as argument. See also `cape-history' from the Cape package. + +(fn &optional HISTORY)" t nil) +(autoload 'consult-isearch-history "consult" "\ +Read a search string with completion from the Isearch history. + +This replaces the current search string if Isearch is active, and +starts a new Isearch session otherwise." t nil) +(autoload 'consult-minor-mode-menu "consult" "\ +Enable or disable minor mode. + +This is an alternative to `minor-mode-menu-from-indicator'." t nil) +(autoload 'consult-theme "consult" "\ +Disable current themes and enable THEME from `consult-themes'. + +The command supports previewing the currently selected theme. + +(fn THEME)" t nil) +(autoload 'consult-buffer "consult" "\ +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), +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 +configuration of the virtual buffer sources. + +(fn &optional SOURCES)" t nil) +(autoload 'consult-project-buffer "consult" "\ +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." t nil) +(autoload 'consult-buffer-other-window "consult" "\ +Variant of `consult-buffer' which opens in other window." t nil) +(autoload 'consult-buffer-other-frame "consult" "\ +Variant of `consult-buffer' which opens in other frame." t nil) +(autoload 'consult-kmacro "consult" "\ +Run a chosen keyboard macro. + +With prefix ARG, run the macro that many times. +Macros containing mouse clicks are omitted. + +(fn ARG)" t nil) +(autoload 'consult-grep "consult" "\ +Search with `grep' for files in DIR where the content matches a regexp. + +The initial input is given by the INITIAL argument. + +The input string is split, the first part of the string (grep input) is +passed to the asynchronous grep process and the second part of the string is +passed to the completion-style filtering. + +The input string is split at a punctuation character, which is given as the +first character of the input string. The format is similar to Perl-style +regular expressions, e.g., /regexp/. Furthermore command line options can be +passed to grep, specified behind --. The overall prompt input has the form +`#async-input -- grep-opts#filter-string'. + +Note that the grep input string is transformed from Emacs regular expressions +to Posix regular expressions. Always enter Emacs regular expressions at the +prompt. `consult-grep' behaves like builtin Emacs search commands, e.g., +Isearch, which take Emacs regular expressions. Furthermore the asynchronous +input split into words, each word must match separately and in any order. See +`consult--regexp-compiler' for the inner workings. In order to disable +transformations of the grep input, adjust `consult--regexp-compiler' +accordingly. + +Here we give a few example inputs: + +#alpha beta : Search for alpha and beta in any order. +#alpha.*beta : Search for alpha before beta. +#\\(alpha\\|beta\\) : Search for alpha or beta (Note Emacs syntax!) +#word -- -C3 : Search for word, include 3 lines as context +#first#second : Search for first, quick filter for second. + +The symbol at point is added to the future history. If `consult-grep' +is called interactively with a prefix argument, the user can specify +the directory to search in. By default the project directory is used +if `consult-project-function' is defined and returns non-nil. +Otherwise the `default-directory' is searched. + +(fn &optional DIR INITIAL)" t nil) +(autoload 'consult-git-grep "consult" "\ +Search with `git grep' for files in DIR where the content matches a regexp. +The initial input is given by the INITIAL argument. See `consult-grep' +for more details. + +(fn &optional DIR INITIAL)" t nil) +(autoload 'consult-ripgrep "consult" "\ +Search with `rg' for files in DIR where the content matches a regexp. +The initial input is given by the INITIAL argument. See `consult-grep' +for more details. + +(fn &optional DIR INITIAL)" t nil) +(autoload 'consult-find "consult" "\ +Search for files in DIR matching input regexp given INITIAL input. + +The find process is started asynchronously, similar to `consult-grep'. +See `consult-grep' for more details regarding the asynchronous search. + +(fn &optional DIR INITIAL)" t nil) +(autoload 'consult-locate "consult" "\ +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 +details regarding the asynchronous search. + +(fn &optional INITIAL)" t nil) +(autoload 'consult-man "consult" "\ +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 +the asynchronous search. + +(fn &optional INITIAL)" t nil) +(register-definition-prefixes "consult" '("consult-")) + + +;;; Generated autoloads from consult-compile.el + +(autoload 'consult-compile-error "consult-compile" "\ +Jump to a compilation error in the current buffer. + +This command collects entries from compilation buffers and grep +buffers related to the current buffer. The command supports +preview of the currently selected error." t nil) +(register-definition-prefixes "consult-compile" '("consult-compile--")) + + +;;; Generated autoloads from consult-flymake.el + +(autoload 'consult-flymake "consult-flymake" "\ +Jump to Flymake diagnostic. +When PROJECT is non-nil then prompt with diagnostics from all +buffers in the current project instead of just the current buffer. + +(fn &optional PROJECT)" t nil) +(register-definition-prefixes "consult-flymake" '("consult-flymake--")) + + +;;; Generated autoloads from consult-icomplete.el + +(register-definition-prefixes "consult-icomplete" '("consult-icomplete--refresh")) + + +;;; Generated autoloads from consult-imenu.el + +(autoload 'consult-imenu "consult-imenu" "\ +Select item from flattened `imenu' using `completing-read' with preview. + +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'." t nil) +(autoload 'consult-imenu-multi "consult-imenu" "\ +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, +QUERY can be set to a plist according to `consult--buffer-query'. + +(fn &optional QUERY)" t nil) +(register-definition-prefixes "consult-imenu" '("consult-imenu-")) + + +;;; Generated autoloads from consult-org.el + +(autoload 'consult-org-heading "consult-org" "\ +Jump to an Org heading. + +MATCH and SCOPE are as in `org-map-entries' and determine which +entries are offered. By default, all entries of the current +buffer are offered. + +(fn &optional MATCH SCOPE)" t nil) +(autoload 'consult-org-agenda "consult-org" "\ +Jump to an Org agenda heading. + +By default, all agenda entries are offered. MATCH is as in +`org-map-entries' and can used to refine this. + +(fn &optional MATCH)" t nil) +(register-definition-prefixes "consult-org" '("consult-org--")) + + +;;; Generated autoloads from consult-register.el + +(autoload 'consult-register-window "consult-register" "\ +Enhanced drop-in replacement for `register-preview'. + +BUFFER is the window buffer. +SHOW-EMPTY must be t if the window should be shown for an empty register list. + +(fn BUFFER &optional SHOW-EMPTY)" nil nil) +(autoload 'consult-register-format "consult-register" "\ +Enhanced preview of register REG. +This function can be used as `register-preview-function'. +If COMPLETION is non-nil format the register for completion. + +(fn REG &optional COMPLETION)" nil nil) +(autoload 'consult-register "consult-register" "\ +Load register and either jump to location or insert the stored text. + +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 +`jump-to-register' and `insert-register' for the meaning of prefix ARG. + +(fn &optional ARG)" t nil) +(autoload 'consult-register-load "consult-register" "\ +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 the meaning of prefix ARG. + +(fn REG &optional ARG)" t nil) +(autoload 'consult-register-store "consult-register" "\ +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 +kmacro. + +(fn ARG)" t nil) +(register-definition-prefixes "consult-register" '("consult-register-")) + + +;;; Generated autoloads from consult-selectrum.el + +(register-definition-prefixes "consult-selectrum" '("consult-selectrum--")) + + +;;; Generated autoloads from consult-vertico.el + +(register-definition-prefixes "consult-vertico" '("consult-vertico--")) + + +;;; Generated autoloads from consult-xref.el + +(autoload 'consult-xref "consult-xref" "\ +Show xrefs with preview in the minibuffer. + +This function can be used for `xref-show-xrefs-function'. +See `xref-show-xrefs-function' for the description of the +FETCHER and ALIST arguments. + +(fn FETCHER &optional ALIST)" nil nil) +(register-definition-prefixes "consult-xref" '("consult-xref--")) + +;;; End of scraped data + +(provide 'consult-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8-emacs-unix +;; End: + +;;; consult-autoloads.el ends here diff --git a/elpa/consult-0.19/consult-compile.el b/elpa/consult-0.19/consult-compile.el @@ -0,0 +1,127 @@ +;;; consult-compile.el --- Provides the command `consult-compile-error' -*- 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; 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: + +(require 'consult) +(require 'compile) + +(defvar consult-compile--history nil) + +(defconst consult-compile--narrow + '((?e . "Error") + (?w . "Warning") + (?i . "Info"))) + +(defun consult-compile--font-lock (str) + "Apply `font-lock' faces in STR, copy them to `face'." + (let ((pos 0) (len (length str))) + (while (< pos len) + (let* ((face (get-text-property pos 'font-lock-face str)) + (end (or (text-property-not-all pos len 'font-lock-face face str) len))) + (put-text-property pos end 'face face str) + (setq pos end))) + str)) + +(defun consult-compile--error-candidates (buffer) + "Return alist of errors and positions in BUFFER, a compilation buffer." + (with-current-buffer buffer + (let ((candidates) + (pos (point-min))) + (save-excursion + (while (setq pos (compilation-next-single-property-change pos 'compilation-message)) + (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--type (pcase (compilation--message->type msg) + (0 ?i) + (1 ?w) + (_ ?e)) + 'consult--candidate (point-marker)) + candidates)))) + (nreverse candidates)))) + +(defun consult-compile--lookup (marker) + "Lookup error position given error MARKER." + (when-let (buffer (and marker (marker-buffer marker))) + (with-current-buffer buffer + (let ((next-error-highlight nil) + (compilation-current-error marker) + (overlay-arrow-position overlay-arrow-position)) + (ignore-errors + (save-window-excursion + (compilation-next-error-function 0) + (point-marker))))))) + +(defun consult-compile--compilation-buffers (file) + "Return a list of compilation buffers relevant to FILE." + (consult--buffer-query + :sort 'alpha :predicate + (lambda (buffer) + (with-current-buffer buffer + (and (compilation-buffer-internal-p) + (file-in-directory-p file default-directory)))))) + +(defun consult-compile--state () + "Like `consult--jump-state', also setting the current compilation error." + (let ((state (consult--jump-state 'consult-preview-error))) + (lambda (action marker) + (let ((pos (consult-compile--lookup marker))) + (when-let (buffer (and (eq action 'return) + marker + (marker-buffer marker))) + (with-current-buffer buffer + (setq compilation-current-error marker + overlay-arrow-position marker))) + (funcall state action pos))))) + +;;;###autoload +(defun consult-compile-error () + "Jump to a compilation error in the current buffer. + +This command collects entries from compilation buffers and grep +buffers related to the current buffer. The command supports +preview of the currently selected error." + (interactive) + (consult--read + (or (mapcan #'consult-compile--error-candidates + (or (consult-compile--compilation-buffers + default-directory) + (user-error "No compilation buffers found for the current buffer"))) + (user-error "No compilation errors found")) + :prompt "Go to error: " + :category 'consult-compile-error + :sort nil + :require-match t + :history t ;; disable history + :lookup #'consult--lookup-candidate + :group (consult--type-group consult-compile--narrow) + :narrow (consult--type-narrow consult-compile--narrow) + :history '(:input consult-compile--history) + :state (consult-compile--state))) + +(provide 'consult-compile) +;;; consult-compile.el ends here diff --git a/elpa/consult-0.19/consult-flymake.el b/elpa/consult-0.19/consult-flymake.el @@ -0,0 +1,114 @@ +;;; consult-flymake.el --- Provides the command `consult-flymake' -*- 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Provides the command `consult-flymake'. This is an extra package, +;; to allow lazy loading of flymake.el. The `consult-flymake' command +;; is autoloaded. + +;;; Code: + +(require 'consult) +(require 'flymake) + +(defconst consult-flymake--narrow + '((?e . "Error") + (?w . "Warning") + (?n . "Note"))) + +(defun consult-flymake--candidates (diags) + "Return Flymake errors from DIAGS as formatted candidates. +DIAGS should be a list of diagnostics as returned from `flymake-diagnostics'." + (let* ((diags + (mapcar + (lambda (diag) + (let ((buffer (flymake-diagnostic-buffer diag)) + (type (flymake-diagnostic-type diag))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char (flymake-diagnostic-beg diag)) + (list (buffer-name buffer) + (line-number-at-pos) + type + (flymake-diagnostic-text diag) + (point-marker) + (pcase (flymake--lookup-type-property type 'flymake-category) + ('flymake-error ?e) + ('flymake-warning ?w) + (_ ?n)))))))) + 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))) + (mapcar + (pcase-lambda (`(,buffer ,line ,type ,text ,marker ,narrow)) + (propertize (format fmt buffer line + (propertize (format "%s" (flymake--lookup-type-property + type 'flymake-type-name type)) + 'face (flymake--lookup-type-property + type 'mode-line-face 'flymake-error)) + text) + 'consult--candidate marker + 'consult--type narrow)) + ;; Sort by buffer, severity and position. + (sort diags + (pcase-lambda (`(,b1 _ ,t1 _ ,m1 _) `(,b2 _ ,t2 _ ,m2 _)) + (let ((s1 (flymake--severity t1)) + (s2 (flymake--severity t2))) + (or + (string-lessp b1 b2) + (and (string-equal b1 b2) + (or + (> s1 s2) + (and (= s1 s2) + (< m1 m2))))))))))) + +;;;###autoload +(defun consult-flymake (&optional project) + "Jump to Flymake diagnostic. +When PROJECT is non-nil then prompt with diagnostics from all +buffers in the current project instead of just the current buffer." + (interactive "P") + (consult--forbid-minibuffer) + (consult--read + (consult-flymake--candidates + (or + (if-let (((and project (fboundp 'flymake--project-diagnostics))) + (project (project-current))) + (flymake--project-diagnostics project) + (flymake-diagnostics)) + (user-error "No flymake errors (Status: %s)" + (if (seq-difference (flymake-running-backends) + (flymake-reporting-backends)) + 'running 'finished)))) + :prompt "Flymake diagnostic: " + :category 'consult-flymake-error + :history t ;; disable history + :require-match t + :sort nil + :group (consult--type-group consult-flymake--narrow) + :narrow (consult--type-narrow consult-flymake--narrow) + :lookup #'consult--lookup-candidate + :state (consult--jump-state 'consult-preview-error))) + +(provide 'consult-flymake) +;;; consult-flymake.el ends here diff --git a/elpa/consult-0.17/consult-icomplete.el b/elpa/consult-0.19/consult-icomplete.el diff --git a/elpa/consult-0.19/consult-imenu.el b/elpa/consult-0.19/consult-imenu.el @@ -0,0 +1,242 @@ +;;; consult-imenu.el --- Consult commands for imenu -*- 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Provides imenu-related Consult commands. + +;;; Code: + +(require 'consult) +(require 'imenu) + +(defcustom consult-imenu-config + '((emacs-lisp-mode :toplevel "Functions" + :types ((?f "Functions" font-lock-function-name-face) + (?m "Macros" font-lock-function-name-face) + (?p "Packages" font-lock-constant-face) + (?t "Types" font-lock-type-face) + (?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." + :type '(repeat (cons symbol plist)) + :group 'consult) + +(defface consult-imenu-prefix + '((t :inherit consult-key)) + "Face used to highlight imenu prefix in `consult-imenu'." + :group 'consult-faces) + +(defvar consult-imenu--history nil) +(defvar-local consult-imenu--cache nil) + +(defun consult-imenu--special (_name pos buf name fn &rest args) + "Wrapper function for special imenu items. + +POS is the position. +BUF is the buffer. +NAME is the item name. +FN is the original special item function. +ARGS are the arguments to the special item function." + (funcall consult--buffer-display buf) + (apply fn name pos args)) + +(defun consult-imenu--flatten (prefix face list types) + "Flatten imenu LIST. + +PREFIX is prepended in front of all items. +FACE is the item face. +TYPES is the mode-specific types configuration." + (mapcan + (lambda (item) + (if (imenu--subalist-p item) + (let* ((name (concat (car item))) + (next-prefix name) + (next-face face)) + (add-face-text-property 0 (length name) + 'consult-imenu-prefix 'append name) + (if prefix + (setq next-prefix (concat prefix "/" name)) + (when-let (type (cdr (assoc name types))) + (put-text-property 0 (length name) 'consult--type (car type) name) + (setq next-face (cadr type)))) + (consult-imenu--flatten next-prefix next-face (cdr item) types)) + (let ((name (car item)) + (payload (cdr item))) + (list (cons + (if prefix + (let ((key (concat prefix " " name))) + (add-face-text-property (1+ (length prefix)) (length key) + face 'append key) + key) + name) + (pcase payload + ;; Simple marker item + ((pred markerp) payload) + ;; Simple integer item + ((pred integerp) (copy-marker payload)) + ;; Semantic uses overlay for positions + ((pred overlayp) (copy-marker (overlay-start payload))) + ;; Wrap special item + (`(,pos ,fn . ,args) + (nconc + (list pos #'consult-imenu--special (current-buffer) name fn) + args)) + (_ (error "Unknown imenu item: %S" item)))))))) + list)) + +(defun consult-imenu--compute () + "Compute imenu candidates." + (consult--forbid-minibuffer) + (let* ((imenu-use-markers t) + ;; Generate imenu, see `imenu--make-index-alist'. + (items (imenu--truncate-items + (save-excursion + (save-restriction + (widen) + (funcall imenu-create-index-function))))) + (config (cdr (seq-find (lambda (x) (derived-mode-p (car x))) consult-imenu-config)))) + ;; Fix toplevel items, e.g., emacs-lisp-mode toplevel items are functions + (when-let (toplevel (plist-get config :toplevel)) + (let ((tops (seq-remove (lambda (x) (listp (cdr x))) items)) + (rest (seq-filter (lambda (x) (listp (cdr x))) items))) + (setq items (nconc rest (and tops (list (cons toplevel tops))))))) + ;; Apply our flattening in order to ease searching the imenu. + (consult-imenu--flatten + nil nil items + (mapcar (pcase-lambda (`(,x ,y ,z)) (list y x z)) + (plist-get config :types))))) + +(defun consult-imenu--deduplicate (items) + "Deduplicate imenu ITEMS by appending a counter." + ;; Some imenu backends generate duplicate items (e.g. for overloaded methods in java) + (let ((ht (make-hash-table :test #'equal :size (length items)))) + (dolist (item items) + (if-let (count (gethash (car item) ht)) + (setcar item (format "%s (%s)" (car item) + (puthash (car item) (1+ count) ht))) + (puthash (car item) 0 ht))))) + +(defun consult-imenu--items () + "Return cached imenu candidates, may error." + (unless (equal (car consult-imenu--cache) (buffer-modified-tick)) + (setq consult-imenu--cache (cons (buffer-modified-tick) (consult-imenu--compute)))) + (cdr consult-imenu--cache)) + +(defun consult-imenu--items-safe () + "Return cached imenu candidates, will not error." + (condition-case err + (consult-imenu--items) + (t (message "Cannot create Imenu for buffer %s (%s)" + (buffer-name) (error-message-string err)) + nil))) + +(defun consult-imenu--multi-items (buffers) + "Return all imenu items from BUFFERS." + (apply #'append (consult--buffer-map buffers #'consult-imenu--items-safe))) + +(defun consult-imenu--jump (item) + "Jump to imenu ITEM via `consult--jump'. +In contrast to the builtin `imenu' jump function, +this function can jump across buffers." + (pcase item + (`(,name ,pos ,fn . ,args) (apply fn name pos args)) + (`(,_ . ,pos) (consult--jump pos)) + (_ (error "Unknown imenu item: %S" item)))) + +(defun consult-imenu--narrow () + "Return narrowing configuration for the current buffer." + (mapcar (lambda (x) (cons (car x) (cadr x))) + (plist-get (cdr (seq-find (lambda (x) (derived-mode-p (car x))) + consult-imenu-config)) + :types))) + +(defun consult-imenu--group () + "Create a imenu group function for the current buffer." + (when-let (narrow (consult-imenu--narrow)) + (lambda (cand transform) + (let ((type (get-text-property 0 'consult--type cand))) + (cond + ((and transform type) + (substring cand (1+ (next-single-property-change 0 'consult--type cand)))) + (transform cand) + (type (alist-get type narrow))))))) + +(defun consult-imenu--select (prompt items) + "Select from imenu ITEMS given PROMPT string." + (consult-imenu--deduplicate items) + (consult-imenu--jump + (consult--read + (or items (user-error "Imenu is empty")) + :state + (let ((preview (consult--jump-preview))) + (lambda (action cand) + ;; Only preview simple menu items which are markers, + ;; in order to avoid any bad side effects. + (funcall preview action (and (markerp (cdr cand)) (cdr cand))))) + :narrow + (when-let (narrow (consult-imenu--narrow)) + (list :predicate + (lambda (cand) + (eq (get-text-property 0 'consult--type (car cand)) consult--narrow)) + :keys narrow)) + :group (consult-imenu--group) + :prompt prompt + :require-match t + :category 'imenu + :lookup #'consult--lookup-cons + :history 'consult-imenu--history + :add-history (thing-at-point 'symbol) + :sort nil))) + +;;;###autoload +(defun consult-imenu () + "Select item from flattened `imenu' using `completing-read' with preview. + +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))) + +;;;###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, +QUERY can be set to a plist according to `consult--buffer-query'." + (interactive "P") + (unless (keywordp (car-safe query)) + (setq query (list :sort 'alpha :mode major-mode + :directory (and (not query) 'project)))) + (let ((buffers (consult--buffer-query-prompt "Go to item" query))) + (consult-imenu--select (car buffers) + (consult-imenu--multi-items (cdr buffers))))) + +(provide 'consult-imenu) +;;; consult-imenu.el ends here diff --git a/elpa/consult-0.19/consult-org.el b/elpa/consult-0.19/consult-org.el @@ -0,0 +1,126 @@ +;;; consult-org.el --- Consult commands for org-mode -*- 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Provides a `completing-read' interface for Org mode navigation. +;; This is an extra package, to allow lazy loading of Org. + +;;; Code: + +(require 'consult) +(require 'org) + +(defvar consult-org--history nil) + +(defun consult-org--narrow () + "Narrowing configuration for `consult-org' commands." + (let ((todo-kws + (seq-filter + (lambda (x) (<= ?a (car x) ?z)) + (mapcar (lambda (s) + (pcase-let ((`(,a ,b) (split-string s "("))) + (cons (downcase (string-to-char (or b a))) a))) + (apply #'append (mapcar #'cdr org-todo-keywords)))))) + (list :predicate + (lambda (cand) + (pcase-let ((`(,level ,todo . ,prio) + (get-text-property 0 'consult-org--heading cand))) + (cond + ((<= ?1 consult--narrow ?9) (<= level (- consult--narrow ?0))) + ((<= ?A consult--narrow ?Z) (eq prio consult--narrow)) + (t (equal todo (alist-get consult--narrow todo-kws)))))) + :keys + (nconc (mapcar (lambda (c) (cons c (format "Level %c" c))) + (number-sequence ?1 ?9)) + (mapcar (lambda (c) (cons c (format "Priority %c" c))) + (number-sequence (max ?A org-highest-priority) + (min ?Z org-lowest-priority))) + todo-kws)))) + +(defun consult-org--headings (prefix match scope &rest skip) + "Return a list of Org heading candidates. + +If PREFIX is non-nil, prefix the candidates with the buffer name. +MATCH, SCOPE and SKIP are as in `org-map-entries'." + (let (buffer) + (apply + #'org-map-entries + (lambda () + ;; Reset the cache when the buffer changes, since `org-get-outline-path' uses the cache + (unless (eq buffer (buffer-name)) + (setq buffer (buffer-name) + org-outline-path-cache nil)) + (pcase-let ((`(_ ,level ,todo ,prio ,_hl ,tags) (org-heading-components)) + (cand (org-format-outline-path + (org-get-outline-path 'with-self 'use-cache) + most-positive-fixnum))) + (when tags + (setq tags (concat " " (propertize tags 'face 'org-tag)))) + (setq cand (if prefix + (concat buffer " " cand tags (consult--tofu-encode (point))) + (concat cand tags (consult--tofu-encode (point))))) + (add-text-properties 0 1 + `(consult--candidate ,(point-marker) + consult-org--heading (,level ,todo . ,prio)) + cand) + cand)) + match scope skip))) + +;;;###autoload +(defun consult-org-heading (&optional match scope) + "Jump to an Org heading. + +MATCH and SCOPE are as in `org-map-entries' and determine which +entries are offered. By default, all entries of the current +buffer are offered." + (interactive (unless (derived-mode-p 'org-mode) + (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) + :prompt "Go to heading: " + :category 'consult-org-heading + :sort nil + :require-match t + :history '(:input consult-org--history) + :narrow (consult-org--narrow) + :state (consult--jump-state) + :group + (when prefix + (lambda (cand transform) + (let ((name (buffer-name + (marker-buffer + (get-text-property 0 'consult--candidate cand))))) + (if transform (substring cand (1+ (length name))) name)))) + :lookup #'consult--lookup-candidate))) + +;;;###autoload +(defun consult-org-agenda (&optional match) + "Jump to an Org agenda heading. + +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 + (user-error "No agenda files")) + (consult-org-heading match 'agenda)) + +(provide 'consult-org) +;;; consult-org.el ends here diff --git a/elpa/consult-0.19/consult-pkg.el b/elpa/consult-0.19/consult-pkg.el @@ -0,0 +1,2 @@ +;; Generated package description from consult.el -*- no-byte-compile: t -*- +(define-package "consult" "0.19" "Consulting completing-read" '((emacs "27.1") (compat "28.1")) :commit "ef3aad65e41e425fbcc80c4a9a1f6fc4cafff383" :authors '(("Daniel Mendler and Consult contributors")) :maintainer '("Daniel Mendler" . "mail@daniel-mendler.de") :url "https://github.com/minad/consult") diff --git a/elpa/consult-0.19/consult-register.el b/elpa/consult-0.19/consult-register.el @@ -0,0 +1,313 @@ +;;; consult-register.el --- Consult commands for registers -*- 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Provides register-related Consult commands. + +;;; Code: + +(require 'consult) + +(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) + +(defvar consult-register--narrow + '((?n . "Number") + (?s . "String") + (?p . "Point") + (?r . "Rectangle") + (?t . "Frameset") + (?k . "Kmacro") + (?f . "File") + (?w . "Window")) + "Register type names. +Each element of the list must have the form \\='(char . name).") + +(cl-defun consult-register--format-value (val) + "Format generic register VAL as string." + (with-output-to-string (register-val-describe val nil))) + +(cl-defgeneric consult-register--describe (val) + "Describe generic register VAL." + (list (consult-register--format-value val))) + +(cl-defmethod consult-register--describe ((val number)) + "Describe numeric register VAL." + (list (consult-register--format-value val) 'consult--type ?n)) + +(cl-defmethod consult-register--describe ((val string)) + "Describe string register VAL." + (list val 'consult--type + (if (eq (car (get-text-property 0 'yank-handler val)) + 'rectangle--insert-for-yank) + ?r ?s))) + +(cl-defmethod consult-register--describe ((val marker)) + "Describe marker register VAL." + (with-current-buffer (marker-buffer val) + (save-restriction + (save-excursion + (widen) + (goto-char val) + (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) + 'multi-category `(consult-location . ,str) + 'consult--type ?p)))))) + +(cl-defmethod consult-register--describe ((val kmacro-register)) + "Describe kmacro register VAL." + (list (consult-register--format-value val) 'consult--type ?k)) + +(cl-defmethod consult-register--describe ((val (head file))) + "Describe file register VAL." + (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 file-query))) + "Describe file-query register VAL." + (list (format "%s at position %d" + (propertize (abbreviate-file-name (cadr val)) + 'face 'consult-file) + (caddr val)) + 'consult--type ?f 'multi-category `(file . ,(cadr val)))) + +(cl-defmethod consult-register--describe ((val cons)) + "Describe rectangle or window-configuration register VAL." + (cond + ((stringp (car val)) + (list (string-join val "\n") 'consult--type ?r)) + ((window-configuration-p (car val)) + (list (consult-register--format-value val) + 'consult--type ?w)) + (t (list (consult-register--format-value val))))) + +(with-eval-after-load 'frameset + (cl-defmethod consult-register--describe ((val frameset-register)) + "Describe frameset register VAL." + (list (consult-register--format-value val) 'consult--type ?t))) + +;;;###autoload +(defun consult-register-window (buffer &optional show-empty) + "Enhanced drop-in replacement for `register-preview'. + +BUFFER is the window buffer. +SHOW-EMPTY must be t if the window should be shown for an empty register list." + (let ((regs (consult-register--alist 'noerror)) + (separator + (and (display-graphic-p) + (propertize #(" \n" 0 1 (display (space :align-to right))) + 'face '(:inherit consult-separator :height 1 :underline t))))) + (when (or show-empty regs) + (with-current-buffer-window buffer + (cons 'display-buffer-at-bottom + '((window-height . fit-window-to-buffer) + (preserve-size . (nil . t)))) + nil + (setq-local cursor-in-non-selected-windows nil + mode-line-format nil + truncate-lines t + window-min-height 1 + window-resize-pixelwise t) + (insert (mapconcat + (lambda (reg) + (concat (funcall register-preview-function reg) separator)) + regs nil)))))) + +;;;###autoload +(defun consult-register-format (reg &optional completion) + "Enhanced preview of register REG. +This function can be used as `register-preview-function'. +If COMPLETION is non-nil format the register for completion." + (pcase-let* ((`(,key . ,val) reg) + (key-str (propertize (single-key-description key) 'face 'consult-key)) + (key-len (max 3 (length key-str))) + (`(,str . ,props) (consult-register--describe val))) + (when (string-search "\n" str) + (let* ((lines (seq-take (seq-remove #'string-blank-p (split-string str "\n")) 3)) + (space (apply #'min most-positive-fixnum + (mapcar (lambda (x) (string-match-p "[^ ]" x)) lines)))) + (setq str (mapconcat (lambda (x) (substring x space)) + lines (concat "\n" (make-string (1+ key-len) ?\s)))))) + (setq str (concat + (and completion consult-register-prefix) + key-str (make-string (- key-len (length key-str)) ?\s) " " + str (and (not completion) "\n"))) + (when completion + (add-text-properties + 0 (length str) + `(consult--candidate ,(car reg) ,@props) + str)) + str)) + +(defun consult-register--alist (&optional noerror) + "Return sorted register list. +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) + (and (not noerror) (user-error "All registers are empty")))) + +;;;###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 +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 +`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)) + :prompt "Register: " + :category 'multi-category + :state + (let ((preview (consult--jump-preview))) + (lambda (action cand) + ;; Preview only markers + (funcall preview action + (when-let (reg (get-register cand)) + (and (markerp reg) reg))))) + :group (consult--type-group consult-register--narrow) + :narrow (consult--type-narrow consult-register--narrow) + :sort nil + :require-match t + :history t ;; disable history + :lookup #'consult--lookup-candidate) + arg)) + +;;;###autoload +(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 the meaning of prefix ARG." + (interactive + (list + (and (consult-register--alist) + (register-read-with-preview "Load register: ")) + current-prefix-arg)) + (condition-case err + (jump-to-register reg arg) + (user-error + (unless (string-search "access aborted" (error-message-string err)) + (insert-register reg (not arg)))))) + +(defun consult-register--action (action-list) + "Read register key and execute action from ACTION-LIST. + +This function is derived from `register-read-with-preview'." + (let* ((buffer "*Register Preview*") + (prefix (car action-list)) + (action-list (cdr action-list)) + (action (car (nth 0 action-list))) + (preview + (lambda () + (unless (get-buffer-window buffer) + (register-preview buffer 'show-empty) + (when-let (win (get-buffer-window buffer)) + (with-selected-window win + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (insert + (propertize (concat prefix ": ") 'face 'consult-help) + (mapconcat + (lambda (x) + (concat (propertize (format "M-%c" (car x)) 'face 'consult-key) + " " (propertize (cadr x) 'face 'consult-help))) + action-list " ")) + (fit-window-to-buffer))))))) + (timer (when (numberp register-preview-delay) + (run-at-time register-preview-delay nil preview))) + (help-chars (seq-remove #'get-register (cons help-char help-event-list))) + key reg) + (unwind-protect + (while (not reg) + (while (memq (setq key + (read-key (propertize (caddr (assq action action-list)) + 'face 'minibuffer-prompt))) + help-chars) + (funcall preview)) + (setq key (if (and (eql key ?\e) (characterp last-input-event)) + ;; in terminal Emacs M-letter is read as two keys, ESC and the letter, + ;; use what would have been read in graphical Emacs + (logior #x8000000 last-input-event) + last-input-event)) + (cond + ((or (eq ?\C-g key) + (eq 'escape key) + (eq ?\C-\[ key)) + (keyboard-quit)) + ((and (numberp key) (assq (logxor #x8000000 key) action-list)) + (setq action (logxor #x8000000 key))) + ((characterp key) + (setq reg key)) + (t (error "Non-character input")))) + (when (timerp timer) + (cancel-timer timer)) + (let ((w (get-buffer-window buffer))) + (when (window-live-p w) + (delete-window w))) + (when (get-buffer buffer) + (kill-buffer buffer))) + (when reg + (funcall (cadddr (assq action action-list)) reg)))) + +;;;###autoload +(defun consult-register-store (arg) + "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 +kmacro." + (interactive "P") + (consult-register--action + (cond + ((use-region-p) + (let ((beg (region-beginning)) + (end (region-end))) + `("Region" + (?c "copy" "Copy region to register: " ,(lambda (r) (copy-to-register r beg end arg t))) + (?a "append" "Append region to register: " ,(lambda (r) (append-to-register r beg end arg))) + (?p "prepend" "Prepend region to register: " ,(lambda (r) (prepend-to-register r beg end arg)))))) + ((numberp arg) + `(,(format "Number %s" arg) + (?s "store" ,(format "Store %s in register: " arg) ,(lambda (r) (number-to-register arg r))) + (?a "add" ,(format "Add %s to register: " arg) ,(lambda (r) (increment-register arg r))))) + (t + `("Store" + (?p "point" "Point to register: " ,#'point-to-register) + (?f "file" "File to register: " ,(lambda (r) (set-register r `(file . ,(buffer-file-name))))) + (?t "frameset" "Frameset to register: " ,#'frameset-to-register) + (?w "window" "Window to register: " ,#'window-configuration-to-register) + ,@(and last-kbd-macro `((?k "kmacro" "Kmacro to register: " ,#'kmacro-to-register)))))))) + +(provide 'consult-register) +;;; consult-register.el ends here diff --git a/elpa/consult-0.19/consult-selectrum.el b/elpa/consult-0.19/consult-selectrum.el @@ -0,0 +1,96 @@ +;;; 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 <http://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)))) + +(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) + +(provide 'consult-selectrum) +;;; consult-selectrum.el ends here diff --git a/elpa/consult-0.17/consult-vertico.el b/elpa/consult-0.19/consult-vertico.el diff --git a/elpa/consult-0.19/consult-xref.el b/elpa/consult-0.19/consult-xref.el @@ -0,0 +1,122 @@ +;;; consult-xref.el --- Xref 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Provides Xref integration for Consult. This is an extra package, to +;; allow lazy loading of xref.el. The `consult-xref' function is +;; autoloaded. + +;;; Code: + +(require 'consult) +(require 'xref) + +(defvar consult-xref--history nil) +(defvar consult-xref--fetcher nil) + +(defun consult-xref--candidates () + "Return xref candidate list." + (let ((root (consult--project-root))) + (mapcar (lambda (xref) + (let* ((loc (xref-item-location xref)) + (group (if (fboundp 'xref--group-name-for-display) + ;; This function is available in xref 1.3.2 + (xref--group-name-for-display + (xref-location-group loc) root) + (xref-location-group loc))) + (cand (consult--format-location + group + (or (xref-location-line loc) 0) + (xref-item-summary xref)))) + (add-text-properties + 0 1 `(consult-xref ,xref consult-xref--group ,group) cand) + cand)) + (funcall consult-xref--fetcher)))) + +(defun consult-xref--preview (display) + "Xref preview with DISPLAY function." + (let ((open (consult--temporary-files)) + (preview (consult--jump-preview))) + (lambda (action cand) + (unless cand + (funcall open)) + (let ((consult--buffer-display display)) + (funcall preview action + (when-let (loc (and cand (eq action 'preview) + (xref-item-location cand))) + (let ((type (type-of loc))) + ;; Only preview file and buffer markers + (pcase type + ('xref-buffer-location + (xref-location-marker loc)) + ((or 'xref-file-location 'xref-etags-location) + (consult--position-marker + (funcall open + ;; xref-location-group returns the file name + (let ((xref-file-name-display 'abs)) + (xref-location-group loc))) + (xref-location-line loc) + (if (eq type 'xref-file-location) + (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. + +This function can be used for `xref-show-xrefs-function'. +See `xref-show-xrefs-function' for the description of the +FETCHER and ALIST arguments." + (let* ((consult-xref--fetcher fetcher) + (candidates (consult-xref--candidates)) + (display (alist-get 'display-action alist))) + (xref-pop-to-location + (if (cdr candidates) + (apply + #'consult--read + candidates + (append + (consult--customize-get #'consult-xref) + (list + :prompt "Go to xref: " + :history 'consult-xref--history + :require-match t + :sort nil + :category 'consult-xref + :group #'consult-xref--group + :state + ;; do not preview other frame + (when-let (fun (pcase-exhaustive display + ('frame nil) + ('window #'switch-to-buffer-other-window) + ('nil #'switch-to-buffer))) + (consult-xref--preview fun)) + :lookup (apply-partially #'consult--lookup-prop 'consult-xref)))) + (get-text-property 0 'consult-xref (car candidates))) + display))) + +(provide 'consult-xref) +;;; consult-xref.el ends here diff --git a/elpa/consult-0.19/consult.el b/elpa/consult-0.19/consult.el @@ -0,0 +1,4749 @@ +;;; consult.el --- Consulting completing-read -*- lexical-binding: t -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; Author: Daniel Mendler and Consult contributors +;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> +;; Created: 2020 +;; Version: 0.19 +;; Package-Requires: ((emacs "27.1") (compat "28.1")) +;; Homepage: https://github.com/minad/consult + +;; 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 <http://www.gnu.org/licenses/>. + +;;; 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. + +;; The Consult commands are compatible with completion systems based +;; on the Emacs `completing-read' API, including the default completion +;; system, Vertico, Mct, Icomplete and Selectrum. + +;; Consult has been inspired by Counsel. Some of the Consult commands +;; originated in the Counsel package or the Selectrum wiki. See the +;; README for a full list of contributors. + +;;; Code: + +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) +(require 'bookmark) +(require 'kmacro) +(require 'recentf) +(require 'seq) +(require 'compat) +(require 'compat-28) + +(defgroup consult nil + "Consulting `completing-read'." + :group 'convenience + :group 'minibuffer + :prefix "consult-") + +;;;; Customization + +(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))) + +(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))) + +(defcustom consult-project-function + #'consult--default-project-function + "Function which returns project root directory. +The function takes one boolargument MAY-PROMPT. If MAY-PROMPT is non-nil, +the function may ask the prompt the user for a project directory. +The root directory is used by `consult-buffer' and `consult-grep'." + :type '(choice function (const nil))) + +(defcustom consult-async-refresh-delay 0.2 + "Refreshing delay of the completion ui for asynchronous commands. + +The completion ui is only updated every `consult-async-refresh-delay' +seconds. This applies to asynchronous commands like for example +`consult-grep'." + :type 'float) + +(defcustom consult-async-input-throttle 0.4 + "Input throttle for asynchronous commands. + +The asynchronous process is started only every +`consult-async-input-throttle' seconds. This applies to asynchronous +commands, e.g., `consult-grep'." + :type 'float) + +(defcustom consult-async-input-debounce 0.2 + "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 +asynchronous commands, e.g., `consult-grep'." + :type 'float) + +(defcustom consult-async-min-input 3 + "Minimum number of letters needed, before asynchronous process is called. + +This applies to asynchronous commands, e.g., `consult-grep'." + :type 'integer) + +(defcustom consult-async-split-style 'perl + "Async splitting style, see `consult-async-split-styles-alist'." + :type '(choice (const :tag "No splitting" nil) + (const :tag "Comma" comma) + (const :tag "Semicolon" semicolon) + (const :tag "Perl" perl))) + +(defcustom consult-async-split-styles-alist + '((nil :function consult--split-nil) + (comma :separator ?, :function consult--split-separator) + (semicolon :separator ?\; :function consult--split-separator) + (perl :initial "#" :function consult--split-perl)) + "Async splitting styles." + :type '(alist :key-type symbol :value-type plist)) + +(defcustom consult-mode-histories + '((eshell-mode . eshell-history-ring) + (comint-mode . comint-input-ring) + (term-mode . term-input-ring)) + "Alist of (mode . history) pairs of mode histories. +The histories can be rings or lists." + :type '(alist :key-type symbol :value-type symbol)) + +(defcustom consult-themes nil + "List of themes (symbols or regexps) to be presented for selection. +nil shows all `custom-available-themes'." + :type '(repeat (choice symbol regexp))) + +(defcustom consult-after-jump-hook '(recenter) + "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 +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 +after selection." + :type 'hook) + +(defcustom consult-line-start-from-top nil + "Start search from the top if non-nil. +Otherwise start the search at the current line and wrap around." + :type 'boolean) + +(defcustom consult-line-point-placement 'match-beginning + "Where to leave point after `consult-line' jumps to a match." + :type '(choice (const :tag "Beginning of the line" line-beginning) + (const :tag "Beginning of the match" match-beginning) + (const :tag "End of the match" match-end))) + +(defcustom consult-line-numbers-widen t + "Show absolute line numbers when narrowing is active. + +See also `display-line-numbers-widen'." + :type 'boolean) + +(defcustom consult-goto-line-numbers t + "Show line numbers for `consult-goto-line'." + :type 'boolean) + +(defcustom consult-fontify-preserve t + "Preserve fontification for line-based commands." + :type 'boolean) + +(defcustom consult-fontify-max-size 1048576 + "Buffers larger than this byte limit are not fontified. + +This is necessary in order to prevent a large startup time +for navigation commands like `consult-line'." + :type 'integer) + +(defcustom consult-buffer-filter + '("\\` " + "\\`\\*Completions\\*\\'" + "\\`\\*Flymake log\\*\\'" + "\\`\\*Semantic SymRef\\*\\'" + "\\`\\*tramp/.*\\*\\'") + "Filter regexps for `consult-buffer'. + +The default setting is to filter ephemeral buffer names beginning with a space +character, the *Completions* buffer and a few log buffers." + :type '(repeat regexp)) + +(defcustom consult-buffer-sources + '(consult--source-hidden-buffer + consult--source-modified-buffer + consult--source-buffer + consult--source-recent-file + consult--source-bookmark + consult--source-project-buffer + consult--source-project-recent-file) + "Sources used by `consult-buffer'. +See also `consult-project-buffer-sources'. +See `consult--multi' for a description of the source data structure." + :type '(repeat symbol)) + +(defcustom consult-project-buffer-sources nil + "Sources used by `consult-project-buffer'. +See also `consult-buffer-sources'. +See `consult--multi' for a description of the source data structure." + :type '(repeat symbol)) + +(defcustom consult-mode-command-filter + '(;; Filter commands + "-mode\\'" "--" + ;; Filter whole features + simple mwheel time so-long recentf) + "Filter commands for `consult-mode-command'." + :type '(repeat (choice symbol regexp))) + +(defcustom consult-grep-max-columns 300 + "Maximal number of columns of grep output." + :type 'integer) + +(defconst consult--grep-match-regexp + "\\`\\(?:\\./\\)?\\([^\n\0]+\\)\0\\([0-9]+\\)\\([-:\0]\\)" + "Regexp used to match file and line of grep output.") + +(defcustom consult-grep-args + "grep --null --line-buffered --color=never --ignore-case --line-number -I -r ." + "Command line arguments for grep, see `consult-grep'. +The dynamically computed arguments are appended." + :type 'string) + +(defcustom consult-git-grep-args + "git --no-pager grep --null --color=never --ignore-case\ + --extended-regexp --line-number -I" + "Command line arguments for git-grep, see `consult-git-grep'. +The dynamically computed arguments are appended." + :type 'string) + +(defcustom consult-ripgrep-args + "rg --null --line-buffered --color=never --max-columns=1000 --path-separator /\ + --smart-case --no-heading --line-number ." + "Command line arguments for ripgrep, see `consult-ripgrep'. +The dynamically computed arguments are appended." + :type 'string) + +(defcustom consult-find-args + "find . -not ( -wholename */.* -prune )" + "Command line arguments for find, see `consult-find'. +The dynamically computed arguments are appended." + :type 'string) + +(defcustom consult-locate-args + "locate --ignore-case --existing" + "Command line arguments for locate, see `consult-locate'. +The dynamically computed arguments are appended." + :type 'string) + +(defcustom consult-man-args + "man -k" + "Command line arguments for man, see `consult-man'. +The dynamically computed arguments are appended." + :type 'string) + +(defcustom consult-preview-key 'any + "Preview trigger keys, can be nil, \\='any, a single key or a list of keys." + :type '(choice (const :tag "Any key" 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))) + +(defcustom consult-preview-max-size 10485760 + "Files larger than this byte limit are not previewed." + :type 'integer) + +(defcustom consult-preview-raw-size 524288 + "Files larger than this byte limit are previewed in raw form." + :type 'integer) + +(defcustom consult-preview-max-count 10 + "Number of files to keep open at once during preview." + :type 'integer) + +(defcustom consult-preview-excluded-files nil + "List of regexps matched against names of files, which are not previewed." + :type '(repeat regexp)) + +(defcustom consult-preview-allowed-hooks + '(global-font-lock-mode-check-buffers + save-place-find-file-hook) + "List of `find-file' hooks, which should be executed during file preview." + :type '(repeat symbol)) + +(defcustom consult-preview-variables + '((inhibit-message . t) + (enable-dir-local-variables . nil) + (enable-local-variables . :safe) + (non-essential . t) + (delay-mode-hooks . t)) + "Variables which are bound for file preview." + :type '(alist :key-type symbol)) + +(defcustom consult-bookmark-narrow + `((?f "File" ,#'bookmark-default-handler) + (?h "Help" ,#'help-bookmark-jump) + (?i "Info" ,#'Info-bookmark-jump) + (?p "Picture" ,#'image-bookmark-jump) + (?d "Docview" ,#'doc-view-bookmark-jump) + (?m "Man" ,#'Man-bookmark-jump) + (?w "Woman" ,#'woman-bookmark-jump) + (?g "Gnus" ,#'gnus-summary-bookmark-jump) + ;; Introduced on Emacs 28 + (?s "Eshell" eshell-bookmark-jump) + (?e "Eww" eww-bookmark-jump) + (?v "VC Directory" vc-dir-bookmark-jump)) + "Bookmark narrowing configuration. + +Each element of the list must have the form \\='(char name handler)." + :type '(repeat (list character string function))) + +;;;; Faces + +(defgroup consult-faces nil + "Faces used by Consult." + :group 'consult + :group 'faces) + +(defface consult-preview-line + '((t :inherit consult-preview-insertion :extend t)) + "Face used for line previews.") + +(defface consult-preview-match + '((t :inherit match)) + "Face used for match previews in `consult-grep'.") + +(defface consult-preview-cursor + '((t :inherit consult-preview-match)) + "Face used for cursor previews and marks in `consult-mark'.") + +(defface consult-preview-error + '((t :inherit isearch-fail)) + "Face used for cursor previews and marks in `consult-compile-error'.") + +(defface consult-preview-insertion + '((t :inherit region)) + "Face used for previews of text to be inserted. +Used by `consult-completion-in-region', `consult-yank' and `consult-history'.") + +(defface consult-narrow-indicator + '((t :inherit warning)) + "Face used for the narrowing indicator.") + +(defface consult-async-running + '((t :inherit consult-narrow-indicator)) + "Face used if asynchronous process is running.") + +(defface consult-async-finished + '((t :inherit success)) + "Face used if asynchronous process has finished.") + +(defface consult-async-failed + '((t :inherit error)) + "Face used if asynchronous process has failed.") + +(defface consult-async-split + '((t :inherit font-lock-negation-char-face)) + "Face used to highlight punctuation character.") + +(defface consult-help + '((t :inherit shadow)) + "Face used to highlight help, e.g., in `consult-register-store'.") + +(defface consult-key + '((t :inherit font-lock-keyword-face)) + "Face used to highlight keys, e.g., in `consult-register'.") + +(defface consult-line-number + '((t :inherit consult-key)) + "Face used to highlight location line in `consult-global-mark'.") + +(defface consult-file + '((t :inherit font-lock-function-name-face)) + "Face used to highlight files in `consult-buffer'.") + +(defface consult-grep-context + '((t :inherit shadow)) + "Face used to highlight grep context in `consult-grep'.") + +(defface consult-bookmark + '((t :inherit font-lock-constant-face)) + "Face used to highlight bookmarks in `consult-buffer'.") + +(defface consult-buffer + '((t)) + "Face used to highlight buffers in `consult-buffer'.") + +(defface consult-line-number-prefix + '((t :inherit line-number)) + "Face used to highlight line number prefixes.") + +(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.") + +(defface consult-separator + '((((class color) (min-colors 88) (background light)) + :foreground "#ccc") + (((class color) (min-colors 88) (background dark)) + :foreground "#333")) + "Face used for thin line separators in `consult-register-window'.") + +;;;; History variables + +(defvar consult--keep-lines-history nil) +(defvar consult--grep-history nil) +(defvar consult--find-history nil) +(defvar consult--man-history nil) +(defvar consult--line-history nil) +(defvar consult--apropos-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 + +(defvar consult--regexp-compiler + #'consult--default-regexp-compiler + "Regular expression compiler used by `consult-grep' and other commands. +The function must return a list of regular expressions and a highlighter +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 + ;; `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 +options set here will be evaluated and passed to `consult--read', when +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.") + +(defvar consult--buffer-display #'switch-to-buffer + "Buffer display function.") + +(defvar consult--completion-candidate-hook + (list #'consult--default-completion-minibuffer-candidate + #'consult--default-completion-list-candidate) + "Get candidate from completion system.") + +(defvar consult--completion-refresh-hook nil + "Refresh completion system.") + +(defvar-local consult--preview-function nil + "Minibuffer-local variable which exposes the current preview function. +This function can be called by custom completion systems from +outside the minibuffer.") + +(defconst consult--tofu-char #x200000 + "Special character used to encode line prefixes for disambiguation. +We use invalid characters outside the Unicode range.") + +(defconst consult--tofu-range #x100000 + "Special character range.") + +(defvar-local consult--narrow nil + "Current narrowing key.") + +(defvar-local consult--narrow-keys nil + "Narrowing prefixes of the current completion.") + +(defvar-local consult--narrow-predicate nil + "Narrowing predicate of the current completion.") + +(defvar-local consult--narrow-overlay nil + "Narrowing indicator overlay.") + +(defvar consult--gc-threshold (* 64 1024 1024) + "Large gc threshold for temporary increase.") + +(defvar consult--gc-percentage 0.5 + "Large gc percentage for temporary increase.") + +(defvar consult--process-chunk (* 1024 1024) + "Increase process output chunk size.") + +(defvar consult--async-log + " *consult-async*" + "Buffer for async logging output used by `consult--async-process'.") + +(defvar-local consult--focus-lines-overlays nil + "Overlays used by `consult-focus-lines'.") + +;;;; Customization helper + +(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 + +(defun consult--command-split (str) + "Return command argument and options list given input STR." + (save-match-data + (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. + (cons str (and opts (ignore-errors (split-string-and-unquote opts))))))) + +(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-preview-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)) + (let ((head (make-symbol "head")) + (prev (make-symbol "prev")) + (result (make-symbol "result"))) + `(let* ((,head (cons nil ,list)) + (,prev ,head)) + (while (cdr ,prev) + (if-let (,result (let ((it (cadr ,prev))) ,form)) + (progn + (pop ,prev) + (setcar ,prev ,result)) + (setcdr ,prev (cddr ,prev)))) + (setq ,list (cdr ,head)) + nil))) + +;; Upstream bug#46326, Consult issue https://github.com/minad/consult/issues/193 +(defmacro consult--minibuffer-with-setup-hook (fun &rest body) + "Variant of `minibuffer-with-setup-hook' using a symbol and `fset'. + +This macro is only needed to prevent memory leaking issues with +the upstream `minibuffer-with-setup-hook' macro. +FUN is the hook function and BODY opens the minibuffer." + (declare (indent 1) (debug t)) + (let ((hook (make-symbol "hook")) + (append)) + (when (eq (car-safe fun) :append) + (setq append '(t) fun (cadr fun))) + `(let ((,hook (make-symbol "consult--minibuffer-setup"))) + (fset ,hook (lambda () + (remove-hook 'minibuffer-setup-hook ,hook) + (funcall ,fun))) + (unwind-protect + (progn + (add-hook 'minibuffer-setup-hook ,hook ,@append) + ,@body) + (remove-hook 'minibuffer-setup-hook ,hook))))) + +(defun consult--completion-filter (pattern cands category _highlight) + "Filter CANDS with PATTERN. + +CATEGORY is the completion category, used to find the completion style via +`completion-category-defaults' and `completion-category-overrides'. +HIGHLIGHT must be non-nil if the resulting strings should be highlighted." + ;; completion-all-completions returns an improper list + ;; where the last link is not necessarily nil. + (nconc (completion-all-completions pattern cands nil (length pattern) + `(metadata (category . ,category))) + nil)) + +(defun consult--completion-filter-complement (pattern cands category _highlight) + "Filter CANDS with complement of PATTERN. +See `consult--completion-filter' for the arguments CATEGORY and HIGHLIGHT." + (let ((ht (consult--string-hash (consult--completion-filter pattern cands category nil)))) + (seq-remove (lambda (x) (gethash x ht)) cands))) + +(defun consult--completion-filter-dispatch (pattern cands category 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 +HIGHLIGHT." + (cond + ((string-match-p "\\`!? ?\\'" pattern) cands) ;; empty pattern + ((string-prefix-p "! " pattern) (consult--completion-filter-complement + (substring pattern 2) cands category nil)) + (t (consult--completion-filter pattern cands category highlight)))) + +(defmacro consult--each-line (beg end &rest body) + "Iterate over each line. + +The line beginning/ending BEG/END is bound in BODY." + (declare (indent 2)) + (let ((max (make-symbol "max"))) + `(save-excursion + (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))) + ,@body + (setq ,beg (1+ ,end))))))) + +(defun consult--display-width (string) + "Compute width of STRING taking display and invisible properties into account." + (let ((pos 0) (width 0) (end (length string))) + (while (< pos end) + (let ((nextd (next-single-property-change pos 'display string end)) + (display (get-text-property pos 'display string))) + (if (stringp display) + (setq width (+ width (string-width display)) + pos nextd) + (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 pos nexti)))))) + width)) + +(defun consult--string-hash (strings) + "Create hashtable from STRINGS." + (let ((ht (make-hash-table :test #'equal :size (length strings)))) + (dolist (str strings) + (puthash str t ht)) + ht)) + +(defmacro consult--local-let (binds &rest body) + "Buffer local let BINDS of dynamic variables in BODY." + (declare (indent 1)) + (let ((buffer (make-symbol "buffer")) + (local (mapcar (lambda (x) (cons (make-symbol "local") (car x))) binds))) + `(let ((,buffer (current-buffer)) + ,@(mapcar (lambda (x) `(,(car x) (local-variable-p ',(cdr x)))) local)) + (unwind-protect + (progn + ,@(mapcar (lambda (x) `(make-local-variable ',(car x))) binds) + (let (,@binds) + ,@body)) + (when (buffer-live-p ,buffer) + (with-current-buffer ,buffer + ,@(mapcar (lambda (x) + `(unless ,(car x) + (kill-local-variable ',(cdr x)))) + local))))))) + +(defun consult--abbreviate-directory (dir) + "Return abbreviated directory DIR for use in `completing-read' prompt." + (save-match-data + (let ((adir (abbreviate-file-name dir))) + (if (string-match "/\\([^/]+\\)/\\([^/]+\\)/\\'" adir) + (format "…/%s/%s/" (match-string 1 adir) (match-string 2 adir)) + adir)))) + +(defun consult--directory-prompt (prompt dir) + "Return prompt and directory. + +PROMPT is the prompt prefix. The directory +is appended to the prompt prefix. For projects +only the project name is shown. The `default-directory' +is not shown. Other directories are abbreviated and +only the last two path components are shown. + +If DIR is a string, it is returned. +If DIR is a true value, the user is asked. +Then the `consult-project-function' is tried. +Otherwise the `default-directory' is returned." + (let* ((dir + (cond + ((stringp dir) dir) + (dir + ;; Preserve this-command across `read-directory-name' call, + ;; such that `consult-customize' continues to work. + (let ((this-command this-command)) + (read-directory-name "Directory: " nil nil t))) + (t (or (consult--project-root) default-directory)))) + (edir (file-name-as-directory (expand-file-name dir))) + ;; Bind default-directory in order to find the project + (pdir (let ((default-directory edir)) (consult--project-root)))) + (cons + (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)))) + edir))) + +(defun consult--default-project-function (may-prompt) + "Return project root directory. +When no project is found and MAY-PROMPT is non-nil ask the user." + (when-let (proj (project-current may-prompt)) + (cond + ((fboundp 'project-root) (project-root proj)) + ((fboundp 'project-roots) (car (project-roots proj)))))) + +(defun consult--project-root (&optional may-prompt) + "Return project root as absolute path. +When no project is found and MAY-PROMPT is non-nil ask the user." + ;; Preserve this-command across project selection, + ;; such that `consult-customize' continues to work. + (let ((this-command this-command)) + (when-let (root (and consult-project-function + (funcall consult-project-function may-prompt))) + (expand-file-name root)))) + +(defun consult--project-name (dir) + "Return the project name for DIR." + (if (string-match "/\\([^/]+\\)/\\'" dir) + (match-string 1 dir) + dir)) + +(defun consult--format-location (file line &optional str) + "Format location string 'FILE:LINE:STR'." + (setq line (number-to-string line) + str (concat file ":" line (and str ":") str) + 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) + +(defmacro consult--overlay (beg end &rest props) + "Make consult overlay between BEG and END with PROPS." + (let ((ov (make-symbol "ov")) + (puts)) + (while props + (push `(overlay-put ,ov ,(car props) ,(cadr props)) puts) + (setq props (cddr props))) + `(let ((,ov (make-overlay ,beg ,end))) + ,@puts + ,ov))) + +(defun consult--remove-dups (list) + "Remove duplicate strings from LIST." + (delete-dups (copy-sequence list))) + +(defsubst consult--in-range-p (pos) + "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) + (user-error "`%s' called inside the minibuffer" this-command))) + +(defun consult--require-minibuffer () + "Raise an error if executed outside the minibuffer." + (unless (minibufferp) + (user-error "`%s' must be called inside the minibuffer" this-command))) + +(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 + ;; order to prevent is hang-up we check the buffer size against + ;; `consult-fontify-max-size'. + (when (and consult-fontify-preserve jit-lock-mode + (< (buffer-size) consult-fontify-max-size)) + (jit-lock-fontify-now))) + +(defun consult--fontify-region (start end) + "Ensure that region between START and END is fontified." + (when (and consult-fontify-preserve jit-lock-mode) + (jit-lock-fontify-now start end))) + +(defmacro consult--with-increased-gc (&rest body) + "Temporarily increase the gc limit in BODY to optimize for throughput." + (let ((overwrite (make-symbol "overwrite"))) + `(let* ((,overwrite (> consult--gc-threshold gc-cons-threshold)) + (gc-cons-threshold (if ,overwrite consult--gc-threshold gc-cons-threshold)) + (gc-cons-percentage (if ,overwrite consult--gc-percentage gc-cons-percentage))) + ,@body))) + +(defun consult--count-lines (pos) + "Move to position POS and return number of lines." + (let ((line 0)) + (while (< (point) pos) + (forward-line) + (when (<= (point) pos) + (setq line (1+ line)))) + (goto-char pos) + line)) + +(defun consult--position-marker (buffer line column) + "Get marker in BUFFER from LINE and COLUMN." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-restriction + (save-excursion + (widen) + (goto-char (point-min)) + ;; Location data might be invalid by now! + (ignore-errors + (forward-line (1- line)) + (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." + (setq curr-line (or curr-line -1)) + (let* ((width (length (number-to-string (line-number-at-pos + (point-max) + consult-line-numbers-widen)))) + (before (format #("%%%dd " 0 6 (face consult-line-number-wrapped)) width)) + (after (format #("%%%dd " 0 6 (face consult-line-number-prefix)) width))) + (lambda (cand) + (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. +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)))) + (add-text-properties 0 1 `(consult-location (,marker . ,line) ,@props) cand) + cand) + +;; 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) + "List of text properties to remove from buffer strings.") + +(defsubst consult--buffer-substring (beg end &optional fontify) + "Return buffer substring between BEG and END. +If FONTIFY and `consult-fontify-preserve' are non-nil, first ensure that the +region has been fontified." + (if consult-fontify-preserve + (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) + str) + (buffer-substring-no-properties beg end))) + +(defun consult--region-with-cursor (beg end marker) + "Return region string with a marking at the cursor position. + +BEG is the begin position. +END is the end position. +MARKER is the cursor position." + (let ((str (consult--buffer-substring beg end 'fontify))) + (if (>= marker end) + (concat str #(" " 0 1 (face consult-preview-cursor))) + (put-text-property (- marker beg) (- (1+ marker) beg) + 'face 'consult-preview-cursor str) + str))) + +(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))) + +;;;; Preview support + +(defun consult--filter-find-file-hook (orig &rest hooks) + "Filter `find-file-hook' by `consult-preview-allowed-hooks'. +This function is an advice for `run-hooks'. +ORIG is the original function, HOOKS the arguments." + (if (memq 'find-file-hook hooks) + (cl-letf* (((default-value 'find-file-hook) + (seq-filter (lambda (x) + (memq x consult-preview-allowed-hooks)) + (default-value 'find-file-hook))) + (find-file-hook (default-value 'find-file-hook))) + (apply orig hooks)) + (apply orig hooks))) + +(defun consult--find-file-temporarily (name) + "Open file NAME temporarily for preview." + (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) + (progn + (message "File `%s' (%s) is too large for preview" + name (file-size-human-readable size)) + nil) + (let* ((vars (delq nil + (mapcar + (pcase-lambda (`(,k . ,v)) + (if (boundp k) + (list k v (default-value k) (symbol-value k)) + (message "consult-preview-variables: The variable `%s' is not bound" k) + nil)) + consult-preview-variables))) + (buf (unwind-protect + (progn + (advice-add #'run-hooks :around #'consult--filter-find-file-hook) + (pcase-dolist (`(,k ,v . ,_) vars) + (set-default k v) + (set k v)) + (find-file-noselect name 'nowarn (> size consult-preview-raw-size))) + (advice-remove #'run-hooks #'consult--filter-find-file-hook) + (pcase-dolist (`(,k ,_ ,d ,v) vars) + (set-default k d) + (set k v))))) + (cond + ((and (> size consult-preview-raw-size) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (search-forward "\0" nil 'noerror)))) + (kill-buffer buf) + (message "Binary file `%s' not previewed literally" name) + nil) + ((ignore-errors (buffer-local-value 'so-long-detected-p buf)) + (kill-buffer buf) + (message "File `%s' with long lines not previewed" name) + nil) + (t buf)))))) + +(defun consult--temporary-files () + "Return a function to open files temporarily for preview." + (let ((dir default-directory) + (hook (make-symbol "consult--temporary-files-window-selection-change")) + (orig-buffers (buffer-list)) + temporary-buffers) + (fset hook + (lambda (_) + ;; Fully initialize previewed files and keep them alive. + (unless (consult--completion-window-p) + (let (live-files) + (pcase-dolist (`(,file . ,buf) temporary-buffers) + (when-let (wins (and (buffer-live-p buf) + (get-buffer-window-list buf))) + (push (cons file (mapcar + (lambda (win) + (cons win (window-state-get win t))) + wins)) + live-files))) + (pcase-dolist (`(,_ . ,buf) temporary-buffers) + (kill-buffer buf)) + (setq temporary-buffers nil) + (pcase-dolist (`(,file . ,wins) live-files) + (when-let (buf (find-file-noselect file)) + (push buf orig-buffers) + (pcase-dolist (`(,win . ,state) wins) + (setf (car (alist-get 'buffer state)) buf) + (window-state-put state win)))))))) + (lambda (&optional name) + (if name + (let ((default-directory dir)) + (setq name (abbreviate-file-name (expand-file-name name))) + (or + ;; 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, + ;; 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 + ;; 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 + ;; preview. + (when-let (buf (consult--find-file-temporarily name)) + ;; Only add new buffer if not already in the list + (unless (or (rassq buf temporary-buffers) (memq buf orig-buffers)) + (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 + ;; lets us open an already previewed buffer with the Embark + ;; default action C-. RET. + (with-current-buffer buf + (rename-buffer + (format " Preview:%s" + (file-name-nondirectory (directory-file-name name))) + '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) + ;; early also prevents the major mode initialization. + (let ((hook (make-symbol "consult--temporary-files-disassociate"))) + (fset hook (lambda () + (when (buffer-live-p buf) + (with-current-buffer buf + (remove-hook 'pre-command-hook hook) + (setq-local buffer-read-only t + dired-directory nil + buffer-file-name nil))))) + (add-hook 'pre-command-hook hook)) + ;; Only keep a few buffers alive + (while (length> temporary-buffers consult-preview-max-count) + (kill-buffer (cdar (last temporary-buffers))) + (setq temporary-buffers (nbutlast temporary-buffers)))) + buf))) + (remove-hook 'window-selection-change-functions hook) + (pcase-dolist (`(,_ . ,buf) temporary-buffers) + (kill-buffer buf)) + (setq temporary-buffers nil))))) + +(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))))) + +(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)) + +(defun consult--jump-1 (pos) + "Go to POS and recenter." + (if (and (markerp pos) (not (marker-buffer pos))) + ;; Only print a message, no error in order to not mess + ;; 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)) + ;; Widen if we cannot jump to the position (idea from flycheck-jump-to-error) + (unless (= (goto-char pos) (point)) + (widen) + (goto-char pos)))) + +(defun consult--jump (pos) + "Push current position to mark ring, go to POS and recenter." + (when pos + ;; When the marker is in the same buffer, record previous location + ;; such that the user can jump back quickly. + (when (or (not (markerp pos)) (eq (current-buffer) (marker-buffer pos))) + ;; push-mark mutates markers in the mark-ring and the mark-marker. + ;; Therefore we transform the marker to a number to be safe. + ;; We all love side effects! + (setq pos (+ pos 0)) + (push-mark (point) t)) + (consult--jump-1 pos) + (consult--invisible-open-permanently) + (run-hooks 'consult-after-jump-hook)) + nil) + +(defun consult--jump-preview (&optional face) + "The preview function used if selecting from a list of candidate positions. +The function can be used as the `:state' argument of `consult--read'. +FACE is the cursor face." + (let ((face (or face 'consult-preview-cursor)) + (saved-min (point-min-marker)) + (saved-max (point-max-marker)) + (saved-pos (point-marker)) + overlays invisible) + (set-marker-insertion-type saved-max t) ;; Grow when text is inserted + (lambda (action cand) + (when (eq action 'preview) + (mapc #'funcall invisible) + (mapc #'delete-overlay overlays) + (setq invisible nil overlays nil) + (if (not cand) + ;; If position cannot be previewed, return to saved position + (let ((saved-buffer (marker-buffer saved-pos))) + (if (not saved-buffer) + (message "Buffer is dead") + (set-buffer saved-buffer) + (narrow-to-region saved-min saved-max) + (goto-char saved-pos))) + ;; Jump to position + (consult--jump-1 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)))) + (consult--overlay (point) (1+ (point)) + 'face face + 'window (selected-window)))) + (run-hooks 'consult-after-jump-hook)))))) + +(defun consult--jump-state (&optional face) + "The state function used if selecting from a list of candidate positions. +The function can be used as the `:state' argument of `consult--read'. +FACE is the cursor face." + (let ((preview (consult--jump-preview face))) + (lambda (action cand) + (funcall preview action cand) + (when (and cand (eq action 'return)) + (consult--jump cand))))) + +(defmacro consult--define-state (type) + "Define state function for TYPE." + `(defun ,(intern (format "consult--%s-state" type)) () + (let ((preview (,(intern (format "consult--%s-preview" type))))) + (lambda (action cand) + (funcall preview action cand) + (when (and cand (eq action 'return)) + (,(intern (format "consult--%s-action" type)) cand)))))) + +(defun consult--preview-key-normalize (preview-key) + "Normalize PREVIEW-KEY, return alist of keys and debounce times." + (let ((keys) + (debounce 0)) + (setq preview-key (ensure-list preview-key)) + (while preview-key + (if (eq (car preview-key) :debounce) + (setq debounce (cadr preview-key) + preview-key (cddr preview-key)) + (push (cons (car preview-key) debounce) keys) + (pop preview-key))) + keys)) + +(defun consult--preview-key-debounce (preview-key cand) + "Return debounce value of PREVIEW-KEY given the current candidate CAND." + (when (and (consp preview-key) (memq :keys preview-key)) + (setq preview-key (funcall (plist-get preview-key :predicate) cand))) + (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))))) + (setq keys (lookup-key map keys)) + (if (functionp keys) (funcall keys) any))) + +(defun consult--append-local-post-command-hook (fun) + "Append FUN to local `post-command-hook' list." + ;; Symbol indirection because of bug#46407. + (let ((hook (make-symbol "consult--preview-post-command"))) + (fset hook fun) + ;; TODO Emacs 28 has a bug, where the hook--depth-alist is not cleaned up properly + ;; Do not use the broken add-hook here. + ;;(add-hook 'post-command-hook sym 'append 'local) + (setq-local post-command-hook + (append + (remove t post-command-hook) + (list hook) + (and (memq t post-command-hook) '(t)))))) + +(defun consult--with-preview-1 (preview-key state transform candidate fun) + "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) + (consult--minibuffer-with-setup-hook + (if (and state preview-key) + (lambda () + (let ((exit-hook (make-symbol "consult--preview-minibuffer-exit"))) + (fset exit-hook + (lambda () + (when timer + (cancel-timer timer) + (setq timer nil)) + (with-selected-window (or (minibuffer-selected-window) (next-window)) + ;; STEP 3: Reset preview + (when last-preview + (funcall state 'preview nil)) + ;; STEP 4: Notify the preview function of the minibuffer exit + (funcall state 'exit nil)))) + (add-hook 'minibuffer-exit-hook exit-hook nil 'local)) + ;; STEP 1: Setup the preview function + (with-selected-window (or (minibuffer-selected-window) (next-window)) + (funcall state 'setup nil)) + (setq consult--preview-function + (lambda () + (when-let ((cand (funcall candidate))) + (with-selected-window (active-minibuffer-window) + (let* ((input (minibuffer-contents-no-properties)) + (transformed (funcall transform narrow input cand)) + (new-preview (cons input cand))) + (with-selected-window (or (minibuffer-selected-window) (next-window)) + (when-let (debounce (consult--preview-key-debounce preview-key transformed)) + (when timer + (cancel-timer timer) + (setq timer nil)) + (unless (equal last-preview new-preview) + (if (> debounce 0) + (let ((win (selected-window))) + (setq timer + (run-at-time + debounce nil + (lambda () + (when (window-live-p win) + (with-selected-window win + ;; STEP 2: Preview candidate + (funcall state 'preview transformed) + (setq last-preview new-preview))))))) + ;; STEP 2: Preview candidate + (funcall state 'preview transformed) + (setq last-preview new-preview)))))))))) + (consult--append-local-post-command-hook + (lambda () + (setq input (minibuffer-contents-no-properties) + narrow consult--narrow) + (funcall consult--preview-function)))) + (lambda () + (consult--append-local-post-command-hook + (lambda () (setq input (minibuffer-contents-no-properties) + narrow consult--narrow))))) + (unwind-protect + (cons (setq selected (when-let (result (funcall fun)) + (funcall transform narrow input result))) + input) + (when state + ;; STEP 5: The preview function should perform its final action + (funcall state 'return selected)))))) + +(defmacro consult--with-preview (preview-key state transform candidate &rest body) + "Add preview support to BODY. + +STATE is the state function. +TRANSFORM is the transformation function. +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 +sequence with the following arguments: + + 1. \\='setup nil After entering the mb (minibuffer-setup-hook). +⎧ 2. \\='preview CAND/nil Preview candidate CAND or reset if CAND is nil. +⎪ \\='preview CAND/nil +⎪ \\='preview CAND/nil +⎪ ... +⎩ 3. \\='preview nil Reset preview. + 4. \\='exit nil Before exiting the mb (minibuffer-exit-hook). + 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 +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 +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 +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 +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 + +(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)))) + +(defun consult-narrow (key) + "Narrow current completion with KEY. + +This command is used internally by the narrowing system of `consult--read'." + (interactive + (list (unless (equal (this-single-command-keys) (consult--widen-key)) + last-command-event))) + (consult--require-minibuffer) + (setq consult--narrow key) + (when consult--narrow-predicate + (setq minibuffer-completion-predicate (and consult--narrow consult--narrow-predicate))) + (when consult--narrow-overlay + (delete-overlay consult--narrow-overlay)) + (when consult--narrow + (setq consult--narrow-overlay + (consult--overlay + (1- (minibuffer-prompt-end)) (minibuffer-prompt-end) + 'before-string + (propertize (format " [%s]" (alist-get consult--narrow + consult--narrow-keys)) + 'face 'consult-narrow-indicator)))) + (run-hooks 'consult--completion-refresh-hook)) + +(defconst consult--narrow-delete + `(menu-item + "" nil :filter + ,(lambda (&optional _) + (when (string= (minibuffer-contents-no-properties) "") + (lambda () + (interactive) + (consult-narrow nil)))))) + +(defconst consult--narrow-space + `(menu-item + "" nil :filter + ,(lambda (&optional _) + (let ((str (minibuffer-contents-no-properties))) + (when-let (pair (or (and (length= str 1) + (assoc (aref str 0) consult--narrow-keys)) + (and (string= str "") + (assoc 32 consult--narrow-keys)))) + (lambda () + (interactive) + (delete-minibuffer-contents) + (consult-narrow (car pair)))))))) + +(defun consult-narrow-help () + "Print narrowing help as a `minibuffer-message'. + +This command can be bound to a key in `consult-narrow-map', +to make it available for commands with narrowing." + (interactive) + (consult--require-minibuffer) + (let ((minibuffer-message-timeout 1000000)) + (minibuffer-message + (mapconcat + (lambda (x) (concat + (propertize (char-to-string (car x)) 'face 'consult-key) " " + (propertize (cdr x) 'face 'consult-help))) + (seq-filter (lambda (x) (/= (car x) 32)) + consult--narrow-keys) + " ")))) + +(defun consult--narrow-setup (settings map) + "Setup narrowing with SETTINGS and keymap MAP." + (if (memq :keys settings) + (setq consult--narrow-predicate (plist-get settings :predicate) + consult--narrow-keys (plist-get settings :keys)) + (setq consult--narrow-predicate nil + consult--narrow-keys settings)) + (when consult-narrow-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 widen (cons "All" #'consult-narrow)))) + +;; Emacs 28: hide in M-X +(put #'consult-narrow-help 'completion-predicate #'ignore) +(put #'consult-narrow 'completion-predicate #'ignore) + +;;;; Splitting completion style + +(defun consult--split-perl (str &optional _plist) + "Split input STR in async input and filtering part. + +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\", +\"#async#filter\"." + (if (string-match-p "^[[:punct:]]" str) + (save-match-data + (let ((q (regexp-quote (substring str 0 1)))) + (string-match (concat "^" q "\\([^" q "]*\\)\\(" q "\\)?") str) + `(,(match-string 1 str) + ,(match-end 0) + ;; Force update it two punctuation characters are entered. + ,(match-end 2) + ;; List of highlights + (0 . ,(match-beginning 1)) + ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2))))))) + `(,str ,(length str)))) + +(defun consult--split-nil (str &optional _plist) + "Treat the complete input STR as async input." + `(,str ,(length str))) + +(defun consult--split-separator (str plist) + "Split input STR in async input and filtering part at first separator. +PLIST is the splitter configuration, including the separator." + (let ((sep (regexp-quote (char-to-string (plist-get plist :separator))))) + (save-match-data + (if (string-match (format "^\\([^%s]+\\)\\(%s\\)?" sep sep) str) + `(,(match-string 1 str) + ,(match-end 0) + ;; Force update it space is entered. + ,(match-end 2) + ;; List of highlights + ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2))))) + `(,str ,(length str)))))) + +(defun consult--split-setup (split) + "Setup splitting completion style with splitter function SPLIT." + (let* ((styles completion-styles) + (catdef completion-category-defaults) + (catovr completion-category-overrides) + (try (lambda (str table pred point) + (let ((completion-styles styles) + (completion-category-defaults catdef) + (completion-category-overrides catovr) + (pos (cadr (funcall split str)))) + (pcase (completion-try-completion (substring str pos) table pred + (max 0 (- point pos))) + ('t t) + (`(,newstr . ,newpt) + (cons (concat (substring str 0 pos) newstr) + (+ pos newpt))))))) + (all (lambda (str table pred point) + (let ((completion-styles styles) + (completion-category-defaults catdef) + (completion-category-overrides catovr) + (pos (cadr (funcall split str)))) + (completion-all-completions (substring str pos) table pred + (max 0 (- point pos))))))) + (setq-local completion-styles-alist (cons `(consult--split ,try ,all "") + completion-styles-alist) + completion-styles '(consult--split) + completion-category-defaults nil + completion-category-overrides nil))) + +;;;; Async support + +(defmacro consult--with-async (bind &rest body) + "Setup asynchronous completion in BODY. + +BIND is the asynchronous function binding." + (declare (indent 1)) + (let ((async (car bind))) + `(let ((,async ,@(cdr bind)) + (new-chunk (max read-process-output-max consult--process-chunk)) + orig-chunk) + (consult--minibuffer-with-setup-hook + ;; Append such that we overwrite the completion style setting of + ;; `fido-mode'. See `consult--async-split' and + ;; `consult--split-setup'. + (:append + (lambda () + (when (functionp ,async) + (setq orig-chunk read-process-output-max + read-process-output-max new-chunk) + (funcall ,async 'setup) + ;; Push input string to request refresh. + ;; We use a symbol in order to avoid adding lambdas to the hook variable. + ;; Symbol indirection because of bug#46407. + (let ((sym (make-symbol "consult--async-after-change"))) + (fset sym (lambda (&rest _) (funcall ,async (minibuffer-contents-no-properties)))) + (run-at-time 0 nil sym) + (add-hook 'after-change-functions sym nil 'local))))) + (let ((,async (if (functionp ,async) ,async (lambda (_) ,async)))) + (unwind-protect + ,(macroexp-progn body) + (funcall ,async 'destroy) + (when (and orig-chunk (eq read-process-output-max new-chunk)) + (setq read-process-output-max orig-chunk)))))))) + +(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. + +\\='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." + (let (candidates last buffer previewed) + (lambda (action) + (pcase-exhaustive action + ('setup + (setq buffer (current-buffer)) + nil) + ((or (pred stringp) 'destroy) nil) + ('flush (setq candidates nil last nil previewed nil)) + ('refresh + ;; Refresh the UI when the current minibuffer window belongs + ;; to the current asynchronous completion session. + (when-let (win (active-minibuffer-window)) + (when (eq (window-buffer win) buffer) + (with-selected-window win + (run-hooks 'consult--completion-refresh-hook) + ;; Interaction between asynchronous completion tables and + ;; preview: We have to trigger preview immediately when + ;; candidates arrive (Issue #436). + (when (and consult--preview-function candidates (not previewed)) + (setq previewed t) + (funcall consult--preview-function))))) + nil) + ('nil candidates) + ((pred consp) + (setq last (last (if last (setcdr last action) (setq candidates action)))) + candidates))))) + +(defun consult--async-split-style () + "Return the async splitting style function and initial string." + (or (alist-get consult-async-split-style consult-async-split-styles-alist) + (user-error "Splitting style `%s' not found" consult-async-split-style))) + +(defun consult--async-split-initial (initial) + "Return initial string for async command. +INITIAL is the additional initial string." + (concat (plist-get (consult--async-split-style) :initial) initial)) + +(defun consult--async-split-thingatpt (thing) + "Return THING at point with async initial prefix." + (when-let (str (thing-at-point thing)) + (consult--async-split-initial str))) + +(defun consult--async-split (async &optional split) + "Create async function, which splits the input string. +ASYNC is the async sink. +SPLIT is the splitting function." + (unless split + (let* ((style (consult--async-split-style)) + (fn (plist-get style :function))) + (setq split (lambda (str) (funcall fn str style))))) + (lambda (action) + (pcase action + ('setup + (consult--split-setup split) + (funcall async 'setup)) + ((pred stringp) + (pcase-let* ((`(,async-str ,_ ,force . ,highlights) + (funcall split action)) + (async-len (length async-str)) + (input-len (length action)) + (end (minibuffer-prompt-end))) + ;; Highlight punctuation characters + (remove-list-of-text-properties end (+ end input-len) '(face)) + (dolist (hl highlights) + (put-text-property (+ end (car hl)) (+ end (cdr hl)) + 'face 'consult-async-split)) + (funcall async + ;; Pass through if the input is long enough! + (if (or force (>= async-len consult-async-min-input)) + async-str + ;; Pretend that there is no input + "")))) + (_ (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) + "Create process source async function. + +ASYNC is the async function which receives the candidates. +CMD is the command line builder function. +PROPS are optional properties passed to `make-process'." + (let (proc proc-buf last-args indicator count) + (lambda (action) + (pcase action + ("" ;; If no input is provided kill current process + (when proc + (delete-process proc) + (kill-buffer proc-buf) + (setq proc nil proc-buf nil)) + (setq last-args nil)) + ((pred stringp) + (funcall async action) + (let* ((args (funcall cmd action)) + (flush t) + (rest "") + (proc-filter + (lambda (_ out) + (when flush + (setq flush nil) + (funcall async 'flush)) + (let ((lines (split-string out "[\r\n]+"))) + (if (not (cdr lines)) + (setq rest (concat rest (car lines))) + (setcar lines (concat rest (car lines))) + (let* ((len (length lines)) + (last (nthcdr (- len 2) lines))) + (setq rest (cadr last) + count (+ count len -1)) + (setcdr last nil) + (funcall async lines)))))) + (proc-sentinel + (lambda (_ event) + (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 (list rest))) + (consult--async-log + "consult--async-process sentinel: event=%s lines=%d\n" + (string-trim event) count) + (with-current-buffer (get-buffer-create consult--async-log) + (goto-char (point-max)) + (insert ">>>>> stderr >>>>>\n") + (insert-buffer-substring proc-buf) + (insert "<<<<< stderr <<<<<\n"))))) + (unless (equal args last-args) + (setq last-args args) + (when proc + (delete-process proc) + (kill-buffer proc-buf) + (setq proc nil proc-buf nil)) + (when args + (overlay-put indicator 'display #("*" 0 1 (face consult-async-running))) + (consult--async-log "consult--async-process started %S\n" args) + (setq count 0 + proc-buf (generate-new-buffer " *consult-async-stderr*") + proc (apply #'make-process + `(,@props + :connection-type pipe + :name ,(car args) + ;;; XXX tramp bug, the stderr buffer must be empty + :stderr ,proc-buf + :noquery t + :command ,args + :filter ,proc-filter + :sentinel ,proc-sentinel)))))) + nil) + ('destroy + (when proc + (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)) + (lambda (action) + (cond + ((stringp action) + (setq highlight (plist-get (funcall builder action) :highlight)) + (funcall async action)) + ((and (consp action) highlight) + (dolist (str action) + (funcall highlight str)) + (funcall async action)) + (t (funcall async action)))))) + +(defun consult--async-throttle (async &optional throttle debounce) + "Create async function from ASYNC which throttles input. + +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)) + (lambda (action) + (pcase action + ((pred stringp) + (unless (string= action input) + (when timer + (cancel-timer timer) + (setq timer nil)) + (funcall async "") ;; cancel running process + (setq input action) + (unless (string= action "") + (setq timer + (run-at-time + (+ debounce + (if last + (min (- (float-time) last) throttle) + 0)) + nil + (lambda () + (setq last (float-time)) + (funcall async action)))))) + nil) + ('destroy + (when timer (cancel-timer timer)) + (funcall async 'destroy)) + (_ (funcall async action)))))) + +(defun consult--async-refresh-immediate (async) + "Create async function from ASYNC, which refreshes the display. + +The refresh happens immediately when candidates are pushed." + (lambda (action) + (pcase action + ((or (pred consp) 'flush) + (prog1 (funcall async action) + (funcall async 'refresh))) + (_ (funcall async action))))) + +(defun consult--async-refresh-timer (async &optional delay) + "Create async function from ASYNC, which refreshes the display. + +The refresh happens after a DELAY, defaulting to `consult-async-refresh-delay'." + (let ((timer) (refresh) (delay (or delay consult-async-refresh-delay))) + (lambda (action) + (prog1 (funcall async action) + (pcase action + ((or (pred consp) 'flush) + (setq refresh t) + (unless timer + (setq timer (run-at-time + nil delay + (lambda () + (when refresh + (setq refresh nil) + (funcall async 'refresh))))))) + ('destroy (when timer (cancel-timer timer)))))))) + +(defmacro consult--async-transform (async &rest transform) + "Use FUN to TRANSFORM candidates of ASYNC." + (let ((async-var (make-symbol "async")) + (action-var (make-symbol "action"))) + `(let ((,async-var ,async)) + (lambda (,action-var) + (funcall ,async-var (if (consp ,action-var) (,@transform ,action-var) ,action-var)))))) + +(defun consult--async-map (async fun) + "Map candidates of ASYNC by FUN." + (consult--async-transform async mapcar fun)) + +(defun consult--async-filter (async fun) + "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)))) + +(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))) + +;;;; 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.") + +;;;; Internal API: consult--read + +(defun consult--add-history (async items) + "Add ITEMS to the minibuffer future history. +ASYNC must be non-nil for async completion functions." + (delete-dups + (append + ;; the defaults are at the beginning of the future history + (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'. + (unless async + (all-completions "" + minibuffer-completion-table + minibuffer-completion-predicate))))) + +(defun consult--setup-keymap (keymap async narrow preview-key) + "Setup minibuffer keymap. + +KEYMAP is a command-specific keymap. +ASYNC must be non-nil for async completion functions. +NARROW are the narrow settings. +PREVIEW-KEY are the preview keys." + (let ((old-map (current-local-map)) + (map (make-sparse-keymap))) + + ;; Add narrow keys + (when narrow + (consult--narrow-setup narrow map)) + + ;; Preview trigger keys + (when (and (consp preview-key) (memq :keys preview-key)) + (setq preview-key (plist-get preview-key :keys))) + (setq preview-key (mapcar #'car (consult--preview-key-normalize preview-key))) + (when preview-key + (dolist (key preview-key) + (unless (or (eq key 'any) (lookup-key old-map key)) + (define-key map key #'ignore)))) + + ;; Put the keymap together + (use-local-map + (make-composed-keymap + (delq nil (list keymap + (and async consult-async-map) + (and narrow consult-narrow-map) + map)) + old-map)))) + +(defsubst consult--tofu-p (char) + "Return non-nil if CHAR is a tofu." + (<= consult--tofu-char char (+ consult--tofu-char consult--tofu-range -1))) + +(defun consult--tofu-hide (str) + "Hide the tofus in STR." + (let* ((max (length str)) + (end max)) + (while (and (> end 0) (consult--tofu-p (aref str (1- end)))) + (setq end (1- end))) + (when (< end max) + (setq str (copy-sequence str)) + (put-text-property end max 'invisible t str)) + str)) + +(defun consult--tofu-hide-in-minibuffer (&rest _) + "Hide the tofus in the minibuffer." + (let* ((min (minibuffer-prompt-end)) + (max (point-max)) + (pos max)) + (while (and (> pos min) (consult--tofu-p (char-before pos))) + (setq pos (1- 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." + (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." + (- (aref cand (1- (length cand))) consult--tofu-char)) + +;; We must disambiguate the lines by adding a prefix such that two lines with +;; the same text can be distinguished. In order to avoid matching the line +;; number, such that the user can search for numbers with `consult-line', we +;; encode the line number as characters outside the unicode range. +;; By doing that, no accidential matching can occur. +(defun consult--tofu-encode (n) + "Return tofu-encoded number N." + (let (str tofu) + (while (progn + (setq tofu (char-to-string + (+ consult--tofu-char (% n consult--tofu-range))) + str (if str (concat tofu str) tofu)) + (and (>= n consult--tofu-range) + (setq n (/ n consult--tofu-range))))) + (add-text-properties 0 (length str) '(invisible t consult-strip t) str) + str)) + +(defun consult--read-annotate (fun cand) + "Annotate CAND with annotation function FUN." + (pcase (funcall fun cand) + (`(,_ ,_ ,suffix) suffix) + (ann ann))) + +(defun consult--read-affixate (fun cands) + "Affixate CANDS with annotation function FUN." + (mapcar (lambda (cand) + (let ((ann (funcall fun cand))) + (if (consp ann) + ann + (setq ann (or ann "")) + (list cand "" + ;; 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)))))) + cands)) + +(cl-defun consult--read-1 (candidates &key + prompt predicate require-match history default + keymap category initial narrow add-history annotate + state preview-key sort lookup group inherit-input-method) + "See `consult--read' for the documentation of the arguments." + (consult--minibuffer-with-setup-hook + (:append (lambda () + (add-hook 'after-change-functions #'consult--tofu-hide-in-minibuffer nil 'local) + (consult--setup-keymap keymap (functionp candidates) narrow preview-key) + (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. + (let* ((metadata `(metadata + ,@(when category `((category . ,category))) + ,@(when group `((group-function . ,group))) + ,@(when annotate + `((affixation-function + . ,(apply-partially #'consult--read-affixate annotate)) + (annotation-function + . ,(apply-partially #'consult--read-annotate annotate)))) + ,@(unless sort '((cycle-sort-function . identity) + (display-sort-function . identity))))) + (result + (consult--with-preview + preview-key state + (lambda (narrow input cand) + (funcall lookup cand (funcall async nil) input narrow)) + (apply-partially #'run-hook-with-args-until-success + 'consult--completion-candidate-hook) + (completing-read prompt + (lambda (str pred action) + (if (eq action 'metadata) + metadata + (complete-with-action action (funcall async nil) str pred))) + predicate require-match initial + (if (symbolp history) history (cadr history)) + default + inherit-input-method)))) + (pcase-exhaustive history + (`(:input ,var) + (set var (cdr (symbol-value var))) + (add-to-history var (cdr result))) + ((pred symbolp))) + (car result))))) + +(cl-defun consult--read (candidates &rest options &key + 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. + +Keyword OPTIONS: + +PROMPT is the string which is shown as prompt message in the minibuffer. +PREDICATE is a filter function called for each candidate. +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. +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. +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). +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." + ;; supported types + (cl-assert (or (functionp candidates) ;; async table + (obarrayp candidates) ;; obarray + (hash-table-p candidates) ;; hash table + (not candidates) ;; empty list + (stringp (car candidates)) ;; string list + (and (consp (car candidates)) (stringp (caar candidates))) ;; string alist + (and (consp (car candidates)) (symbolp (caar candidates))))) ;; symbol alist + (ignore prompt predicate require-match history default + keymap category initial narrow add-history annotate + state preview-key sort lookup group inherit-input-method) + (apply #'consult--read-1 candidates + (append + (consult--customize-get) + options + (list :prompt "Select: " + :preview-key consult-preview-key + :sort t + :lookup (lambda (selected &rest _) selected))))) + +;;;; Internal API: consult--multi + +(defsubst consult--multi-source (sources cand) + "Lookup source for CAND in SOURCES list." + (aref sources (consult--tofu-get cand))) + +(defun consult--multi-predicate (sources cand) + "Predicate function called for each candidate CAND given SOURCES." + (let* ((src (consult--multi-source sources cand)) + (narrow (plist-get src :narrow)) + (type (or (car-safe narrow) narrow -1))) + (or (eq consult--narrow type) + (not (or consult--narrow (plist-get src :hidden)))))) + +(defun consult--multi-narrow (sources) + "Return narrow list from SOURCES." + (thread-last sources + (mapcar (lambda (src) + (when-let (narrow (plist-get src :narrow)) + (if (consp narrow) + narrow + (when-let (name (plist-get src :name)) + (cons narrow name)))))) + (delq nil) + (delete-dups))) + +(defun consult--multi-annotate (sources align cand) + "Annotate candidate CAND with `consult--multi' type, given SOURCES and ALIGN." + (let* ((src (consult--multi-source sources cand)) + (annotate (plist-get src :annotate)) + (ann (if annotate + (funcall annotate (cdr (get-text-property 0 'multi-category cand))) + (plist-get src :name)))) + (and ann (concat align ann)))) + +(defun consult--multi-group (sources cand transform) + "Return title of candidate CAND or TRANSFORM the candidate given SOURCES." + (if transform + cand + (plist-get (consult--multi-source sources cand) :name))) + +(defun consult--multi-preview-key (sources) + "Return preview keys from SOURCES." + (list :predicate + (lambda (cand) + (if (plist-member (cdr cand) :preview-key) + (plist-get (cdr cand) :preview-key) + consult-preview-key)) + :keys + (delete-dups + (seq-mapcat (lambda (src) + (let ((key (if (plist-member src :preview-key) + (plist-get src :preview-key) + consult-preview-key))) + (ensure-list key))) + sources)))) + +(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)) + (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))))) + +(defun consult--multi-candidates (sources) + "Return `consult--multi' candidates from SOURCES." + (let ((def) (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))) + ;; Preserve existing `multi-category' datum of the candidate. + (if (get-text-property 0 'multi-category cand) + (when face (add-text-properties 0 (length item) face cand)) + ;; Attach `multi-category' datum and face. + (add-text-properties 0 (length item) + `(multi-category (,cat . ,item) ,@face) cand)) + (when (> width max-width) (setq max-width width)) + (push cand candidates)))) + (setq idx (1+ idx))) + (list def (+ 3 max-width) (nreverse candidates)))) + +(defun consult--multi-enabled-sources (sources) + "Return vector of enabled SOURCES." + (vconcat + (seq-filter (lambda (src) + (if-let (pred (plist-get src :enabled)) + (funcall pred) + t)) + (mapcar (lambda (src) + (if (symbolp src) (symbol-value src) src)) + sources)))) + +(defun consult--multi-state (sources) + "State function given SOURCES." + (when-let (states (delq nil (mapcar (lambda (src) + (when-let (fun (plist-get src :state)) + (cons src (funcall fun)))) + sources))) + (let (last-fun) + (pcase-lambda (action `(,cand . ,src)) + (pcase action + ('setup + (pcase-dolist (`(,_ . ,fun) states) + (funcall fun 'setup nil))) + ('exit + (pcase-dolist (`(,_ . ,fun) states) + (funcall fun 'exit nil))) + ('preview + (let ((selected-fun (cdr (assq src states)))) + ;; If the candidate source changed during preview communicate to + ;; the last source, that none of its candidates is previewed anymore. + (when (and last-fun (not (eq last-fun selected-fun))) + (funcall last-fun 'preview nil)) + (setq last-fun selected-fun) + (when selected-fun + (funcall selected-fun 'preview cand)))) + ('return + (let ((selected-fun (cdr (assq src states)))) + ;; Finish all the sources, except the selected one. + (pcase-dolist (`(,_ . ,fun) states) + (unless (eq fun selected-fun) + (funcall fun 'return nil))) + ;; Finish the source with the selected candidate + (when selected-fun + (funcall selected-fun 'return cand))))))))) + +(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 are supported: :require-match, :history, :keymap, :initial, +: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. + +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 +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: + +Required source fields: +* :category - Completion category. +* :items - List of strings to select from or function returning list of strings. + +Optional source fields: +* :name - Name of the source, 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. +* :face - Face used for highlighting the candidates. +* :annotate - Annotation function called for each candidate, returns string. +* :history - Name of history variable to add selected candidate. +* :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." + (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)))))) + (when-let (history (plist-get (cdr selected) :history)) + (add-to-history history (car selected))) + (if (plist-member (cdr selected) :match) + (when-let (fun (plist-get (cdr selected) :new)) + (funcall fun (car selected)) + (plist-put (cdr selected) :match 'new)) + (when-let (fun (plist-get (cdr selected) :action)) + (funcall fun (car selected))) + (setq selected `(,(car selected) :match t ,@(cdr selected)))) + selected)) + +;;;; Internal API: consult--prompt + +(cl-defun consult--prompt-1 (&key prompt history add-history initial default + keymap state preview-key transform inherit-input-method) + "See `consult--prompt' for documentation." + (consult--minibuffer-with-setup-hook + (:append (lambda () + (consult--setup-keymap keymap nil nil preview-key) + (setq-local minibuffer-default-add-function + (apply-partially #'consult--add-history nil add-history)))) + (car (consult--with-preview + preview-key state + (lambda (_narrow inp _cand) (funcall transform inp)) #'always + (read-from-minibuffer prompt initial nil nil history default inherit-input-method))))) + +(cl-defun consult--prompt (&rest options &key prompt history add-history initial default + keymap state preview-key transform inherit-input-method) + "Read from minibuffer. + +Keyword OPTIONS: + +PROMPT is the string to prompt with. +TRANSFORM is a function which is applied to the current input string. +HISTORY is the symbol of the history variable. +INITIAL is initial input. +DEFAULT is the default selected value. +ADD-HISTORY is a list of items to add to the history. +STATE is the state function, see `consult--with-preview'. +PREVIEW-KEY are the preview keys (nil, \\='any, a single key or a list of keys). +KEYMAP is a command-specific keymap." + (ignore prompt history add-history initial default + keymap state preview-key transform inherit-input-method) + (apply #'consult--prompt-1 + (append + (consult--customize-get) + options + (list :prompt "Input: " + :preview-key consult-preview-key + :transform #'identity)))) + +;;;; Functions + +;;;;; Function: consult-completion-in-region + +(defun consult--insertion-preview (start end) + "State function for previewing a candidate in a specific region. +The candidates are previewed in the region from START to END. This function is +used as the `:state' argument for `consult--read' in the `consult-yank' family +of functions and in `consult-completion-in-region'." + (unless (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. + (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))))) + (let (ov) + (lambda (action cand) + (cond + ((and (not cand) ov) + (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))))))) + +;;;###autoload +(defun consult-completion-in-region (start end collection &optional predicate) + "Use minibuffer completion as the UI for `completion-at-point'. + +The function is called with 4 arguments: START END COLLECTION PREDICATE. +The arguments and expected return value are as specified for +`completion-in-region'. Use as a value for `completion-in-region-function'. + +The function can be configured via `consult-customize'. + + (consult-customize consult-completion-in-region + :completion-styles (basic) + :cycle-threshold 3) + +These configuration options are supported: + + * :cycle-threshold - Cycling threshold (def: `completion-cycle-threshold') + * :completion-styles - Use completion styles (def: `completion-styles') + * :require-match - Require matches when completing (def: nil) + * :prompt - The prompt string shown in the minibuffer" + (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 + ;; necessary if `completion-styles' is buffer-local. + ;; NOTE: The completion-styles will be overwritten for recursive editing sessions! + (cs (or (plist-get config :completion-styles) completion-styles)) + (completion-styles cs) + ((default-value 'completion-styles) cs) + (prompt (or (plist-get config :prompt) "Completion: ")) + (require-match (plist-get config :require-match)) + (preview-key (if (plist-member config :preview-key) + (plist-get config :preview-key) + consult-preview-key)) + (initial (buffer-substring-no-properties start end)) + (metadata (completion-metadata initial collection predicate)) + (threshold (or (plist-get config :cycle-threshold) (completion--cycle-threshold metadata))) + (all (completion-all-completions initial collection predicate (length initial))) + ;; Provide `:annotation-function' if `:company-docsig' is specified + (completion-extra-properties + (if-let (fun (and (not (plist-get completion-extra-properties :annotation-function)) + (plist-get completion-extra-properties :company-docsig))) + `(:annotation-function + ,(lambda (cand) + (concat (propertize " " 'display '(space :align-to center)) + (funcall fun cand))) + ,@completion-extra-properties) + completion-extra-properties))) + ;; error if `threshold' is t or the improper list `all' is too short + (if (and threshold + (or (not (consp (ignore-errors (nthcdr threshold all)))) + (and completion-cycling completion-all-sorted-completions))) + (completion--in-region start end collection predicate) + (let* ((limit (car (completion-boundaries initial collection predicate ""))) + (category (completion-metadata-get metadata 'category)) + (buffer (current-buffer)) + (completion + (cond + ((atom all) nil) + ((and (consp all) (atom (cdr all))) + (concat (substring initial 0 limit) (car all))) + (t (car + (consult--with-preview + preview-key + ;; preview state + (consult--insertion-preview start end) + ;; transformation function + (if (eq category 'file) + (cond + ;; Transform absolute file names + ((file-name-absolute-p initial) + (lambda (_narrow _inp cand) + (substitute-in-file-name cand))) + ;; Ensure that ./ prefix is kept for the shell (#356) + ((string-match-p "\\`\\.\\.?/" initial) + (lambda (_narrow _inp cand) + (setq cand (file-relative-name (substitute-in-file-name cand))) + (if (string-match-p "\\`\\.\\.?/" cand) cand (concat "./" cand)))) + ;; Simplify relative file names + (t + (lambda (_narrow _inp cand) + (file-relative-name (substitute-in-file-name cand))))) + (lambda (_narrow _inp cand) cand)) + ;; candidate function + (apply-partially #'run-hook-with-args-until-success + 'consult--completion-candidate-hook) + (consult--local-let ((enable-recursive-minibuffers t)) + (if (eq category 'file) + ;; We use read-file-name, since many completion UIs make it nicer to + ;; navigate the file system this way; and we insert the initial text + ;; directly into the minibuffer to allow the user's completion + ;; styles to expand it as appropriate (particularly useful for the + ;; partial-completion and initials styles, which allow for very + ;; condensed path specification). + (consult--minibuffer-with-setup-hook + (lambda () (insert initial)) + (read-file-name prompt nil initial require-match nil predicate)) + (completing-read prompt + ;; Evaluate completion table in the original buffer. + ;; This is a reasonable thing to do and required + ;; by some completion tables in particular by lsp-mode. + ;; See https://github.com/minad/vertico/issues/61. + (if (functionp collection) + (lambda (&rest args) + (with-current-buffer buffer + (apply collection args))) + collection) + predicate require-match initial))))))))) + (if completion + (progn + ;; bug#55205: completion--replace removes properties! + (completion--replace start end (setq completion (concat completion))) + (when-let (exit (plist-get completion-extra-properties :exit-function)) + (funcall exit completion + ;; If completion is finished and cannot be further completed, + ;; return 'finished. Otherwise return 'exact. + (if (eq (try-completion completion collection predicate) t) + 'finished 'exact))) + t) + (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 () + "Return alist of outline headings and positions." + (consult--forbid-minibuffer) + (let* ((line (line-number-at-pos (point-min) consult-line-numbers-widen)) + (heading-regexp (concat "^\\(?:" + ;; default definition from outline.el + (or (bound-and-true-p outline-regexp) "[*\^L]+") + "\\)")) + (heading-alist (bound-and-true-p outline-heading-alist)) + (level-fun (or (bound-and-true-p outline-level) + (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)) + (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)))) + (push (consult--location-candidate + (consult--buffer-substring (line-beginning-position) + (line-end-position) + 'fontify) + (cons buffer (point)) line + 'consult--outline-level (funcall level-fun)) + candidates) + (unless (eobp) (forward-char 1)))) + (unless candidates + (user-error "No headings")) + (nreverse candidates))) + +;;;###autoload +(defun consult-outline () + "Jump to an outline heading, obtained by matching against `outline-regexp'. + +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)) + (min-level (- (apply #'min (mapcar + (lambda (cand) + (get-text-property 0 'consult--outline-level cand)) + candidates)) + ?1)) + (narrow-pred (lambda (cand) + (<= (get-text-property 0 'consult--outline-level cand) + (+ consult--narrow min-level)))) + (narrow-keys (mapcar (lambda (c) (cons c (format "Level %c" c))) + (number-sequence ?1 ?9)))) + (consult--read + candidates + :prompt "Go to heading: " + :annotate (consult--line-prefix) + :category 'consult-location + :sort nil + :require-match t + :lookup #'consult--line-match + :narrow `(:predicate ,narrow-pred :keys ,narrow-keys) + :history '(:input consult--line-history) + :add-history (thing-at-point 'symbol) + :state (consult--location-state candidates)))) + +;;;;; Command: consult-mark + +(defun consult--mark-candidates (markers) + "Return list of candidates strings for MARKERS." + (consult--forbid-minibuffer) + (let ((candidates) + (current-buf (current-buffer))) + (save-excursion + (dolist (marker markers) + (when-let ((pos (marker-position marker)) + (buf (marker-buffer marker))) + (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'. + (push (consult--location-candidate + (consult--line-with-cursor marker) marker + (line-number-at-pos pos consult-line-numbers-widen)) + candidates))))) + (unless candidates + (user-error "No marks")) + (nreverse (delete-dups candidates)))) + +;;;###autoload +(defun consult-mark (&optional markers) + "Jump to a marker in MARKERS list (defaults to buffer-local `mark-ring'). + +The command supports preview of the currently selected marker position. +The symbol at point is added to the future history." + (interactive) + (consult--read + (consult--mark-candidates + (or markers (cons (mark-marker) mark-ring))) + :prompt "Go to mark: " + :annotate (consult--line-prefix) + :category 'consult-location + :sort nil + :require-match t + :lookup #'consult--lookup-location + :history '(:input consult--line-history) + :add-history (thing-at-point 'symbol) + :state (consult--jump-state))) + +;;;;; Command: consult-global-mark + +(defun consult--global-mark-candidates (markers) + "Return list of candidates strings for MARKERS." + (consult--forbid-minibuffer) + (let ((candidates)) + (save-excursion + (dolist (marker markers) + (when-let ((pos (marker-position marker)) + (buf (marker-buffer marker))) + (unless (minibufferp buf) + (with-current-buffer buf + (when (consult--in-range-p pos) + (goto-char pos) + ;; `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) + (consult--line-with-cursor marker) + (consult--tofu-encode marker)) + candidates)))))))) + (unless candidates + (user-error "No global marks")) + (nreverse (delete-dups candidates)))) + +;;;###autoload +(defun consult-global-mark (&optional markers) + "Jump to a marker in MARKERS list (defaults to `global-mark-ring'). + +The command supports preview of the currently selected marker position. +The symbol at point is added to the future history." + (interactive) + (consult--read + (consult--global-mark-candidates + (or markers global-mark-ring)) + :prompt "Go to global mark: " + ;; Despite `consult-global-mark' formating the candidates in grep-like + ;; style, we are not using the 'consult-grep category, since the candidates + ;; have location markers attached. + :category 'consult-location + :sort nil + :require-match t + :lookup #'consult--lookup-location + :history '(:input consult--line-history) + :add-history (thing-at-point 'symbol) + :state (consult--jump-state))) + +;;;;; Command: consult-line + +(defun consult--line-candidates (top curr-line) + "Return list of line candidates. +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))) + (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))))))) + +(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 (or (string-blank-p input) + (eq consult-line-point-placement 'line-beginning)) + pos + (let ((beg 0) + (end (length selected))) + ;; Ignore tofu-encoded unique line number suffix + (while (and (> end 0) (consult--tofu-p (aref selected (1- end)))) + (setq end (1- end))) + ;; Find match end position, remove characters from line end until + ;; matching fails + (let ((step 16)) + (while (> step 0) + (while (and (> (- end step) 0) + ;; Use consult-location completion category when + ;; filtering lines. Highlighting is not necessary here, + ;; but it is actually cheaper to highlight a single + ;; candidate, since setting up deferred highlighting is + ;; costly. + (consult--completion-filter input + (list (substring selected 0 (- end step))) + 'consult-location 'highlight)) + (setq end (- end step))) + (setq step (/ step 2)))) + ;; Find match beginning position, remove characters from line beginning + ;; until matching fails + (when (eq consult-line-point-placement 'match-beginning) + (let ((step 16)) + (while (> step 0) + (while (and (< (+ beg step) end) + ;; See comment above, call to `consult--completion-filter'. + (consult--completion-filter input + (list (substring selected (+ beg step) end)) + 'consult-location 'highlight)) + (setq beg (+ beg step))) + (setq step (/ step 2))) + (setq end beg))) + ;; 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-all'. + (ignore-errors + (if (or (not (markerp pos)) + (eq (marker-buffer pos) + (window-buffer (or (minibuffer-selected-window) (next-window))))) + (+ pos end) + ;; Only create a new marker when jumping across buffers, to avoid + ;; creating unnecessary markers, when scrolling through candidates. + ;; Creating markers is not free. + (move-marker + (make-marker) + (+ pos end) + (marker-buffer pos)))))))) + +(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))) + +;;;###autoload +(defun consult-line (&optional initial start) + "Search for a matching line. + +Depending on the setting `consult-line-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) + :prompt (if top "Go to line from top: " "Go to line: ") + :initial initial))) + +;;;;; Command: consult-line-multi + +(defun consult--line-multi-candidates (buffers) + "Collect the line candidates from multiple buffers. +BUFFERS is the list of buffers." + (or (apply #'nconc + (consult--buffer-map buffers + #'consult--line-candidates 'top most-positive-fixnum)) + (user-error "No lines"))) + +;;;###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'." + (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))) + +;;;;; Command: consult-keep-lines + +(defun consult--keep-lines-state (filter) + "State function for `consult-keep-lines' with FILTER function." + (let ((font-lock-orig font-lock-mode) + (hl-line-orig (bound-and-true-p hl-line-mode)) + (point-orig (point)) + lines content-orig replace last-input) + (if (use-region-p) + (save-restriction + ;; Use the same behavior as `keep-lines'. + (let ((rbeg (region-beginning)) + (rend (save-excursion + (goto-char (region-end)) + (unless (or (bolp) (eobp)) + (forward-line 0)) + (point)))) + (consult--fontify-region rbeg rend) + (narrow-to-region rbeg rend) + (consult--each-line beg end + (push (consult--buffer-substring beg end) lines)) + (setq content-orig (buffer-string) + replace (lambda (content &optional pos) + (delete-region rbeg rend) + (insert content) + (goto-char (or pos rbeg)) + (setq rend (+ rbeg (length content))) + (add-face-text-property rbeg rend 'region t))))) + (consult--fontify-all) + (setq content-orig (buffer-string) + replace (lambda (content &optional pos) + (delete-region (point-min) (point-max)) + (insert content) + (goto-char (or pos (point-min))))) + (consult--each-line beg end + (push (consult--buffer-substring beg end) lines))) + (setq lines (nreverse lines)) + (lambda (action input) + ;; Restoring content and point position + (when (and (eq action 'return) last-input) + ;; No undo recording, modification hooks, buffer modified-status + (with-silent-modifications (funcall replace content-orig point-orig))) + ;; Committing or new input provided -> Update + (when (and input ;; Input has been povided + (or + ;; Committing, but not with empty input + (and (eq action 'return) (not (string-match-p "\\`!? ?\\'" input))) + ;; Input has changed + (not (equal input last-input)))) + (let ((filtered-content + (if (string-match-p "\\`!? ?\\'" input) + ;; Special case the empty input for performance. + ;; Otherwise it could happen that the minibuffer is empty, + ;; but the buffer has not been updated. + content-orig + (if (eq action 'return) + (apply #'concat (mapcan (lambda (x) (list x "\n")) + (funcall filter input lines))) + (while-no-input + ;; Heavy computation is interruptible if *not* committing! + ;; Allocate new string candidates since the matching function mutates! + (apply #'concat (mapcan (lambda (x) (list x "\n")) + (funcall filter input (mapcar #'copy-sequence lines))))))))) + (when (stringp filtered-content) + (when font-lock-mode (font-lock-mode -1)) + (when (bound-and-true-p hl-line-mode) (hl-line-mode -1)) + (if (eq action 'return) + (atomic-change-group + ;; Disable modification hooks for performance + (let ((inhibit-modification-hooks t)) + (funcall replace filtered-content))) + ;; No undo recording, modification hooks, buffer modified-status + (with-silent-modifications + (funcall replace filtered-content) + (setq last-input input)))))) + ;; Restore modes + (when (eq action 'return) + (when hl-line-orig (hl-line-mode 1)) + (when font-lock-orig (font-lock-mode 1)))))) + +;;;###autoload +(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 +command obeys narrowing. + +FILTER is the filter function. +INITIAL is the initial input." + (interactive + (list (lambda (pattern cands) + ;; Use consult-location completion category when filtering lines + (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)))))) + +;;;;; Command: consult-focus-lines + +(defun consult--focus-lines-state (filter) + "State function for `consult-focus-lines' with FILTER function." + (let (lines overlays last-input pt-orig pt-min pt-max) + (save-excursion + (save-restriction + (if (not (use-region-p)) + (consult--fontify-all) + (consult--fontify-region (region-beginning) (region-end)) + (narrow-to-region + (region-beginning) + ;; Behave the same as `keep-lines'. + ;; Move to the next line. + (save-excursion + (goto-char (region-end)) + (unless (or (bolp) (eobp)) + (forward-line 0)) + (point)))) + (setq pt-orig (point) pt-min (point-min) pt-max (point-max)) + (let ((i 0)) + (consult--each-line beg end + ;; NOTE: Use "\n" for empty lines, since we need + ;; a string to attach the text property to. + (let ((line (if (eq beg end) (char-to-string ?\n) + (buffer-substring-no-properties beg end)))) + (put-text-property 0 1 'consult--focus-line (cons (cl-incf i) beg) line) + (push line lines))) + (setq lines (nreverse lines))))) + (lambda (action input) + ;; New input provided -> Update + (when (and input (not (equal input last-input))) + (let (new-overlays) + (pcase (while-no-input + (unless (string-match-p "\\`!? ?\\'" input) ;; empty input. + (let* ((inhibit-quit (eq action 'return)) ;; Non interruptible, when quitting! + (not (string-prefix-p "! " input)) + (stripped (string-remove-prefix "! " input)) + (matches (funcall filter stripped lines)) + (old-ind 0) + (block-beg pt-min) + (block-end pt-min)) + (while old-ind + (let ((match (pop matches)) (ind nil) (beg pt-max) (end pt-max) prop) + (when match + (setq prop (get-text-property 0 'consult--focus-line match) + ind (car prop) + beg (cdr prop) + ;; NOTE: Check for empty lines, see above! + end (+ 1 beg (if (equal match "\n") 0 (length match))))) + (unless (eq ind (1+ old-ind)) + (let ((a (if not block-beg block-end)) + (b (if not block-end beg))) + (when (/= a b) + (push (consult--overlay a b 'invisible t) new-overlays))) + (setq block-beg beg)) + (setq block-end end old-ind ind))))) + 'commit) + ('commit + (mapc #'delete-overlay overlays) + (setq last-input input overlays new-overlays)) + (_ (mapc #'delete-overlay new-overlays))))) + (when (eq action 'return) + (cond + ((not input) + (mapc #'delete-overlay overlays) + (goto-char pt-orig)) + ((equal input "") + (consult-focus-lines 'show) + (goto-char pt-orig)) + (t + ;; Sucessfully terminated -> Remember invisible overlays + (setq consult--focus-lines-overlays + (nconc consult--focus-lines-overlays overlays)) + ;; move point past invisible + (goto-char (if-let (ov (and (invisible-p pt-orig) + (seq-find (lambda (ov) (overlay-get ov 'invisible)) + (overlays-at pt-orig)))) + (overlay-end ov) + pt-orig)))))))) + +;;;###autoload +(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. + +FILTER is the filter function. +INITIAL is the initial input." + (interactive + (list current-prefix-arg + (lambda (pattern cands) + ;; Use consult-location completion category when filtering lines + (consult--completion-filter-dispatch + pattern cands 'consult-location nil)))) + (if show + (progn + (mapc #'delete-overlay consult--focus-lines-overlays) + (setq consult--focus-lines-overlays nil) + (message "All lines revealed")) + (consult--forbid-minibuffer) + (consult--with-increased-gc + (consult--prompt + :prompt + (if consult--focus-lines-overlays + "Focus on lines (RET to reveal): " + "Focus on lines: ") + :initial initial + :history 'consult--keep-lines-history + :state (consult--focus-lines-state filter))))) + +;;;;; Command: consult-goto-line + +(defun consult--goto-line-position (str msg) + "Transform input STR to line number. +Print an error message with MSG function." + (if-let (line (and str + (string-match-p "\\`[[:digit:]]+\\'" str) + (string-to-number str))) + (let ((pos (save-excursion + (save-restriction + (when consult-line-numbers-widen + (widen)) + (goto-char (point-min)) + (forward-line (1- line)) + (point))))) + (if (consult--in-range-p pos) + pos + (funcall msg "Line number out of range.") + nil)) + (when (and str (not (string= str ""))) + (funcall msg "Please enter a number.")) + nil)) + +;;;###autoload +(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 +narrowing and the settings `consult-goto-line-numbers' and +`consult-line-numbers-widen'." + (interactive "P") + (if arg + (call-interactively #'goto-line) + (consult--forbid-minibuffer) + (consult--local-let ((display-line-numbers consult-goto-line-numbers) + (display-line-numbers-widen consult-line-numbers-widen)) + (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) + :state + (let ((preview (consult--jump-preview))) + (lambda (action str) + (funcall preview action + (consult--goto-line-position str #'ignore))))) + #'minibuffer-message)) + (consult--jump pos) + t))))) + +;;;;; Command: consult-recent-file + +(defun consult--file-preview () + "Create preview function for files." + (let ((open (consult--temporary-files)) + (preview (consult--buffer-preview))) + (lambda (action cand) + (unless cand + (funcall open)) + (funcall preview action + (and cand + (eq action 'preview) + (funcall open cand)))))) + +(defun consult--file-action (file) + "Open FILE via `consult--buffer-action'." + (consult--buffer-action (find-file-noselect file))) + +(consult--define-state file) + +;;;###autoload +(defun consult-recent-file () + "Find recent file using `completing-read'." + (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"))) + :prompt "Find recent file: " + :sort nil + :require-match t + :category 'file + :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) + "Return name part of MODE." + (replace-regexp-in-string + "global-\\(.*\\)-mode" "\\1" + (replace-regexp-in-string + "\\(-global\\)?-mode\\'" "" + (if (eq mode 'c-mode) + "cc" + (symbol-name mode)) + 'fixedcase) + 'fixedcase)) + +(defun consult--mode-command-candidates (modes) + "Extract commands from MODES. + +The list of features is searched for files belonging to the modes. +From these files, the commands are extracted." + (let* ((buffer (current-buffer)) + (command-filter (consult--regexp-filter (seq-filter #'stringp consult-mode-command-filter))) + (feature-filter (seq-filter #'symbolp consult-mode-command-filter)) + (minor-hash (consult--string-hash minor-mode-list)) + (minor-local-modes (seq-filter (lambda (m) + (and (gethash m minor-hash) + (local-variable-if-set-p m))) + modes)) + (minor-global-modes (seq-filter (lambda (m) + (and (gethash m minor-hash) + (not (local-variable-if-set-p m)))) + modes)) + (major-modes (seq-remove (lambda (m) + (gethash m minor-hash)) + modes)) + (major-paths-hash (consult--string-hash (mapcar #'symbol-file major-modes))) + (minor-local-paths-hash (consult--string-hash (mapcar #'symbol-file minor-local-modes))) + (minor-global-paths-hash (consult--string-hash (mapcar #'symbol-file minor-global-modes))) + (major-name-regexp (regexp-opt (mapcar #'consult--mode-name major-modes))) + (minor-local-name-regexp (regexp-opt (mapcar #'consult--mode-name minor-local-modes))) + (minor-global-name-regexp (regexp-opt (mapcar #'consult--mode-name minor-global-modes))) + (commands)) + (dolist (feature load-history commands) + (when-let (name (alist-get 'provide feature)) + (let* ((path (car feature)) + (file (file-name-nondirectory path)) + (key (cond + ((memq name feature-filter) nil) + ((or (gethash path major-paths-hash) + (string-match-p major-name-regexp file)) + ?m) + ((or (gethash path minor-local-paths-hash) + (string-match-p minor-local-name-regexp file)) + ?l) + ((or (gethash path minor-global-paths-hash) + (string-match-p minor-global-name-regexp file)) + ?g)))) + (when key + (dolist (cmd (cdr feature)) + (let ((sym (cdr-safe cmd))) + (when (and (consp cmd) + (eq (car cmd) 'defun) + (commandp sym) + (not (get sym 'byte-obsolete-info)) + ;; Emacs 28 has a `read-extended-command-predicate' + (if (bound-and-true-p read-extended-command-predicate) + (funcall read-extended-command-predicate sym buffer) + t)) + (let ((name (symbol-name sym))) + (unless (string-match-p command-filter name) + (push (propertize name + 'consult--candidate sym + 'consult--type key) + commands)))))))))))) + +;;;###autoload +(defun consult-mode-command (&rest modes) + "Run a command from any of the given MODES. + +If no MODES are specified, use currently active major and minor modes." + (interactive) + (unless modes + (setq modes (cons major-mode + (seq-filter (lambda (m) + (and (boundp m) (symbol-value m))) + minor-mode-list)))) + (let ((narrow `((?m . ,(format "Major: %s" major-mode)) + (?l . "Local Minor") + (?g . "Global Minor")))) + (command-execute + (consult--read + (consult--mode-command-candidates modes) + :prompt "Mode command: " + :predicate + (lambda (cand) + (let ((key (get-text-property 0 'consult--type cand))) + (if consult--narrow + (= key consult--narrow) + (/= key ?g)))) + :lookup #'consult--lookup-candidate + :group (consult--type-group narrow) + :narrow narrow + :require-match t + :history 'extended-command-history + :category 'command)))) + +;;;;; Command: consult-yank + +(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 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. + (consult--lookup-member + (consult--read + (consult--remove-dups + (or kill-ring (user-error "Kill ring is empty"))) + :prompt "Yank from kill-ring: " + :history t ;; disable history + :sort nil + :category 'kill-ring + :require-match t + :state + (consult--insertion-preview + (point) + ;; If previous command is yank, hide previously yanked string + (or (and (eq last-command 'yank) (mark t)) (point)))) + kill-ring)) + +;; Adapted from the Emacs `yank-from-kill-ring' function. +;;;###autoload +(defun consult-yank-from-kill-ring (string &optional arg) + "Select STRING from the kill ring and insert it. +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 +version supports preview of the selected string." + (interactive (list (consult--read-from-kill-ring) current-prefix-arg)) + (when string + (setq yank-window-start (window-start)) + (push-mark) + (insert-for-yank string) + (setq this-command 'yank) + (when (consp arg) + ;; Swap point and mark like in `yank'. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer))))))) + +(put 'consult-yank-replace 'delete-selection 'yank) +(put 'consult-yank-pop 'delete-selection 'yank) +(put 'consult-yank-from-kill-ring 'delete-selection 'yank) + +;;;###autoload +(defun consult-yank-pop (&optional arg) + "If there is a recent yank act like `yank-pop'. + +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 +version supports preview of the selected string." + (interactive "*p") + (if (eq last-command 'yank) + (yank-pop (or arg 1)) + (call-interactively #'consult-yank-from-kill-ring))) + +;; Adapted from the Emacs yank-pop function. +;;;###autoload +(defun consult-yank-replace (string) + "Select STRING from the kill ring. + +If there was no recent yank, insert the string. +Otherwise replace the just-yanked string with the selected string. + +There exists no equivalent of this command in Emacs 28." + (interactive (list (consult--read-from-kill-ring))) + (when string + (if (not (eq last-command 'yank)) + (consult-yank-from-kill-ring string) + (let ((inhibit-read-only t) + (pt (point)) + (mk (mark t))) + (setq this-command 'yank) + (funcall (or yank-undo-function 'delete-region) (min pt mk) (max pt mk)) + (setq yank-undo-function nil) + (set-marker (mark-marker) pt (current-buffer)) + (insert-for-yank string) + (set-window-start (selected-window) yank-window-start t) + (if (< pt mk) + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer))))))))) + +;;;;; Command: consult-bookmark + +(defun consult--bookmark-preview () + "Create preview function for bookmarks." + (let ((preview (consult--jump-preview)) + (open (consult--temporary-files))) + (lambda (action cand) + (unless cand + (funcall open)) + (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))) + (set-marker (make-marker) pos buf)))))) + +(defun consult--bookmark-action (bm) + "Open BM via `consult--buffer-action'." + (bookmark-jump bm consult--buffer-display)) + +(consult--define-state bookmark) + +(defun consult--bookmark-candidates () + "Return bookmark candidates." + (bookmark-maybe-load-default-file) + (let ((narrow (mapcar (pcase-lambda (`(,y ,_ ,x)) (cons x y)) + consult-bookmark-narrow))) + (mapcar (lambda (cand) + (propertize (car cand) + 'consult--type + (alist-get + (or (bookmark-get-handler cand) #'bookmark-default-handler) + narrow))) + bookmark-alist))) + +;;;###autoload +(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 +variable `consult-bookmark-narrow' for the narrowing configuration." + (interactive + (list + (let ((narrow (mapcar (pcase-lambda (`(,x ,y ,_)) (cons x y)) + consult-bookmark-narrow))) + (consult--read + (consult--bookmark-candidates) + :prompt "Bookmark: " + :state (consult--bookmark-preview) + :category 'bookmark + :history 'bookmark-history + ;; Add default names to future history. + ;; Ignore errors such that `consult-bookmark' can be used in + ;; buffers which are not backed by a file. + :add-history (ignore-errors (bookmark-prop-get (bookmark-make-record) 'defaults)) + :group (consult--type-group narrow) + :narrow (consult--type-narrow narrow))))) + (bookmark-maybe-load-default-file) + (if (assoc name bookmark-alist) + (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 +(defun consult-complex-command () + "Select and evaluate command from the command history. + +This command can act as a drop-in replacement for `repeat-complex-command'." + (interactive) + (let* ((history (or (delete-dups (mapcar #'prin1-to-string command-history)) + (user-error "There are no previous complex commands"))) + (cmd (read (consult--read + history + :prompt "Command: " + :default (car history) + :sort nil + :history t ;; disable history + :category 'expression)))) + ;; Taken from `repeat-complex-command' + (add-to-history 'command-history cmd) + (apply #'funcall-interactively + (car cmd) + (mapcar (lambda (e) (eval e t)) (cdr cmd))))) + +;;;;; Command: consult-history + +(declare-function ring-elements "ring") +(defun consult--current-history (&optional history) + "Return the normalized HISTORY or the history relevant to the current buffer. + +If the minibuffer is active, returns the minibuffer history, +otherwise the history corresponding to the mode is returned. +There is a special case for `repeat-complex-command', +for which the command history is used." + (cond + (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-:"! + ((eq last-command 'repeat-complex-command) + (setq history (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) + (if (eq minibuffer-history-variable t) + (user-error "Minibuffer history is disabled for `%s'" this-command) + (setq history (mapcar #'consult--tofu-hide (symbol-value minibuffer-history-variable))))) + ;; Otherwise we use a mode-specific history, see `consult-mode-histories'. + (t (when-let (found + (or (seq-find (lambda (ring) + (and (derived-mode-p (car ring)) + (boundp (cdr ring)))) + consult-mode-histories) + (user-error + "No history configured for `%s', see `consult-mode-histories'" + major-mode))) + (setq history (symbol-value (cdr found)))))) + (consult--remove-dups (if (ring-p history) (ring-elements history) history))) + +;; This command has been adopted from https://github.com/oantolin/completing-history/. +;;;###autoload +(defun consult-history (&optional history) + "Insert string from HISTORY of current buffer. +In order to select from a specific HISTORY, pass the history variable +as argument. See also `cape-history' from the Cape package." + (interactive) + (let ((str (consult--local-let ((enable-recursive-minibuffers t)) + (consult--read + (or (consult--current-history 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)) + (insert (substring-no-properties str)))) + +;;;;; Command: consult-isearch-history + +(defun consult-isearch-forward (&optional reverse) + "Continue isearch forward optionally in REVERSE." + (interactive) + (consult--require-minibuffer) + (setq isearch-new-forward (not reverse) isearch-new-nonincremental nil) + (funcall (or (command-remapping #'exit-minibuffer) #'exit-minibuffer))) + +(defun consult-isearch-backward (&optional reverse) + "Continue isearch backward optionally in REVERSE." + (interactive) + (consult-isearch-forward (not reverse))) + +;; Emacs 28: hide in M-X +(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'.") + +(defun consult--isearch-history-candidates () + "Return isearch history candidates." + ;; NOTE: Do not throw an error on empty history, + ;; in order to allow starting a search. + ;; We do not :require-match here! + (let ((history (if (eq t search-default-mode) + (append regexp-search-ring search-ring) + (append search-ring regexp-search-ring)))) + (cons + (delete-dups + (mapcar + (lambda (cand) + ;; The search type can be distinguished via text properties. + (let* ((props (plist-member (text-properties-at 0 cand) + 'isearch-regexp-function)) + (type (pcase (cadr props) + ((and 'nil (guard (not props))) ?r) + ('nil ?l) + ('word-search-regexp ?w) + ('isearch-symbol-regexp ?s) + ('char-fold-to-regexp ?c) + (_ ?u)))) + ;; Disambiguate history items. The same string could + ;; occur with different search types. + (consult--tofu-append cand type))) + history)) + (if history + (+ 4 (apply #'max (mapcar #'length history))) + 0)))) + +(defconst consult--isearch-history-narrow + '((?c . "Char") + (?u . "Custom") + (?l . "Literal") + (?r . "Regexp") + (?s . "Symbol") + (?w . "Word"))) + +;;;###autoload +(defun consult-isearch-history () + "Read a search string with completion from the Isearch history. + +This replaces the current search string if Isearch is active, and +starts a new Isearch session otherwise." + (interactive) + (consult--forbid-minibuffer) + (let* ((isearch-message-function 'ignore) ;; Avoid flicker in echo area + (inhibit-redisplay t) ;; Avoid flicker in mode line + (candidates (consult--isearch-history-candidates)) + (align (propertize " " 'display `(space :align-to (+ left ,(cdr candidates)))))) + (unless isearch-mode (isearch-mode t)) + (with-isearch-suspended + (setq isearch-new-string + (consult--read + (car candidates) + :prompt "I-search: " + :category 'consult-isearch + :history t ;; disable history + :sort nil + :initial isearch-string + :keymap consult-isearch-history-map + :annotate + (lambda (cand) + (concat align (alist-get (consult--tofu-get cand) consult--isearch-history-narrow))) + :group + (lambda (cand transform) + (if transform + cand + (alist-get (consult--tofu-get cand) consult--isearch-history-narrow))) + :lookup + (lambda (selected candidates &rest _) + (if-let (found (member selected candidates)) + (substring (car found) 0 -1) + selected)) + :state + (lambda (action cand) + (when (and (eq action 'preview) cand) + (setq isearch-string cand) + (isearch-update-from-string-properties cand) + (isearch-update))) + :narrow + (list :predicate + (lambda (cand) (= (consult--tofu-get cand) consult--narrow)) + :keys consult--isearch-history-narrow)) + isearch-new-message + (mapconcat 'isearch-text-char-description isearch-new-string ""))) + ;; Setting `isearch-regexp' etc only works outside of `with-isearch-suspended'. + (unless (plist-member (text-properties-at 0 isearch-string) 'isearch-regexp-function) + (setq isearch-regexp t + isearch-regexp-function nil)))) + +;;;;; Command: consult-minor-mode-menu + +(defun consult--minor-mode-candidates () + "Return list of minor-mode candidate strings." + (mapcar + (pcase-lambda (`(,name . ,sym)) + (propertize + name + 'consult--candidate sym + 'consult--minor-mode-narrow + (logior + (ash (if (local-variable-if-set-p sym) ?l ?g) 8) + (if (and (boundp sym) (symbol-value sym)) ?i ?o)) + 'consult--minor-mode-group + (concat + (if (local-variable-if-set-p sym) "Local " "Global ") + (if (and (boundp sym) (symbol-value sym)) "On" "Off")))) + (nconc + ;; according to describe-minor-mode-completion-table-for-symbol + ;; the minor-mode-list contains *all* minor modes + (mapcar (lambda (sym) (cons (symbol-name sym) sym)) minor-mode-list) + ;; take the lighters from minor-mode-alist + (delq nil + (mapcar (pcase-lambda (`(,sym ,lighter)) + (when (and lighter (not (equal "" lighter))) + (setq lighter (string-trim (format-mode-line lighter))) + (unless (string-blank-p lighter) + (cons lighter sym)))) + minor-mode-alist))))) + +(defconst consult--minor-mode-menu-narrow + '((?l . "Local") + (?g . "Global") + (?i . "On") + (?o . "Off"))) + +;;;###autoload +(defun consult-minor-mode-menu () + "Enable or disable minor mode. + +This is an alternative to `minor-mode-menu-from-indicator'." + (interactive) + (call-interactively + (consult--read + (consult--minor-mode-candidates) + :prompt "Minor mode: " + :require-match t + :category 'minor-mode + :group + (lambda (cand transform) + (if transform cand (get-text-property 0 'consult--minor-mode-group cand))) + :narrow + (list :predicate + (lambda (cand) + (let ((narrow (get-text-property 0 'consult--minor-mode-narrow cand))) + (or (= (logand narrow 255) consult--narrow) + (= (ash narrow -8) consult--narrow)))) + :keys + consult--minor-mode-menu-narrow) + :lookup #'consult--lookup-candidate + :history 'consult--minor-mode-menu-history))) + +;;;;; Command: consult-theme + +;;;###autoload +(defun consult-theme (theme) + "Disable current themes and enable THEME from `consult-themes'. + +The command supports previewing the currently selected theme." + (interactive + (list + (let* ((regexp (consult--regexp-filter + (mapcar (lambda (x) (if (stringp x) x (format "\\`%s\\'" x))) + consult-themes))) + (avail-themes (seq-filter + (lambda (x) (string-match-p regexp (symbol-name x))) + (cons 'default (custom-available-themes)))) + (saved-theme (car custom-enabled-themes))) + (consult--read + (mapcar #'symbol-name avail-themes) + :prompt "Theme: " + :require-match t + :category 'theme + :history 'consult--theme-history + :lookup (lambda (selected &rest _) + (setq selected (and selected (intern-soft selected))) + (or (and selected (car (memq selected avail-themes))) + saved-theme)) + :state (lambda (action theme) + (pcase action + ('return (consult-theme (or theme saved-theme))) + ((and 'preview (guard theme)) (consult-theme theme)))) + :default (symbol-name (or saved-theme 'default)))))) + (when (eq theme 'default) (setq theme nil)) + (unless (eq theme (car custom-enabled-themes)) + (mapc #'disable-theme custom-enabled-themes) + (when theme + (if (custom-theme-p theme) + (enable-theme theme) + (load-theme theme :no-confirm))))) + +;;;;; Command: consult-buffer + +(defun consult--buffer-sort-alpha (buffers) + "Sort BUFFERS alphabetically, but push down starred buffers." + (sort buffers + (lambda (x y) + (setq x (buffer-name x) y (buffer-name y)) + (let ((a (and (length> x 0) (eq (aref x 0) ?*))) + (b (and (length> y 0) (eq (aref y 0) ?*)))) + (if (eq a b) + (string< x y) + (not a)))))) + +(defun consult--buffer-sort-visibility (buffers) + "Sort BUFFERS by visibility." + (let ((hidden) + (current (current-buffer))) + (consult--keep! buffers + (unless (eq it current) + (if (get-buffer-window it 'visible) + it + (push it hidden) + nil))) + (nconc (nreverse hidden) buffers (list (current-buffer))))) + +(defun consult--normalize-directory (dir) + "Normalize directory DIR. +DIR can be project, nil or a path." + (cond + ((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. +PROMPT is the prompt format string. +QUERY is passed to `consult--buffer-query'." + (let* ((dir (plist-get query :directory)) + (ndir (consult--normalize-directory dir)) + (buffers (apply #'consult--buffer-query :directory ndir query)) + (count (length buffers))) + (cons (format "%s (%d buffer%s%s): " prompt count + (if (= count 1) "" "s") + (cond + ((and ndir (eq dir 'project)) + (format ", Project %s" (consult--project-name ndir))) + (ndir (concat ", " (consult--abbreviate-directory ndir))) + (t ""))) + buffers))) + +(cl-defun consult--buffer-query (&key sort directory mode as predicate (filter t) + include (exclude consult-buffer-filter)) + "Buffer query function. +DIRECTORY can either be project or a path. +SORT can be visibility, alpha or nil. +FILTER can be either t, nil or invert. +EXCLUDE is a list of regexps. +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 + ;; function supports filtering by various criteria which are used throughout + ;; Consult. + (let ((root (consult--normalize-directory directory)) + (buffers (buffer-list))) + (when sort + (setq buffers (funcall (intern (format "consult--buffer-sort-%s" sort)) buffers))) + (when (or filter mode as root) + (let ((mode (ensure-list mode)) + (exclude-re (consult--regexp-filter exclude)) + (include-re (consult--regexp-filter include))) + (consult--keep! buffers + (and + (or (not mode) + (apply #'provided-mode-derived-p + (buffer-local-value 'major-mode it) mode)) + (pcase-exhaustive filter + ('nil t) + ((or 't 'invert) + (eq (eq filter t) + (and + (or (not exclude) + (not (string-match-p exclude-re (buffer-name it)))) + (or (not include) + (not (not (string-match-p include-re (buffer-name it))))))))) + (or (not root) + (when-let (dir (buffer-local-value 'default-directory it)) + (string-prefix-p root + (if (and (/= 0 (length dir)) (eq (aref dir 0) ?/)) + dir + (expand-file-name dir))))) + (or (not predicate) (funcall predicate it)) + (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))) + +(defun consult--buffer-preview () + "Buffer preview function." + (let ((orig-buf (current-buffer)) other-win) + (lambda (action cand) + (when (eq action 'preview) + (when (and (eq consult--buffer-display #'switch-to-buffer-other-window) + (not other-win)) + (switch-to-buffer-other-window orig-buf) + (setq other-win (selected-window))) + (let ((win (or other-win (selected-window)))) + (when (window-live-p win) + (with-selected-window win + (cond + ((and cand (get-buffer cand)) + (switch-to-buffer cand 'norecord)) + ((buffer-live-p orig-buf) + (switch-to-buffer orig-buf 'norecord)))))))))) + +(defun consult--buffer-action (buffer &optional norecord) + "Switch to BUFFER via `consult--buffer-display' function. +If NORECORD is non-nil, do not record the buffer switch in the buffer list." + (funcall consult--buffer-display buffer norecord)) + +(consult--define-state buffer) + +(defvar consult--source-bookmark + `(:name "Bookmark" + :narrow ?m + :category bookmark + :face consult-bookmark + :history bookmark-history + :items ,#'bookmark-all-names + :state ,#'consult--bookmark-state) + "Bookmark candidate source for `consult-buffer'.") + +(defvar consult--source-project-buffer + `(:name "Project Buffer" + :narrow (?p . "Project") + :hidden t + :category buffer + :face consult-buffer + :history buffer-name-history + :state ,#'consult--buffer-state + :enabled ,(lambda () consult-project-function) + :items + ,(lambda () + (when-let (root (consult--project-root)) + (consult--buffer-query :sort 'visibility + :directory root + :as #'buffer-name)))) + "Project buffer candidate source for `consult-buffer'.") + +(defvar consult--source-project-recent-file + `(:name "Project File" + :narrow (?p . "Project") + :hidden t + :category file + :face consult-file + :history file-name-history + :state ,#'consult--file-state + :new + ,(lambda (file) + (consult--file-action + (expand-file-name file (consult--project-root)))) + :enabled + ,(lambda () + (and consult-project-function + recentf-mode)) + :items + ,(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)))))) + "Project file candidate source for `consult-buffer'.") + +(defvar consult--source-hidden-buffer + `(:name "Hidden Buffer" + :narrow 32 + :hidden t + :category buffer + :face consult-buffer + :history buffer-name-history + :action ,#'consult--buffer-action + :items + ,(lambda () (consult--buffer-query :sort 'visibility + :filter 'invert + :as #'buffer-name))) + "Hidden buffer candidate source for `consult-buffer'.") + +(defvar consult--source-modified-buffer + `(:name "Modified Buffer" + :narrow ?* + :hidden t + :category buffer + :face consult-buffer + :history buffer-name-history + :state ,#'consult--buffer-state + :items + ,(lambda () (consult--buffer-query :sort 'visibility + :as #'buffer-name + :predicate + (lambda (buf) + (and (buffer-modified-p buf) + (buffer-file-name buf)))))) + "Modified buffer candidate source for `consult-buffer'.") + +(defvar consult--source-buffer + `(:name "Buffer" + :narrow ?b + :category buffer + :face consult-buffer + :history buffer-name-history + :state ,#'consult--buffer-state + :default t + :items + ,(lambda () (consult--buffer-query :sort 'visibility + :as #'buffer-name))) + "Buffer candidate source for `consult-buffer'.") + +(defvar consult--source-recent-file + `(:name "File" + :narrow ?f + :category file + :face consult-file + :history file-name-history + :state ,#'consult--file-state + :new ,#'consult--file-action + :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))))) + "Recent file candidate source for `consult-buffer'.") + +;;;###autoload +(defun consult-buffer (&optional sources) + "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), +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 +configuration of the virtual buffer sources." + (interactive) + (let ((selected (consult--multi (or sources consult-buffer-sources) + :require-match + (confirm-nonexistent-file-or-buffer) + :prompt "Switch to: " + :history 'consult--buffer-history + :sort nil))) + ;; For non-matching candidates, fall back to buffer creation. + (unless (plist-get (cdr selected) :match) + (consult--buffer-action (car selected))))) + +;; Populate `consult-project-buffer-sources'. +(setq consult-project-buffer-sources + (list + `(:hidden nil :narrow ?b ,@consult--source-project-buffer) + `(:hidden nil :narrow ?f ,@consult--source-project-recent-file))) + +(defmacro consult--with-project (&rest body) + "Ensure that BODY is executed with a project root." + ;; We have to work quite hard here to ensure that the project root is + ;; only overriden at the current recursion level. When entering a + ;; recursive minibuffer session, we should be able to still switch the + ;; project. But who does that? Working on the first level on project A + ;; and on the second level on project B and on the third level on project C? + ;; You mustn't be afraid to dream a little bigger, darling. + `(let ((consult-project-function + (let ((root (or (consult--project-root t) (user-error "No project found"))) + (depth (recursion-depth)) + (orig consult-project-function)) + (lambda (may-prompt) + (if (= depth (recursion-depth)) + root + (funcall orig may-prompt)))))) + ,@body)) + +;;;###autoload +(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." + (interactive) + (consult--with-project + (consult-buffer consult-project-buffer-sources))) + +;;;###autoload +(defun consult-buffer-other-window () + "Variant of `consult-buffer' which opens in other window." + (interactive) + (let ((consult--buffer-display #'switch-to-buffer-other-window)) + (consult-buffer))) + +;;;###autoload +(defun consult-buffer-other-frame () + "Variant of `consult-buffer' which opens in other frame." + (interactive) + (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)) + (lambda (action) + (cond + ((stringp action) + (setq highlight (plist-get (funcall builder action) :highlight)) + (funcall async action)) + ((consp action) + (let (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)) + (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) + (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)) + (push str result))))) + (funcall async (nreverse result)))) + (t (funcall async action)))))) + +(defun consult--grep-position (cand &optional find-file) + "Return the grep position marker for CAND. +FIND-FILE is the file open function, defaulting to `find-file'." + (when cand + (let* ((file-end (next-single-property-change 0 'face cand)) + (line-end (next-single-property-change (+ 1 file-end) 'face cand)) + (col (next-single-property-change (+ 1 line-end) 'face cand)) + (file (substring-no-properties cand 0 file-end)) + (line (string-to-number (substring-no-properties cand (+ 1 file-end) line-end)))) + (setq col (if col (- col line-end 1) 0)) + (consult--position-marker + (funcall (or find-file #'find-file) file) + line col)))) + +(defun consult--grep-state () + "Grep state function." + (let ((open (consult--temporary-files)) + (jump (consult--jump-state))) + (lambda (action cand) + (unless cand + (funcall open)) + (funcall jump action (consult--grep-position + 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 (prompt builder dir initial) + "Run grep in DIR. + +BUILDER is the command builder. +PROMPT is the prompt string. +INITIAL is inital input." + (let* ((prompt-dir (consult--directory-prompt prompt dir)) + (default-directory (cdr prompt-dir))) + (consult--read + (consult--async-command builder + (consult--grep-format builder) + :file-handler t) ;; allow tramp + :prompt (car prompt-dir) + :lookup #'consult--lookup-member + :state (consult--grep-state) + :initial (consult--async-split-initial initial) + :add-history (consult--async-split-thingatpt 'symbol) + :require-match t + :category 'consult-grep + :group #'consult--grep-group + :history '(:input consult--grep-history) + :sort nil))) + +(defun consult--grep-lookahead-p (&rest cmd) + "Return t if grep CMD supports lookahead." + (with-temp-buffer + (insert "xaxbx") + (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 (append (split-string-and-unquote consult-grep-args) + (mapcar (lambda (s) (concat "--exclude=" s)) + (bound-and-true-p grep-find-ignored-files)) + (mapcar (lambda (s) (concat "--exclude-dir=" s)) + (bound-and-true-p grep-find-ignored-directories)))) + (`(,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)))))) + +;;;###autoload +(defun consult-grep (&optional dir initial) + "Search with `grep' for files in DIR where the content matches a regexp. + +The initial input is given by the INITIAL argument. + +The input string is split, the first part of the string (grep input) is +passed to the asynchronous grep process and the second part of the string is +passed to the completion-style filtering. + +The input string is split at a punctuation character, which is given as the +first character of the input string. The format is similar to Perl-style +regular expressions, e.g., /regexp/. Furthermore command line options can be +passed to grep, specified behind --. The overall prompt input has the form +`#async-input -- grep-opts#filter-string'. + +Note that the grep input string is transformed from Emacs regular expressions +to Posix regular expressions. Always enter Emacs regular expressions at the +prompt. `consult-grep' behaves like builtin Emacs search commands, e.g., +Isearch, which take Emacs regular expressions. Furthermore the asynchronous +input split into words, each word must match separately and in any order. See +`consult--regexp-compiler' for the inner workings. In order to disable +transformations of the grep input, adjust `consult--regexp-compiler' +accordingly. + +Here we give a few example inputs: + +#alpha beta : Search for alpha and beta in any order. +#alpha.*beta : Search for alpha before beta. +#\\(alpha\\|beta\\) : Search for alpha or beta (Note Emacs syntax!) +#word -- -C3 : Search for word, include 3 lines as context +#first#second : Search for first, quick filter for second. + +The symbol at point is added to the future history. If `consult-grep' +is called interactively with a prefix argument, the user can specify +the directory to search in. By default the project directory is used +if `consult-project-function' is defined and returns non-nil. +Otherwise the `default-directory' is searched." + (interactive "P") + (consult--grep "Grep" #'consult--grep-builder dir initial)) + +;;;;; Command: consult-git-grep + +(defun consult--git-grep-builder (input) + "Build command line given CONFIG and INPUT." + (pcase-let* ((cmd (split-string-and-unquote consult-git-grep-args)) + (`(,arg . ,opts) (consult--command-split input)) + (flags (append cmd opts)) + (ignore-case (or (member "-i" flags) (member "--ignore-case" flags)))) + (if (or (member "-F" flags) (member "--fixed-strings" flags)) + `(:command (,@cmd "-e" ,arg ,@opts) :highlight + ,(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)))))) + +;;;###autoload +(defun consult-git-grep (&optional dir initial) + "Search with `git grep' for files in DIR where the content matches a regexp. +The initial input is given by the INITIAL argument. See `consult-grep' +for more details." + (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 (split-string-and-unquote 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)))))) + +;;;###autoload +(defun consult-ripgrep (&optional dir initial) + "Search with `rg' for files in DIR where the content matches a regexp. +The initial input is given by the INITIAL argument. See `consult-grep' +for more details." + (interactive "P") + (consult--grep "Ripgrep" #'consult--ripgrep-builder dir initial)) + +;;;;; Command: consult-find + +(defun consult--find (prompt builder initial) + "Run find command in current directory. + +The function returns the selected file. +The filename at point is added to the future history. + +BUILDER is the command builder. +PROMPT is the prompt. +INITIAL is inital input." + (consult--read + (consult--async-command builder + (consult--async-map (lambda (x) (string-remove-prefix "./" x))) + (consult--async-highlight builder) + :file-handler t) ;; allow tramp + :prompt prompt + :sort nil + :require-match t + :initial (consult--async-split-initial initial) + :add-history (consult--async-split-thingatpt 'filename) + :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 (split-string-and-unquote 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)))) + +;;;###autoload +(defun consult-find (&optional dir initial) + "Search for files in DIR matching input regexp given INITIAL input. + +The find process is started asynchronously, similar to `consult-grep'. +See `consult-grep' for more details regarding the asynchronous search." + (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)))) + +;;;;; Command: consult-locate + +(defun consult--locate-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 (split-string-and-unquote consult-locate-args) + (list arg) opts) + :highlight (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 +details regarding the asynchronous search." + (interactive) + (find-file (consult--find "Locate: " #'consult--locate-builder initial))) + +;;;;; Command: consult-man + +(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 (split-string-and-unquote consult-man-args) + (list arg) opts) + :highlight (cdr (consult--default-regexp-compiler input 'basic t)))))) + +(defun consult--man-format (lines) + "Format man candidates from LINES." + (let ((candidates)) + (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))))) + (nreverse candidates))) + +;;;###autoload +(defun consult-man (&optional initial) + "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 +the asynchronous search." + (interactive) + (man (consult--read + (consult--async-command #'consult--man-builder + (consult--async-transform consult--man-format) + (consult--async-highlight #'consult--man-builder)) + :prompt "Manual entry: " + :require-match t + :lookup #'consult--lookup-cdr + :initial (consult--async-split-initial initial) + :add-history (consult--async-split-thingatpt 'symbol) + :history '(:input consult--man-history)))) + +;;;; Preview at point in completions buffers + +(define-minor-mode consult-preview-at-point-mode + "Preview minor mode for *Completions* buffers. +When moving around in the *Completions* buffer, the candidate at point is +automatically previewed." + :init-value nil :group 'consult + (if consult-preview-at-point-mode + (add-hook 'post-command-hook #'consult-preview-at-point nil 'local) + (remove-hook 'post-command-hook #'consult-preview-at-point 'local))) + +(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))) + (funcall fun))) + +;;;; Integration with the default completion system + +(defun consult--default-completion-minibuffer-candidate () + "Return current minibuffer candidate from default completion system or Icomplete." + (when (and (minibufferp) + (eq completing-read-function #'completing-read-default)) + (let ((content (minibuffer-contents-no-properties))) + ;; When the current minibuffer content matches a candidate, return it! + (if (test-completion content + minibuffer-completion-table + minibuffer-completion-predicate) + content + ;; Return the full first candidate of the sorted completion list. + (when-let ((completions (completion-all-sorted-completions))) + (concat + (substring content 0 (or (cdr (last completions)) 0)) + (car completions))))))) + +(defun consult--default-completion-list-candidate () + "Return current candidate at point from completions buffer." + (let (beg end) + (when (and + (derived-mode-p 'completion-list-mode) + ;; Logic taken from `choose-completion'. + ;; TODO Upstream a `completion-list-get-candidate' function. + (cond + ((and (not (eobp)) (get-text-property (point) 'mouse-face)) + (setq end (point) beg (1+ (point)))) + ((and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) + (setq end (1- (point)) beg (point))))) + (setq beg (previous-single-property-change beg 'mouse-face) + end (or (next-single-property-change end 'mouse-face) (point-max))) + (or (get-text-property beg 'completion--string) + (buffer-substring-no-properties beg end))))) + +;; Announce now that consult has been loaded +(provide 'consult) + +;;;; Integration with other completion systems + +(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)) + +;;; consult.el ends here diff --git a/elpa/consult-0.19/consult.info b/elpa/consult-0.19/consult.info @@ -0,0 +1,1491 @@ +This is consult.info, produced by makeinfo version 6.7 from +consult.texi. + +INFO-DIR-SECTION Emacs misc features +START-INFO-DIR-ENTRY +* Consult: (consult). Useful commands built on completing-read. +END-INFO-DIR-ENTRY + + +File: consult.info, Node: Top, Next: Available commands, Up: (dir) + +consult.el - Consulting completing-read +*************************************** + +Consult provides practical commands based on the Emacs completion +function completing-read +(https://www.gnu.org/software/emacs/manual/html_node/elisp/Minibuffer-Completion.html). +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 *note live +preview: Live previews, *note grouping and narrowing: Narrowing and +grouping. Please take a look at the *note full list of commands: +Available commands. + + Consult is fully compatible with completion systems based on the +standard Emacs ‘completing-read’ API, notably the default completion +system, Vertico (https://github.com/minad/vertico), Mct +(https://github.com/protesilaos/mct), Icomplete +(https://www.gnu.org/software/emacs/manual/html_node/emacs/Icomplete.html) +and Selectrum (https://github.com/radian-software/selectrum). + + 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 the main advantages of the package. Consult fits well +into existing setups and it helps you to create a full completion +environment out of small and independent components. Note that, if you +use Ivy (https://github.com/abo-abo/swiper#ivy) or Helm +(https://github.com/emacs-helm/helm), you probably don’t need Consult, +since both packages bring their own Consult-like functionality. + + You can combine the complementary packages Marginalia +(https://github.com/minad/marginalia/), Embark +(https://github.com/oantolin/embark/) and Orderless +(https://github.com/oantolin/orderless) with 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 selected candidate in the minibuffer or at point in normal buffers. +For example, when selecting from a list of files, Embark offers an +action to delete the file. Additionally Embark offers a facility to +collect completion candidates in a collect buffer. The section *note +Embark integration:: documents in greater detail how Consult and Embark +work together. + +* Menu: + +* Available commands:: Navigation, search, editing commands and more +* Special features:: Enhancements over built-in ‘completing-read’ +* Configuration:: Example configuration and customization variables +* Recommended packages:: Related packages recommended for installation +* Bug reports:: How to create reproducible bug reports +* Contributions:: Feature requests and pull requests +* Acknowledgments:: Contributors and Sources of Inspiration +* Indices:: Indices of concepts and functions + +— The Detailed Node Listing — + +Available commands + +* Virtual Buffers:: Buffers, bookmarks and recent files +* Editing:: Commands useful for editing +* Register:: Searching through registers and fast access +* Navigation:: Mark rings, outlines and imenu +* Search:: Line search, grep and file search +* Grep and Find:: Searching through the filesystem +* Compilation:: Jumping to references and compilation errors +* Histories:: Navigating histories +* Modes:: Toggling minor modes and executing commands +* Org Mode:: Org-specific commands +* Miscellaneous:: Various other useful commands + +Special features + +* Live previews:: Preview the currently selected candidate +* Narrowing and grouping:: Restricting the completion to a candidate group +* Asynchronous search:: Filtering asynchronously generated candidate lists +* Multiple sources:: Combining candidates from different sources +* Embark integration:: Actions, Grep/Occur-buffer export + +Configuration + +* Use-package example:: Configuration example based on use-package +* Custom variables:: Short description of all customization settings +* Fine-tuning:: Fine-grained configuration for special requirements + +Indices + +* Function index:: List of all Consult commands +* Concept index:: List of all Consult-specific concepts + + + +File: consult.info, Node: Available commands, Next: Special features, Prev: Top, Up: Top + +1 Available commands +******************** + +Most Consult commands follow the meaningful naming scheme +‘consult-<thing>’. Many commands implement a little known but +convenient Emacs feature called "future history", which guesses what +input the user wants. At a command prompt type ‘M-n’ and typically +Consult will insert the symbol or thing at point into the input. + + *TIP:* If you have Marginalia (https://github.com/minad/marginalia) +annotators activated, type ‘M-x ^consult’ to see 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. + +* Menu: + +* Virtual Buffers:: Buffers, bookmarks and recent files +* Editing:: Commands useful for editing +* Register:: Searching through registers and fast access +* Navigation:: Mark rings, outlines and imenu +* Search:: Line search, grep and file search +* Grep and Find:: Searching through the filesystem +* Compilation:: Jumping to references and compilation errors +* Histories:: Navigating histories +* Modes:: Toggling minor modes and executing commands +* Org Mode:: Org-specific commands +* Miscellaneous:: Various other useful commands + + +File: consult.info, Node: Virtual Buffers, Next: Editing, Up: Available commands + +1.1 Virtual Buffers +=================== + + • ‘consult-buffer’ (‘-other-window’, ‘-other-frame’): Enhanced + version of ‘switch-to-buffer’ with support for virtual buffers. + Supports live preview of buffers and narrowing to the virtual + buffer types. You can type ‘f SPC’ in order to narrow to recent + files. Press ‘SPC’ to show ephemeral buffers. Supported narrowing + keys: + • b Buffers + • SPC Hidden buffers + • * Modified buffers + • f Files (Requires ‘recentf-mode’) + • m Bookmarks + • p Project + • Custom *note other sources: Multiple sources. configured in + ‘consult-buffer-sources’. + • ‘consult-project-buffer’: Variant of ‘consult-buffer’ restricted to + buffers and recent files of the current project. You can add + custom sources to ‘consult-project-buffer-sources’. The command + may prompt you for a project if you invoke it from outside a + project. + • ‘consult-bookmark’: Select or create bookmark. To select bookmarks + you might use the ‘consult-buffer’ as an alternative, which can + include a bookmark virtual buffer source. Note that + ‘consult-bookmark’ supports preview of bookmarks and narrowing. + • ‘consult-recent-file’: Select from recent files with preview. You + might prefer the powerful ‘consult-buffer’ instead, which can + include recent files as a virtual buffer source. The + ‘recentf-mode’ enables tracking of recent files. + + +File: consult.info, Node: Editing, Next: Register, Prev: Virtual Buffers, Up: Available commands + +1.2 Editing +=========== + + • ‘consult-yank-from-kill-ring’: Enhanced version of ‘yank’ to select + an item from the ‘kill-ring’. The selected text previewed as + overlay in the buffer. + • ‘consult-yank-pop’: Enhanced version of ‘yank-pop’ with + DWIM-behavior, which either replaces the last ‘yank’ by cycling + through the ‘kill-ring’, or if there has not been a last ‘yank’ + consults the ‘kill-ring’. The selected text previewed as overlay + in the buffer. + • ‘consult-yank-replace’: Like ‘consult-yank-pop’, but always + replaces the last ‘yank’ with an item from the ‘kill-ring’. + • ‘consult-kmacro’: Select macro from the macro ring and execute it. + + +File: consult.info, Node: Register, Next: Navigation, Prev: Editing, Up: Available commands + +1.3 Register +============ + + • ‘consult-register’: Select from list of registers. The command + supports narrowing to register types and preview of marker + positions. This command is useful to search the register contents. + For quick access use the commands ‘consult-register-load’, + ‘consult-register-store’ or the built-in Emacs register commands. + • ‘consult-register-format’: Set ‘register-preview-function’ to this + function for an enhanced register formatting. See the *note + example configuration: Use-package example. + • ‘consult-register-window’: Replace ‘register-preview’ with this + function for a better register window. See the *note example + configuration: Use-package example. + • ‘consult-register-load’: Utility command to quickly load a + register. The command either jumps to the register value or + inserts it. + • ‘consult-register-store’: Improved UI to store registers depending + on the current context with an action menu. With an active region, + store/append/prepend the contents, optionally deleting the region + when a prefix argument is given. With a numeric prefix argument, + store/add the number. Otherwise store point, frameset, window or + kmacro. Usage examples: + • ‘M-' x’: If no region is active, store point in register ‘x’. + If a region is active, store the region in register ‘x’. + • ‘M-' M-w x’: Store window configuration in register ‘x’. + • ‘C-u 100 M-' x’: Store number in register ‘x’. + + +File: consult.info, Node: Navigation, Next: Search, Prev: Register, Up: Available commands + +1.4 Navigation +============== + + • ‘consult-goto-line’: Jump to line number enhanced with live + preview. This is a drop-in replacement for ‘goto-line’. + • ‘consult-mark’: Jump to a marker in the ‘mark-ring’. Supports live + preview and recursive editing. + • ‘consult-global-mark’: Jump to a marker in the ‘global-mark-ring’. + Supports live preview and recursive editing. + • ‘consult-outline’: Jump to a heading of the outline. Supports + narrowing to a heading level, live preview and recursive editing. + • ‘consult-imenu’: Jump to imenu item in the current buffer. + Supports live preview, recursive editing and narrowing. + • ‘consult-imenu-multi’: Jump to imenu item in project buffers, with + the same major mode as the current buffer. Supports live preview, + recursive editing and narrowing. This feature has been inspired by + imenu-anywhere (https://github.com/vspinu/imenu-anywhere). + + +File: consult.info, Node: Search, Next: Grep and Find, Prev: Navigation, Up: Available commands + +1.5 Search +========== + + • ‘consult-line’: Enter search string and select from matching lines. + Supports live preview and recursive editing. The symbol at point + and the 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-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 Embark collect + buffer further, relying on the same completion filtering as + ‘completing-read’. If the input begins with the negation operator, + i.e., ‘! SPC’, the filter matches the complement. If a region is + active, the region restricts the filtering. + • ‘consult-focus-lines’: Temporarily hide lines by filtering them + using the current completion style. Call with ‘C-u’ prefix + argument in order to show the hidden lines again. If the input + begins with the negation operator, i.e., ‘! SPC’, the filter + matches the complement. In contrast to ‘consult-keep-lines’ this + function does not edit the buffer. If a region is active, the + region restricts the filtering. + + +File: consult.info, Node: Grep and Find, Next: Compilation, Prev: Search, Up: Available commands + +1.6 Grep and Find +================= + + • ‘consult-grep’, ‘consult-ripgrep’, ‘consult-git-grep’: Search for + regular expression in files. Consult invokes Grep asynchronously, + while you enter the search term. After at least + ‘consult-async-min-input’ characters, the search gets started. + Consult splits the input string into two parts, if the first + character is a punctuation character, like ‘#’. For example + ‘#regexps#filter-string’, is split at the second ‘#’. The string + ‘regexps’ is passed to Grep. Note that Consult transforms Emacs + regular expressions to expressions understand by the search + program. Always use Emacs regular expressions at the prompt. If + you enter multiple regular expressions separated by space only + lines matching all regular expressions are shown. In order to + match space literally, escape the space with a backslash. The + ‘filter-string’ is passed to the _fast_ Emacs filtering to further + narrow down the list of matches. This is particularly useful if + you are using an advanced completion style like orderless. + ‘consult-grep’ supports preview. If the ‘consult-project-function’ + returns non-nil, ‘consult-grep’ searches the current project + directory. Otherwise the ‘default-directory’ is searched. If + ‘consult-grep’ is invoked with prefix argument ‘C-u M-s g’, you can + specify the directory manually. + • ‘consult-find’, ‘consult-locate’: Find file by matching the path + against a regexp. Like for ‘consult-grep,’ either the project root + or the current directory is the root directory for the search. The + input string is treated similarly to ‘consult-grep’, where the + first part is passed to find, and the second part is used for Emacs + filtering. + + +File: consult.info, Node: Compilation, Next: Histories, Prev: Grep and Find, Up: Available commands + +1.7 Compilation +=============== + + • ‘consult-compile-error’: Jump to a compilation error. Supports + live preview narrowing and recursive editing. + • ‘consult-flymake’: Jump to flymake diagnostic. Supports live + preview and recursive editing. The command supports narrowing. + Press ‘e SPC’, ‘w SPC’, ‘n SPC’ to only show errors, warnings and + notes respectively. + • ‘consult-xref’: Integration with xref. This function can be set as + ‘xref-show-xrefs-function’ and ‘xref-show-definitions-function’. + + +File: consult.info, Node: Histories, Next: Modes, Prev: Compilation, Up: Available commands + +1.8 Histories +============= + + • ‘consult-complex-command’: Select a command from the + ‘command-history’. This command is a ‘completing-read’ version of + ‘repeat-complex-command’ and is also a replacement for the + ‘command-history’ command from chistory.el. + • ‘consult-history’: Insert a string from the current buffer history, + for example the Eshell or Comint history. You can also invoke this + command from the minibuffer. In that case ‘consult-history’ uses + the history stored in the ‘minibuffer-history-variable’. If you + prefer ‘completion-at-point’, take a look at ‘cape-history’ from + the Cape (https://github.com/minad/cape) package. + • ‘consult-isearch-history’: During an Isearch session, this command + picks a search string from history and continues the search with + the newly selected string. Outside of Isearch, the command allows + you to pick a string from the history and starts a new Isearch. + ‘consult-isearch-history’ acts as a drop-in replacement for + ‘isearch-edit-string’. + + +File: consult.info, Node: Modes, Next: Org Mode, Prev: Histories, Up: Available commands + +1.9 Modes +========= + + • ‘consult-minor-mode-menu’: Enable/disable minor mode. Supports + narrowing to on/off/local/global modes by pressing ‘i/o/l/g SPC’ + respectively. + • ‘consult-mode-command’: Run a command from the currently active + minor or major modes. Supports narrowing to + local-minor/global-minor/major mode via the keys ‘l/g/m’. + + +File: consult.info, Node: Org Mode, Next: Miscellaneous, Prev: Modes, Up: Available commands + +1.10 Org Mode +============= + + • ‘consult-org-heading’: Similar to ‘consult-outline’, for Org + buffers. Supports narrowing by heading level, priority and TODO + state, as well as live preview and recursive editing. + • ‘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. + + +File: consult.info, Node: Miscellaneous, Prev: Org Mode, Up: Available commands + +1.11 Miscellaneous +================== + + • ‘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 mode which previews the candidate at point in the + ‘*Completions*’ buffer. This mode is relevant if you use Mct + (https://git.sr.ht/~protesilaos/mct) or the default ‘*Completions*’ + UI. + • ‘consult-completion-in-region’: In case you don’t use Corfu + (https://github.com/minad/corfu) as your in-buffer completion UI, + this function can be set as ‘completion-in-region-function’. Then + your minibuffer completion UI (e.g., Vertico or Icomplete) will be + used for ‘completion-at-point’. Note that Selectrum provides its + own variant of ‘consult-completion-in-region’. If you use Mct, you + may want to try ‘mct-region-mode’ instead. + ;; Use `consult-completion-in-region' if Vertico is enabled. + ;; Otherwise use the default `completion--in-region' function. + (setq completion-in-region-function + (lambda (&rest args) + (apply (if vertico-mode + #'consult-completion-in-region + #'completion--in-region) + args))) + 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 either the Corfu (https://github.com/minad/corfu) + or the Company (https://github.com/company-mode/company-mode) + package. There is a technical limitation of + ‘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 minibuffer, the server + does not receive the updated input. LSP completion works with + Corfu or Company though, which perform the completion directly in + the original buffer. + + +File: consult.info, Node: Special features, Next: Configuration, Prev: Available commands, Up: Top + +2 Special features +****************** + +Consult enhances ‘completing-read’ with live previews of candidates, +additional narrowing capabilities to candidate groups and asynchronously +generated candidate lists. The internal ‘consult--read’ function, which +is used by most Consult commands, is a thin wrapper around +‘completing-read’ and provides the special functionality. In order to +support multiple candidate sources there exists the high-level function +‘consult--multi’. The architecture of Consult allows it to work with +different completion systems in the backend, while still offering +advanced features. + +* Menu: + +* Live previews:: Preview the currently selected candidate +* Narrowing and grouping:: Restricting the completion to a candidate group +* Asynchronous search:: Filtering asynchronously generated candidate lists +* Multiple sources:: Combining candidates from different sources +* Embark integration:: Actions, Grep/Occur-buffer export + + +File: consult.info, Node: Live previews, Next: Narrowing and grouping, Up: Special features + +2.1 Live previews +================= + +Some Consult commands support live previews. For example when you +scroll through the items of ‘consult-line’, the buffer will scroll to +the corresponding position. It is possible to jump back and forth +between the minibuffer and the buffer to perform recursive editing while +the search is ongoing. + + Consult enables previews by default. You can disable them by +adjusting the ‘consult-preview-key’ variable. Furthermore it is +possible to specify keybindings which trigger the preview manually as +shown in the *note example configuration: Use-package example. The +default setting of ‘consult-preview-key’ is ‘any’ which means that +Consult triggers the preview _immediately_ on any key press when the +selected candidate changes. You can configure each command individually +with its own ‘:preview-key’. The 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-."))’ + • Disabled ‘nil’ + + A safe recommendation is to leave automatic immediate previews +enabled in general and disable the automatic preview only for commands +where the preview may be expensive due to file loading. Internally, +Consult uses the value of ‘this-command’ to determine the ‘:preview-key’ +customized. This means that if you wrap a ‘consult-*’ command within +your own function or command, you will also need to add the name of +_your custom command_ to the ‘consult-customize’ call in order for it 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 + + In this case one may wonder what the difference is between using an +Embark action on the current candidate in comparison to a manually +triggered preview. The main difference is that the files opened by +manual preview are closed again after the completion session. +Furthermore during preview some functionality is disabled to improve the +performance, see for example the customization variables +‘consult-preview-allowed-hooks’ and ‘consult-preview-variables’. Files +larger than ‘consult-preview-raw-size’ are previewed literally without +syntax highlighting and without changing the major mode. Delaying the +preview is also useful for ‘consult-theme’, since the theme preview is +slow. The delay results in a smoother UI experience. + + ;; Preview on any key press, but delay 0.5s + (consult-customize consult-theme :preview-key '(:debounce 0.5 any)) + ;; 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)) + + +File: consult.info, Node: Narrowing and grouping, Next: Asynchronous search, Prev: Live previews, Up: Special features + +2.2 Narrowing and grouping +========================== + +Consult has special support for candidate groups. If the completion UI +supports the grouping functionality, the UI separates the groups with +thin lines and shows group titles. Grouping is useful if the list of +candidates consists of candidates of multiple types or candidates from +*note multiple sources: Multiple sources, like the ‘consult-buffer’ +command, which shows both buffers and recently opened files. Note that +you can disable the group titles by setting the ‘:group’ property of the +corresponding command to nil using the ‘consult-customize’ macro. + + By entering a narrowing prefix or by pressing a narrowing key it is +possible to restrict the completion candidates to a certain candidate +group. When you use the ‘consult-buffer’ command, you can enter the +prefix ‘b SPC’ to restrict list of candidates to buffers only. If you +press ‘DEL’ afterwards, the full candidate list will be shown again. +Furthermore a narrowing prefix key and a widening key can be configured +which can be pressed to achieve the same effect, see the configuration +variables ‘consult-narrow-key’ and ‘consult-widen-key’. + + After pressing ‘consult-narrow-key’, the possible narrowing keys can +be shown by pressing ‘C-h’. When pressing ‘C-h’ after some prefix key, +the ‘prefix-help-command’ 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 *note example +configuration: Use-package example. If which-key +(https://github.com/justbur/emacs-which-key) is installed, the narrowing +keys are automatically shown in the which-key window after pressing the +‘consult-narrow-key’. + + +File: consult.info, Node: Asynchronous search, Next: Multiple sources, Prev: Narrowing and grouping, Up: Special features + +2.3 Asynchronous search +======================= + +Consult has support for asynchronous generation of candidate lists. +This feature is used for search commands like ‘consult-grep’, where the +list of matches is generated dynamically while the user is typing a +regular expression. The grep process is executed in the background. +When modifying the regular expression, the background process is +terminated and a new process is started with the modified regular +expression. + + The matches, which have been found, can then be narrowed using the +installed Emacs completion-style. This can be powerful if you are using +for example the ‘orderless’ completion style. + + This two-level filtering is possible by splitting the input string. +Part of the input string is treated as input to grep and part of the +input is used for filtering. There are multiple splitting styles +available, configured in ‘consult-async-split-styles-alist’: ‘nil’, +‘comma’, ‘semicolon’ and ‘perl’. The default splitting style is +configured with the variable ‘consult-async-split-style’. + + With the ‘comma’ and ‘semicolon’ splitting styles, the first word +before the comma or semicolon is passed to grep, the remaining string is +used for filtering. The ‘nil’ splitting style does not perform any +splitting, the whole input is passed to grep. + + The ‘perl’ splitting style splits the input string at a punctuation +character, using a similar syntax as Perl regular expressions. + + Examples: + + • ‘#defun’: Search for "defun" using grep. + • ‘#consult embark’: Search for both "consult" and "embark" using + grep in any order. + • ‘#first.*second’: Search for "first" followed by "second" using + grep. + • ‘#\(consult\|embark\)’: Search for "consult" or "embark" using + grep. Note the usage of Emacs-style regular expressions. + • ‘#defun#consult’: Search for "defun" using grep, filter with the + word "consult". + • ‘/defun/consult’: It is also possible to use other punctuation + characters. + • ‘#to#’: Force searching for "to" using grep, since the grep pattern + must be longer than ‘consult-async-min-input’ characters by + default. + • ‘#defun -- --invert-match#’: Pass argument ‘--invert-match’ to + grep. + + Asynchronous processes like ‘find’ and ‘grep’ create an error log +buffer ‘_*consult-async*’ (note the leading space), which is useful for +troubleshooting. The prompt has a small indicator showing the process +status: + + • ‘:’ the usual prompt colon, before input is provided. + • ‘*’ with warning face, the process is running. + • ‘:’ with success face, success, process exited with an error code + of zero. + • ‘!’ with error face, failure, process exited with a nonzero error + code. + • ‘;’ with error face, interrupted, for example if more input is + provided. + + +File: consult.info, Node: Multiple sources, Next: Embark integration, Prev: Asynchronous search, Up: Special features + +2.4 Multiple sources +==================== + +Multiple synchronous candidate sources can be combined. This feature is +used by the ‘consult-buffer’ command to present buffer-like candidates +in a single menu for quick access. By default ‘consult-buffer’ includes +buffers, bookmarks, recent files and project-specific buffers and files. +It is possible to configure the list of sources via the +‘consult-buffer-sources’ variable. Arbitrary custom sources can be +defined. + + As an example, the bookmark source is defined as follows: + + (defvar consult--source-bookmark + `(:name "Bookmark" + :narrow ?m + :category bookmark + :face consult-bookmark + :history bookmark-history + :items ,#'bookmark-all-names + :action ,#'consult--bookmark-action)) + + Required source fields: + • ‘:category’ Completion category. + • ‘:items’ List of strings to select from or function returning list + of strings. A list of cons cells is not supported. + + Optional source fields: + • ‘:name’ Name of the source, used for narrowing, group titles and + annotations. + • ‘:narrow’ Narrowing character or ‘(character . string)’ pair. + • ‘:preview-key’ Preview key or keys which trigger preview. + • ‘:enabled’ Function which must return t if the source is enabled. + • ‘:hidden’ When t candidates of this source are hidden by default. + • ‘:face’ Face used for highlighting the candidates. + • ‘:annotate’ Annotation function called for each candidate, returns + string. + • ‘:history’ Name of history variable to add selected candidate. + • ‘: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. + + The ‘:state’ and ‘:action’ fields of the sources deserve a longer +explanation. The ‘:action’ function takes a single argument and is only +called after selection with the selected candidate, if the selection has +not been aborted. This functionality is provided for convenience and +easy definition of sources. The ‘:state’ field is more general. The +‘:state’ function is a constructor function without arguments, which can +perform some setup necessary for the preview. It must return a closure +which takes an ACTION and a CANDIDATE argument. See the docstring of +‘consult--with-preview’ for more details about the ACTION argument. + + By default, ‘consult-buffer’ previews buffers, bookmarks and files. +Loading recent files or bookmarks can result in expensive operations. +However it is possible to configure a manual preview as follows. + + (consult-customize + consult--source-bookmark consult--source-recent-file + consult--source-project-recent-file :preview-key (kbd "M-.")) + + 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 +<https://github.com/minad/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))))) + + Another useful source lists all Org buffers and lets you create new +ones. One can create similar sources for other major modes, e.g., for +Eshell. + + (defvar org-source + (list :name "Org Buffer" + :category 'buffer + :narrow ?o + :face 'consult-buffer + :history 'buffer-name-history + :state #'consult--buffer-state + :new + (lambda (name) + (with-current-buffer (get-buffer-create name) + (insert "#+title: " name "\n\n") + (org-mode) + (consult--buffer-action (current-buffer)))) + :items + (lambda () + (mapcar #'buffer-name + (seq-filter + (lambda (x) + (eq (buffer-local-value 'major-mode x) 'org-mode)) + (buffer-list)))))) + + (add-to-list 'consult-buffer-sources 'org-source 'append) + + For more details, see the documentation of ‘consult-buffer’ and of +the internal ‘consult--multi’ API. The ‘consult--multi’ function can be +used to create new multi-source commands, but is part of the internal +API as of now, since some details may still change. + + +File: consult.info, Node: Embark integration, Prev: Multiple sources, Up: Special features + +2.5 Embark integration +====================== + +*NOTE*: Install the ‘embark-consult’ package from MELPA, which provides +Consult-specific Embark actions and the Occur buffer export. + + Embark is a versatile package which offers context dependent actions, +comparable to a context menu. See the Embark manual +(https://github.com/oantolin/embark) for an extensive description of its +capabilities. + + Actions are commands which can operate on the currently selected +candidate (or target in Embark terminology). When completing files, for +example the ‘delete-file’ command is offered. With Embark you can +execute arbitrary commands on the currently selected candidate via +‘M-x’. + + Furthermore Embark provides the ‘embark-collect’ command, which +collects candidates and presents them in an Embark collect buffer, where +further actions can be applied to them. A related feature is the +‘embark-export’ command, which exports candidate lists to a buffer of a +special type. For example in the case of file completion, a Dired +buffer is opened. + + In the context of Consult, particularly exciting is the possibility +to export the matching lines from ‘consult-line’, ‘consult-outline’, +‘consult-mark’ and ‘consult-global-mark’. The matching lines are +exported to an Occur buffer where 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, if the wgrep (https://github.com/mhayashi1120/Emacs-wgrep) +package is installed. These three workflows are symmetric. + + • ‘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. + • ‘consult-find’ -> ‘embark-export’ to ‘dired-mode’ buffer -> + ‘wdired-change-to-wdired-mode’ for editing. + + +File: consult.info, Node: Configuration, Next: Recommended packages, Prev: Special features, Up: Top + +3 Configuration +*************** + +Consult can be installed from ELPA +(http://elpa.gnu.org/packages/consult.html) or MELPA +(https://melpa.org/#/consult) via the Emacs built-in package manager. +Alternatively it can be directly installed from the development +repository via other non-standard package managers. + + There is the Consult wiki (https://github.com/minad/consult/wiki), +where additional configuration examples can be contributed. + + *IMPORTANT:* It is strongly recommended that you enable lexical +binding +(https://www.gnu.org/software/emacs/manual/html_node/elisp/Lexical-Binding.html) +in your configuration. Consult relies on lambdas and lexical closures. +For this reason many Consult-related snippets require lexical binding. + +* Menu: + +* Use-package example:: Configuration example based on use-package +* Custom variables:: Short description of all customization settings +* Fine-tuning:: Fine-grained configuration for special requirements + + +File: consult.info, Node: Use-package example, Next: Custom variables, Up: Configuration + +3.1 Use-package example +======================= + +The Consult package only provides commands and does not add any +keybindings or modes. Therefore the package is non-intrusive but +requires a little setup 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. The configuration +shown here relies on the ‘use-package’ macro, which is a convenient tool +to manage package configurations. + + *NOTE:* There is the Consult wiki +(https://github.com/minad/consult/wiki), where you can contribute +additional configuration examples. + + ;; Example configuration for Consult + (use-package consult + ;; Replace bindings. Lazily loaded due by `use-package'. + :bind (;; C-c bindings (mode-specific-map) + ("C-c h" . consult-history) + ("C-c m" . consult-mode-command) + ("C-c k" . consult-kmacro) + ;; 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 + ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window + ("C-x 5 b" . consult-buffer-other-frame) ;; orig. switch-to-buffer-other-frame + ("C-x r b" . consult-bookmark) ;; orig. bookmark-jump + ("C-x p b" . consult-project-buffer) ;; orig. project-switch-to-buffer + ;; Custom M-# bindings for fast register access + ("M-#" . consult-register-load) + ("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated) + ("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 + ("M-g g" . consult-goto-line) ;; orig. goto-line + ("M-g M-g" . consult-goto-line) ;; orig. goto-line + ("M-g o" . consult-outline) ;; Alternative: consult-org-heading + ("M-g m" . consult-mark) + ("M-g k" . consult-global-mark) + ("M-g i" . consult-imenu) + ("M-g I" . consult-imenu-multi) + ;; M-s bindings (search-map) + ("M-s d" . consult-find) + ("M-s D" . consult-locate) + ("M-s g" . consult-grep) + ("M-s G" . consult-git-grep) + ("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 + ("M-s e" . consult-isearch-history) + :map isearch-mode-map + ("M-e" . consult-isearch-history) ;; orig. isearch-edit-string + ("M-s e" . consult-isearch-history) ;; orig. isearch-edit-string + ("M-s l" . consult-line) ;; needed by consult-line to detect isearch + ("M-s L" . consult-line-multi) ;; needed by consult-line to detect isearch + ;; Minibuffer history + :map minibuffer-local-map + ("M-s" . consult-history) ;; orig. next-matching-history-element + ("M-r" . consult-history)) ;; orig. previous-matching-history-element + + ;; Enable automatic preview at point in the *Completions* buffer. This is + ;; relevant when you use the default completion UI. + :hook (completion-list-mode . consult-preview-at-point-mode) + + ;; The :init configuration is always executed (Not lazy) + :init + + ;; Optionally configure the register formatting. This improves the register + ;; preview for `consult-register', `consult-register-load', + ;; `consult-register-store' and the Emacs built-ins. + (setq register-preview-delay 0.5 + register-preview-function #'consult-register-format) + + ;; Optionally tweak the register preview window. + ;; This adds thin lines, sorting and hides the mode line of the window. + (advice-add #'register-preview :override #'consult-register-window) + + ;; Use Consult to select xref locations with preview + (setq xref-show-xrefs-function #'consult-xref + xref-show-definitions-function #'consult-xref) + + ;; Configure other variables and modes in the :config section, + ;; after lazily loading the package. + :config + + ;; 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>"))) + ;; 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-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-.")) + + ;; Optionally configure the narrowing key. + ;; Both < and C-+ work reasonably well. + (setq consult-narrow-key "<") ;; (kbd "C-+") + + ;; Optionally make narrowing help available in the minibuffer. + ;; You may want to use `embark-prefix-help-command' or which-key instead. + ;; (define-key consult-narrow-map (vconcat consult-narrow-key "?") #'consult-narrow-help) + + ;; 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) + ;; (setq consult-project-function (lambda (_) (vc-root-dir))) + ;;;; 4. locate-dominating-file + ;; (setq consult-project-function (lambda (_) (locate-dominating-file "." ".git"))) + ) + + +File: consult.info, Node: Custom variables, Next: Fine-tuning, Prev: Use-package example, Up: Configuration + +3.2 Custom variables +==================== + +*TIP:* If you have Marginalia (https://github.com/minad/marginalia) +installed, type ‘M-x customize-variable RET ^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. + +Variable Description +------------------------------------------------------------------------------------------- +consult-after-jump-hook Functions to call after jumping to a location +consult-async-input-debounce Input debounce for asynchronous commands +consult-async-input-throttle Input throttle for asynchronous commands +consult-async-min-input Minimum numbers of letters needed for async process +consult-async-refresh-delay Refresh delay for asynchronous commands +consult-async-split-style Splitting style used for async commands +consult-async-split-styles-alist Available splitting styles used for async commands +consult-bookmark-narrow Narrowing configuration for ‘consult-bookmark’ +consult-buffer-filter Filter for ‘consult-buffer’ +consult-buffer-sources List of virtual buffer sources +consult-find-args Command line arguments for find +consult-fontify-max-size Buffers larger than this limit are not fontified +consult-fontify-preserve Preserve fontification for line-based commands. +consult-git-grep-args Command line arguments for git-grep +consult-goto-line-numbers Show line numbers for ‘consult-goto-line’ +consult-grep-max-columns Maximal number of columns of the matching lines +consult-grep-args Command line arguments for grep +consult-imenu-config Mode-specific configuration for ‘consult-imenu’ +consult-line-numbers-widen Show absolute line numbers when narrowing is active. +consult-line-point-placement Placement of the point used by ‘consult-line’ +consult-line-start-from-top Start the ‘consult-line’ search from the top +consult-locate-args Command line arguments for locate +consult-man-args Command line arguments for man +consult-mode-command-filter Filter for ‘consult-mode-command’ +consult-mode-histories Mode-specific history variables +consult-narrow-key Narrowing prefix key during completion +consult-preview-key Keys which triggers preview +consult-preview-allowed-hooks List of ‘find-file’ hooks to enable during preview +consult-preview-excluded-files Regexps matched against file names during preview +consult-preview-max-count Maximum number of files to keep open during preview +consult-preview-max-size Files larger than this size are not previewed +consult-preview-raw-size Files larger than this size are previewed in raw form +consult-preview-variables Alist of variables to bind during preview +consult-project-buffer-sources List of virtual project buffer sources +consult-project-function Function which returns current project root +consult-register-prefix Prefix string for register keys during completion +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 + + +File: consult.info, Node: Fine-tuning, Prev: Custom variables, Up: Configuration + +3.3 Fine-tuning of individual commands +====================================== + +*NOTE:* Consult supports fine-grained customization of individual +commands. This configuration feature exists for experienced users with +special requirements. There is the Consult wiki +(https://github.com/minad/consult/wiki), where we collect further +configuration examples. + + Commands and buffer sources allow flexible, individual customization +by using the ‘consult-customize’ macro. You can override any option +passed to the internal ‘consult--read’ API. The Consult wiki +(https://github.com/minad/consult/wiki) already contains a numerous +useful configuration examples. Note that since ‘consult--read’ is part +of the internal API, options could be removed, replaced or renamed in +future versions of the package. + + Useful options are: + • ‘:prompt’ set the prompt string + • ‘:preview-key’ set the preview key, default is + ‘consult-preview-key’ + • ‘:initial’ set the initial input + • ‘:default’ set the default value + • ‘:history’ set the history variable symbol + • ‘:add-history’ add items to the future history, for example symbol + at point + • ‘:sort’ enable or disable sorting + • ‘:group’ set to nil to disable candidate grouping and titles. + • ‘:inherit-input-method’ set to non-nil to inherit the input method. + + (consult-customize + ;; 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-.") + ;; 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>"))) + + The configuration values are evaluated at runtime, just before the +completion session is started. Therefore you can use for example +‘thing-at-point’ to adjust the initial input or the future history. + + (consult-customize + consult-line + :add-history (seq-some #'thing-at-point '(region symbol))) + + (defalias 'consult-line-thing-at-point 'consult-line) + + (consult-customize + consult-line-thing-at-point + :initial (thing-at-point 'symbol)) + + Generally it is possible to modify commands for your individual needs +by the following techniques: + + 1. Use ‘consult-customize’ in order to change the command or source + settings. + 2. Create your own wrapper function which passes modified arguments to + the Consult functions. + 3. Create your own buffer *note multi sources: Multiple sources. for + ‘consult-buffer’. + 4. Create advices to modify some internal behavior. + 5. Write or propose a patch. + + +File: consult.info, Node: Recommended packages, Next: Bug reports, Prev: Configuration, Up: Top + +4 Recommended packages +********************** + +I use and recommend this combination of packages: + + • consult: This package + • vertico (https://github.com/minad/vertico): Fast and minimal + vertical completion system + • marginalia (https://github.com/minad/marginalia): Annotations for + the completion candidates + • embark and embark-consult (https://github.com/oantolin/embark): + Action commands, which can act on the completion candidates + • orderless (https://github.com/oantolin/orderless): Completion style + which offers flexible candidate filtering + + 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! + + • The builtin completion UI, which pops up the ‘*Completions*’ + buffer. + • The builtin ‘icomplete-vertical-mode’ in Emacs 28. + • selectrum by Radon Rosborough + (https://github.com/radian-software/selectrum): Alternative + vertical UI, predecessor of Vertico. + • mct by Protesilaos Stavrou (https://git.sr.ht/~protesilaos/mct): + Minibuffer and Completions in Tandem, which builds on the default + completion UI (development discontinued + (https://protesilaos.com/codelog/2022-04-14-emacs-discontinue-mct/)). + + You can integrated 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. + + • consult-ag (https://github.com/yadex205/consult-ag): Support for + the Silver Searcher (https://github.com/ggreer/the_silver_searcher) + in the style of ‘consult-grep’. + • consult-company (https://github.com/mohkale/consult-company): + Completion at point using the Company + (https://github.com/company-mode/company-mode) backends. + • consult-dir (https://github.com/karthink/consult-dir): Directory + jumper using Consult multi sources. + • consult-dash (https://codeberg.org/ravi/consult-dash): Consult + interface to Dash documentation + (https://github.com/dash-docs-el/dash-docs) + • consult-eglot (https://github.com/mohkale/consult-eglot): + Integration with Eglot (LSP client). + • consult-flycheck (https://github.com/minad/consult-flycheck): + Additional Flycheck integration. + • consult-flyspell (https://gitlab.com/OlMon/consult-flyspell): + Additional Flyspell integration. + • consult-ls-git (https://github.com/rcj/consult-ls-git): List files + from git via Consult. + • consult-lsp (https://github.com/gagbo/consult-lsp): Integration + with Lsp-mode (LSP client). + • consult-notmuch (https://codeberg.org/jao/consult-notmuch): Access + the Notmuch (https://notmuchmail.org/) email system using Consult. + • consult-notes (https://github.com/mclear-tools/consult-notes): + Searching notes with Consult. + • consult-org-roam (https://github.com/jgru/consult-org-roam): + Integration with Org-roam (https://github.com/org-roam/org-roam). + • consult-project-extra + (https://github.com/Qkessler/consult-project-extra/): Additional + project.el extras and buffer sources. + • consult-projectile (https://gitlab.com/OlMon/consult-projectile/): + Additional Projectile (https://github.com/bbatsov/projectile) + integration and buffer sources. + • consult-recoll (https://codeberg.org/jao/consult-recoll): Access + the Recoll (https://www.lesbonscomptes.com/recoll/) desktop + full-text search using Consult. + • consult-spotify (https://codeberg.org/jao/espotify): Access the + Spotify API and control your local music player. + • consult-yasnippet (https://github.com/mohkale/consult-yasnippet): + Integration with Yasnippet. + • affe (https://github.com/minad/affe): Asynchronous Fuzzy Finder for + Emacs based on Consult. + + Not directly related to Consult, but maybe still of interest are the +following packages. These packages should work well with Consult, +follow a similar spirit or offer functionality based on +‘completing-read’. + + • corfu (https://github.com/minad/corfu): Completion systems for + ‘completion-at-point’ using small popups (Alternative to Company + (https://github.com/company-mode/company-mode)). + • cape (https://github.com/minad/cape): Completion At Point + Extensions, which can be used with ‘consult-completion-in-region’ + and Corfu (https://github.com/minad/corfu). + • bookmark-view (https://github.com/minad/bookmark-view): Store + window configuration as bookmarks, possible integration with + ‘consult-buffer’. + • citar (https://github.com/bdarcus/citar): Versatile package for + citation insertion and bibliography management. + • devdocs (https://github.com/astoff/devdocs.el): Emacs viewer for + DevDocs (https://devdocs.io/) with a convenient completion + interface. + • flyspell-correct (https://github.com/d12frosted/flyspell-correct): + Apply spelling corrections by selecting via ‘completing-read’. + • wgrep (https://github.com/mhayashi1120/Emacs-wgrep): Editing of + grep buffers, use together with ‘consult-grep’ via ‘embark-export’. + • all-the-icons-completion + (https://github.com/iyefrat/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. + + +File: consult.info, Node: Bug reports, Next: Contributions, Prev: Recommended packages, Up: Top + +5 Bug reports +************* + +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 + ‘vertico-mode’, ‘mct-mode’, ‘selectrum-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 ‘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’ 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 in the minimal + configuration snippet. + + Minimal setup with Vertico for ‘emacs -Q’: + (package-initialize) + (require 'consult) + (require 'vertico) + (vertico-mode) + (setq completion-styles '(substring basic)) + + Minimal setup with the default completion system for ‘emacs -Q’: + (package-initialize) + (require 'consult) + (setq completion-styles '(substring basic)) + + Please provide the necessary important information with your bug +report: + + • The minimal configuration snippet used to reproduce the issue. + • Your completion UI (Default completion, Vertico, Mct, Selectrum or + Icomplete). + • A stack trace in case the bug triggers an exception. + • Your Emacs version, since bugs may be fixed or introduced in newer + versions. + • Your operating system, since Emacs behavior varies between Linux, + Mac and Windows. + • The package manager, e.g., straight.el or package.el, used to + install the Emacs packages, in order to exclude update issues. Did + you install Consult as part of the Doom or Spacemacs Emacs + distributions? + • Do you use Evil or other packages which apply deep changes? + Consult does not provide Evil integration out of the box, but there + is some support in evil-collection + (https://github.com/emacs-evil/evil-collection). + + When evaluating Consult-related code snippets you should enable +lexical binding +(https://www.gnu.org/software/emacs/manual/html_node/elisp/Lexical-Binding.html). +Consult often relies on lambdas and lexical closures. + + +File: consult.info, Node: Contributions, Next: Acknowledgments, Prev: Bug reports, Up: Top + +6 Contributions +*************** + +Consult is a community effort, please participate in the discussions. +Contributions are welcome, but you may want to discuss potential +contributions first. Since this package is part of GNU ELPA +(http://elpa.gnu.org/packages/consult.html) contributions require a +copyright assignment to the FSF. + + If you have a proposal, take a look at the Consult issue tracker +(https://github.com/consult/issues) and the Consult wishlist +(https://github.com/minad/consult/issues/6). There have been many prior +feature discussions. Please search through the issue tracker, maybe +your issue or feature request has already been discussed. You can +contribute to the Consult wiki (https://github.com/minad/consult/wiki), +in case you want to share small configuration or command snippets. + + +File: consult.info, Node: Acknowledgments, Next: Indices, Prev: Contributions, Up: Top + +7 Acknowledgments +***************** + +This package took inspiration from Counsel +(https://github.com/abo-abo/swiper#counsel) by Oleh Krehel. Some of the +Consult commands originated in the Counsel package or the Selectrum wiki +(https://github.com/radian-software/selectrum/wiki/Useful-Commands). +The commands have been rewritten and greatly enhanced in comparison to +the original versions. + + Code contributions: + • Omar Antolín Camarena (https://github.com/oantolin/) + • Sergey Kostyaev (https://github.com/s-kostyaev/) + • okamsn (https://github.com/okamsn/) + • Clemens Radermacher (https://github.com/clemera/) + • Tom Fitzhenry (https://github.com/tomfitzhenry/) + • jakanakaevangeli (https://github.com/jakanakaevangeli) + • Iñigo Serna (https://hg.serna.eu) + • Adam Spiers (https://github.com/aspiers/) + • Omar Polo (https://github.com/omar-polo) + • Augusto Stoffel (https://github.com/astoff) + • Fox Kiester (https://github.com/noctuid) + • Tecosaur (https://github.com/tecosaur) + • Mohamed Abdelnour (https://github.com/mohamed-abdelnour) + • Sylvain Rousseau (https://github.com/thisirs) + • J.D. Smith (https://github.com/jdtsmith) + • Mohsin Kaleem (https://github.com/mohkale) + + Advice and useful discussions: + • Clemens Radermacher (https://github.com/clemera/) + • Omar Antolín Camarena (https://github.com/oantolin/) + • Protesilaos Stavrou (https://protesilaos.com) + • Steve Purcell (https://github.com/purcell/) + • Adam Porter (https://github.com/alphapapa/) + • Manuel Uberti (https://github.com/manuel-uberti/) + • Tom Fitzhenry (https://github.com/tomfitzhenry/) + • Howard Melman (https://github.com/hmelman/) + • Stefan Monnier (https://github.com/monnier/) + • Dmitry Gutov (https://github.com/dgutov/) + • Itai Y. Efrat (https://github.com/iyefrat) + • Bruce d’Arcus (https://github.com/bdarcus) + • J.D. Smith (https://github.com/jdtsmith) + • Enrique Kessler Martínez (https://github.com/Qkessler) + + Authors of supplementary ‘consult-*’ packages: + + • Jose A Ortega Ruiz (https://codeberg.org/jao/) (consult-notmuch + (https://codeberg.org/jao/consult-notmuch), consult-recoll + (https://codeberg.org/jao/consult-recoll), consult-spotify + (https://codeberg.org/jao/espotify)) + • Gerry Agbobada (https://github.com/gagbo/) (consult-lsp + (https://github.com/gagbo/consult-lsp)) + • Karthik Chikmagalur (https://github.com/karthink) (consult-dir + (https://github.com/karthink/consult-dir)) + • Mohsin Kaleem (https://github.com/mohkale) (consult-company + (https://github.com/mohkale/consult-company), consult-eglot + (https://github.com/mohkale/consult-eglot), consult-yasnippet + (https://github.com/mohkale/consult-yasnippet)) + • Marco Pawłowski (https://gitlab.com/OlMon) (consult-flyspell + (https://gitlab.com/OlMon/consult-flyspell), consult-projectile + (https://gitlab.com/OlMon/consult-projectile)) + • Enrique Kessler Martínez (https://github.com/Qkessler) + (consult-project-extra + (https://github.com/Qkessler/consult-project-extra)) + • Jan Gru (https://github.com/jgru) (consult-org-roam + (https://github.com/jgru/consult-org-roam)) + • Kanon Kakuno (https://github.com/yadex205) (consult-ag + (https://github.com/yadex205/consult-ag)) + • Robin Joy (https://github.com/rcj) (consult-ls-git + (https://github.com/rcj/consult-ls-git)) + • Ravi R Kiran (https://codeberg.org/ravi) (consult-dash + (https://codeberg.org/ravi/consult-dash)) + • Colin McLear (https://github.com/mclearc) (consult-notes + (https://github.com/mclear-tools/consult-notes)) + + +File: consult.info, Node: Indices, Prev: Acknowledgments, Up: Top + +8 Indices +********* + +* Menu: + +* Function index:: List of all Consult commands +* Concept index:: List of all Consult-specific concepts + + +File: consult.info, Node: Function index, Next: Concept index, Up: Indices + +8.1 Function index +================== + + +* Menu: + +* consult-apropos: Miscellaneous. (line 6) +* consult-bookmark: Virtual Buffers. (line 6) +* consult-buffer: Virtual Buffers. (line 6) +* consult-buffer-other-frame: Virtual Buffers. (line 6) +* consult-buffer-other-window: Virtual Buffers. (line 6) +* consult-compile-error: Compilation. (line 6) +* consult-completion-in-region: Miscellaneous. (line 6) +* consult-complex-command: Histories. (line 6) +* consult-file-externally: Miscellaneous. (line 6) +* consult-find: Grep and Find. (line 6) +* consult-flymake: Compilation. (line 6) +* consult-focus-lines: Search. (line 6) +* consult-git-grep: Grep and Find. (line 6) +* consult-global-mark: Navigation. (line 6) +* consult-goto-line: Navigation. (line 6) +* consult-grep: Grep and Find. (line 6) +* consult-history: Histories. (line 6) +* consult-imenu: Navigation. (line 6) +* consult-imenu-multi: Navigation. (line 6) +* consult-isearch-history: Histories. (line 6) +* consult-keep-lines: Search. (line 6) +* consult-kmacro: Editing. (line 6) +* consult-line: Search. (line 6) +* consult-line-multi: Search. (line 6) +* consult-locate: Grep and Find. (line 6) +* consult-man: Miscellaneous. (line 6) +* consult-mark: Navigation. (line 6) +* consult-minor-mode-menu: Modes. (line 6) +* consult-mode-command: Modes. (line 6) +* consult-multi-occur: Search. (line 6) +* consult-org-agenda: Org Mode. (line 6) +* consult-org-heading: Org Mode. (line 6) +* consult-outline: Navigation. (line 6) +* consult-preview-at-point: Miscellaneous. (line 6) +* consult-preview-at-point-mode: Miscellaneous. (line 6) +* consult-project-buffer: Virtual Buffers. (line 6) +* consult-recent-file: Virtual Buffers. (line 6) +* consult-register: Register. (line 6) +* consult-register-format: Register. (line 6) +* consult-register-load: Register. (line 6) +* consult-register-store: Register. (line 6) +* consult-register-window: Register. (line 6) +* consult-ripgrep: Grep and Find. (line 6) +* consult-theme: Miscellaneous. (line 6) +* consult-xref: Compilation. (line 6) +* consult-yank-from-kill-ring: Editing. (line 6) +* consult-yank-pop: Editing. (line 6) +* consult-yank-replace: Editing. (line 6) + + +File: consult.info, Node: Concept index, Prev: Function index, Up: Indices + +8.2 Concept index +================= + + +* Menu: + +* asynchronous search: Asynchronous search. (line 6) +* commands: Available commands. (line 6) +* compilation errors: Compilation. (line 6) +* customization: Custom variables. (line 6) +* editing: Editing. (line 6) +* embark: Embark integration. (line 6) +* find: Grep and Find. (line 6) +* grep: Grep and Find. (line 6) +* history: Histories. (line 6) +* locate: Grep and Find. (line 6) +* major mode: Modes. (line 6) +* minor mode: Modes. (line 6) +* multiple sources: Multiple sources. (line 6) +* narrowing: Narrowing and grouping. + (line 6) +* navigation: Navigation. (line 6) +* preview: Live previews. (line 6) +* register: Register. (line 6) +* search: Search. (line 6) +* use-package: Use-package example. (line 6) +* virtual buffers: Virtual Buffers. (line 6) + + + +Tag Table: +Node: Top219 +Node: Available commands5203 +Node: Virtual Buffers6722 +Node: Editing8378 +Node: Register9232 +Node: Navigation10942 +Node: Search12023 +Node: Grep and Find13914 +Node: Compilation15910 +Node: Histories16584 +Node: Modes17802 +Node: Org Mode18280 +Node: Miscellaneous18795 +Node: Special features21586 +Node: Live previews22713 +Node: Narrowing and grouping26138 +Node: Asynchronous search28139 +Node: Multiple sources31219 +Node: Embark integration36929 +Node: Configuration39122 +Node: Use-package example40221 +Node: Custom variables47258 +Node: Fine-tuning50944 +Node: Recommended packages53985 +Node: Bug reports59992 +Node: Contributions62769 +Node: Acknowledgments63676 +Node: Indices67469 +Node: Function index67705 +Node: Concept index71351 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/elpa/consult-0.19/dir b/elpa/consult-0.19/dir @@ -0,0 +1,18 @@ +This is the file .../info/dir, which contains the +topmost node of the Info hierarchy, called (dir)Top. +The first time you invoke Info you start off looking at this node. + +File: dir, Node: Top This is the top of the INFO tree + + This (the Directory node) gives a menu of major topics. + Typing "q" exits, "H" lists all Info commands, "d" returns here, + "h" gives a primer for first-timers, + "mEmacs<Return>" visits the Emacs manual, etc. + + In Emacs, you can click mouse button 2 on a menu item or cross reference + to select it. + +* Menu: + +Emacs misc features +* Consult: (consult). Useful commands built on completing-read. diff --git a/init.el b/init.el @@ -217,9 +217,6 @@ ;; Aggressive Intent mode causes 100% CPU for me whenever the sly repl prints warnings (add-hook 'sly-mrepl-mode-hook (lambda () (aggressive-indent-mode -1))) -(advice-add #'completing-read-multiple - :override #'consult-completing-read-multiple) - ;; notmuch's tag selection doesnt work with consult-completing-read-multiple ;; items need to be trimmed (defun lh/notmuch-read-tag-changes-trim (tags)