commit 7914e559781ac60fc55238ec0cbd8f849266a99c
parent afcb9be9fd07d206b2f5774bb6afab64466e01a8
Author: Lukas Henkel <lh@entf.net>
Date: Tue, 1 Feb 2022 20:43:20 +0100
Delete older packages
Diffstat:
98 files changed, 5339 insertions(+), 24697 deletions(-)
diff --git a/elpa/consult-0.13/consult-autoloads.el b/elpa/consult-0.13/consult-autoloads.el
@@ -1,489 +0,0 @@
-;;; consult-autoloads.el --- automatically extracted autoloads
-;;
-;;; 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. Furthermore 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-root-function' is used. See `consult-buffer-sources' and
-`consult--multi' for the configuration of the virtual buffer sources." 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 for regexp with grep in DIR with INITIAL input.
-
-The input string is split, the first part of the string 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 --.
-
-Example: #async-regexp -- grep-opts#filter-string
-
-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-root-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 for regexp with grep in DIR with INITIAL input.
-
-See `consult-grep' for more details.
-
-\(fn &optional DIR INITIAL)" t nil)
-
-(autoload 'consult-ripgrep "consult" "\
-Search for regexp with rg in DIR with INITIAL input.
-
-See `consult-grep' for more details.
-
-\(fn &optional DIR INITIAL)" t nil)
-
-(autoload 'consult-find "consult" "\
-Search for regexp with find in DIR with 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 for regexp with locate with INITIAL input.
-
-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 regexp with man with INITIAL input.
-
-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)
-
-(if (fboundp 'register-definition-prefixes) (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)
-
-(if (fboundp 'register-definition-prefixes) (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)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "consult-flymake" '("consult-flymake--")))
-
-;;;***
-
-;;;### (autoloads nil "consult-icomplete" "consult-icomplete.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from consult-icomplete.el
-
-(if (fboundp 'register-definition-prefixes) (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-root-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)
-
-(if (fboundp 'register-definition-prefixes) (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)
-
-(if (fboundp 'register-definition-prefixes) (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'.
-
-\(fn REG)" 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/add the
-number. Otherwise store point, frameset, window or kmacro.
-
-\(fn ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "consult-register" '("consult-register-")))
-
-;;;***
-
-;;;### (autoloads nil "consult-selectrum" "consult-selectrum.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from consult-selectrum.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "consult-selectrum" '("consult-selectrum--")))
-
-;;;***
-
-;;;### (autoloads nil "consult-vertico" "consult-vertico.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from consult-vertico.el
-
-(if (fboundp 'register-definition-prefixes) (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)
-
-(if (fboundp 'register-definition-prefixes) (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.13/consult-compile.el b/elpa/consult-0.13/consult-compile.el
@@ -1,122 +0,0 @@
-;;; consult-compile.el --- Provides the command `consult-compile-error' -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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-compile--marker (point-marker)
- 'consult-compile--loc (compilation--message->loc msg))
- candidates))))
- (nreverse candidates))))
-
-(defun consult-compile--error-lookup (_ candidates cand)
- "Lookup marker of CAND by accessing CANDIDATES list."
- (when-let ((cand (car (member cand candidates)))
- (marker (get-text-property 0 'consult-compile--marker cand))
- (loc (get-text-property 0 'consult-compile--loc cand))
- (buffer (marker-buffer marker))
- (default-directory (buffer-local-value 'default-directory buffer)))
- (consult--position-marker
- ;; taken from compile.el
- (apply #'compilation-find-file
- marker
- (caar (compilation--loc->file-struct loc))
- (cadar (compilation--loc->file-struct loc))
- (compilation--file-struct->formats
- (compilation--loc->file-struct loc)))
- (compilation--loc->line loc)
- (compilation--loc->col loc))))
-
-(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))))))
-
-;;;###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-compile--error-lookup
- :group (consult--type-group consult-compile--narrow)
- :narrow (consult--type-narrow consult-compile--narrow)
- :history '(:input consult-compile--history)
- :state (consult--jump-state 'consult-preview-error)))
-
-(provide 'consult-compile)
-;;; consult-compile.el ends here
diff --git a/elpa/consult-0.13/consult-compile.elc b/elpa/consult-0.13/consult-compile.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult-flymake.el b/elpa/consult-0.13/consult-flymake.el
@@ -1,100 +0,0 @@
-;;; consult-flymake.el --- Provides the command `consult-flymake' -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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.13/consult-flymake.elc b/elpa/consult-0.13/consult-flymake.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult-icomplete.el b/elpa/consult-0.13/consult-icomplete.el
@@ -1,55 +0,0 @@
-;;; consult-icomplete.el --- Icomplete integration for Consult -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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 Icomplete completion system. This package
-;; is automatically loaded by Consult.
-
-;;; Code:
-
-(require 'consult)
-(require 'icomplete)
-
-(defun consult-icomplete--refresh (&optional reset)
- "Refresh icomplete view, keep current candidate unless RESET is non-nil."
- (when icomplete-mode
- (let ((top (car completion-all-sorted-completions)))
- (completion--flush-all-sorted-completions)
- ;; force flushing, otherwise narrowing is broken!
- (setq completion-all-sorted-completions nil)
- (when (and top (not reset))
- (let* ((completions (completion-all-sorted-completions))
- (last (last completions))
- (before)) ;; completions before top
- ;; warning: completions is an improper list
- (while (consp completions)
- (if (equal (car completions) top)
- (progn
- (setcdr last (append (nreverse before) (cdr last)))
- (setq completion-all-sorted-completions completions
- completions nil))
- (push (car completions) before)
- (setq completions (cdr completions)))))))
- (icomplete-exhibit)))
-
-(add-hook 'consult--completion-refresh-hook #'consult-icomplete--refresh)
-
-(provide 'consult-icomplete)
-;;; consult-icomplete.el ends here
diff --git a/elpa/consult-0.13/consult-icomplete.elc b/elpa/consult-0.13/consult-icomplete.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult-imenu.el b/elpa/consult-0.13/consult-imenu.el
@@ -1,232 +0,0 @@
-;;; consult-imenu.el --- Consult commands for imenu -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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 (cand restore)
- ;; Only preview simple menu items which are markers,
- ;; in order to avoid any bad side effects.
- (funcall preview (and (markerp (cdr cand)) (cdr cand)) restore)))
- :require-match t
- :group
- (when narrow
- (lambda (cand transform)
- (when-let (type (get-text-property 0 'consult--type cand))
- (if transform
- (substring cand (1+ (next-single-property-change 0 'consult--type cand)))
- (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-root-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.13/consult-imenu.elc b/elpa/consult-0.13/consult-imenu.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult-org.el b/elpa/consult-0.13/consult-org.el
@@ -1,124 +0,0 @@
-;;; consult-org.el --- Consult commands for org-mode -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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)))))
- (put-text-property 0 1 'consult-org--heading (list (point-marker) 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
- (car (get-text-property 0 'consult-org--heading cand))))))
- (if transform (substring cand (1+ (length name))) name))))
- :lookup
- (lambda (_ candidates cand)
- (when-let (found (member cand candidates))
- (car (get-text-property 0 'consult-org--heading (car found))))))))
-
-;;;###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.13/consult-org.elc b/elpa/consult-0.13/consult-org.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult-pkg.el b/elpa/consult-0.13/consult-pkg.el
@@ -1,10 +0,0 @@
-(define-package "consult" "0.13" "Consulting completing-read"
- '((emacs "26.1"))
- :commit "c2fed383c9c555ed017200a22efad0a9734725b0" :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.13/consult-register.el b/elpa/consult-0.13/consult-register.el
@@ -1,266 +0,0 @@
-;;; consult-register.el --- Consult commands for registers -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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-narrow
- `((?n "Number" ,#'numberp)
- (?s "String" ,#'stringp)
- (?p "Point" ,#'markerp)
- (?r "Rectangle" ,(lambda (x) (stringp (car-safe x))))
- ;; frameset-register-p and kmacro-register-p exists since 27.1
- (?t "Frameset" ,(lambda (x) (eq (type-of x) 'frameset-register)))
- (?k "Kmacro" ,(lambda (x) (eq (type-of x) 'kmacro-register)))
- (?f "File" ,(lambda (x) (memq (car-safe x) '(file file-query))))
- (?w "Window" ,(lambda (x) (window-configuration-p (car-safe x)))))
- "Register narrowing configuration.
-
-Each element of the list must have the form '(char name predicate)."
- :type '(repeat (list character string function))
- :group 'consult)
-
-;;;###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 (seq-filter #'cdr register-alist))
- (separator
- (and (display-graphic-p)
- (propertize (concat (propertize " " 'display '(space :align-to right)) "\n")
- 'face '(:inherit consult-separator :height 1 :underline t)))))
- (when (or show-empty regs)
- (with-current-buffer-window buffer
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)
- (preserve-size . (nil . t))))
- nil
- (setq-local cursor-in-non-selected-windows nil)
- (setq-local mode-line-format nil)
- (setq-local truncate-lines t)
- (setq-local window-min-height 1)
- (setq-local window-resize-pixelwise t)
- (insert (mapconcat
- (lambda (reg)
- (concat (funcall register-preview-function reg) separator))
- (seq-sort #'car-less-than-car regs) nil))))))
-
-;;;###autoload
-(defun consult-register-format (reg)
- "Enhanced preview of register REG.
-
-This function can be used as `register-preview-function'."
- (concat (consult-register--format reg) "\n"))
-
-(defun consult-register--format (reg)
- "Format register REG for preview."
- (pcase-let ((`(,key . ,val) reg))
- (let* ((key-str (propertize (single-key-description key) 'face 'consult-key))
- (len (max 3 (length key-str))))
- (concat
- key-str
- (make-string (- len (length key-str)) ?\s)
- ;; Special printing for certain register types
- (cond
- ;; Display full string
- ((or (stringp val) (stringp (car-safe val)))
- (when (consp val)
- (setq val (mapconcat #'identity val "\n")))
- (mapconcat #'identity
- (seq-take (split-string (string-trim val) "\n") 3)
- (concat "\n" (make-string len ?\s))))
- ;; Display 'file-query
- ((eq (car-safe val) 'file-query)
- (format "%s at position %d"
- (propertize (abbreviate-file-name (cadr val)) 'face 'consult-file)
- (caddr val)))
- ;; Display 'file
- ((eq (car-safe val) 'file)
- (propertize (abbreviate-file-name (cdr val)) 'face 'consult-file))
- ;; Display full line of buffer
- ((and (markerp val) (marker-buffer val))
- (with-current-buffer (marker-buffer val)
- (save-restriction
- (save-excursion
- (widen)
- (goto-char val)
- (consult--format-location (buffer-name) (line-number-at-pos)
- (consult--line-with-cursor val))))))
- ;; Default printing for the other types
- (t (register-describe-oneline key)))))))
-
-(defun consult-register--alist ()
- "Return register list or raise an error if the list is empty."
- ;; Sometimes, registers are made without a `cdr'.
- ;; Such registers don't do anything, and can be ignored.
- (or (seq-filter #'cdr register-alist) (user-error "All registers are empty")))
-
-(defun consult-register--candidates ()
- "Return list of formatted register candidates."
- (mapcar (lambda (reg)
- (propertize
- (consult-register--format reg)
- 'consult--candidate (car reg)
- 'consult--type
- (car (seq-find (lambda (x) (funcall (caddr x) (cdr reg)))
- consult-register-narrow))))
- (sort (consult-register--alist) #'car-less-than-car)))
-
-;;;###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")
- (let ((narrow (mapcar (lambda (x) (cons (car x) (cadr x)))
- consult-register-narrow)))
- (consult-register-load
- (consult--read
- (consult-register--candidates)
- :prompt "Register: "
- :category 'consult-register
- :state
- (let ((preview (consult--jump-preview)))
- (lambda (cand restore)
- ;; Preview only markers
- (funcall preview
- (when-let (reg (get-register cand))
- (and (markerp reg) reg))
- restore)))
- :group (consult--type-group narrow)
- :narrow (consult--type-narrow 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 nil
- (jump-to-register reg arg)
- (user-error (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)))
- (reg)
- (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))))
- (unwind-protect
- (while (not reg)
- (while (memq (read-key (propertize (caddr (assq action action-list))
- 'face 'minibuffer-prompt))
- help-chars)
- (funcall preview))
- (cond
- ((or (eq ?\C-g last-input-event)
- (eq 'escape last-input-event)
- (eq ?\C-\[ last-input-event))
- (keyboard-quit))
- ((and (numberp last-input-event) (assq (logxor #x8000000 last-input-event) action-list))
- (setq action (logxor #x8000000 last-input-event)))
- ((characterp last-input-event)
- (setq reg last-input-event))
- (t (error "Non-character input-event"))))
- (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/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.13/consult-register.elc b/elpa/consult-0.13/consult-register.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult-selectrum.el b/elpa/consult-0.13/consult-selectrum.el
@@ -1,104 +0,0 @@
-;;; consult-selectrum.el --- Selectrum integration for Consult -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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, splitting
-the input using SPLIT."
- (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))
- (setq-local 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.13/consult-selectrum.elc b/elpa/consult-0.13/consult-selectrum.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult-vertico.el b/elpa/consult-0.13/consult-vertico.el
@@ -1,54 +0,0 @@
-;;; consult-vertico.el --- Vertico integration for Consult -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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 Vertico completion system. This package
-;; is automatically loaded by Consult.
-
-;;; Code:
-
-(require 'consult)
-
-;; NOTE: It is not guaranteed that Vertico is available during compilation!
-(defvar vertico--input)
-(defvar vertico--history-hash)
-(defvar vertico--lock-candidate)
-(declare-function vertico--exhibit "ext:vertico")
-(declare-function vertico--candidate "ext:vertico")
-
-(defun consult-vertico--candidate ()
- "Return current candidate for Consult preview."
- (and vertico--input (vertico--candidate 'highlight)))
-
-(defun consult-vertico--refresh (&optional reset)
- "Refresh completion UI, keep current candidate unless RESET is non-nil."
- (when vertico--input
- (setq vertico--input t)
- (when reset
- (setq vertico--history-hash nil
- vertico--lock-candidate nil))
- (vertico--exhibit)))
-
-(add-hook 'consult--completion-candidate-hook #'consult-vertico--candidate)
-(add-hook 'consult--completion-refresh-hook #'consult-vertico--refresh)
-(define-key consult-async-map [remap vertico-insert] 'vertico-next-group)
-
-(provide 'consult-vertico)
-;;; consult-vertico.el ends here
diff --git a/elpa/consult-0.13/consult-vertico.elc b/elpa/consult-0.13/consult-vertico.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult-xref.el b/elpa/consult-0.13/consult-xref.el
@@ -1,116 +0,0 @@
-;;; consult-xref.el --- Xref integration for Consult -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 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."
- (mapcar (lambda (xref)
- (let* ((loc (xref-item-location xref))
- (group (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 (cand restore)
- (cond
- (restore
- (funcall preview nil t)
- (funcall open nil))
- (cand
- (let ((loc (xref-item-location cand))
- (consult--buffer-display display))
- (funcall preview
- ;; 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))
- 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
- (alist-get #'consult-xref consult--read-config)
- (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.13/consult-xref.elc b/elpa/consult-0.13/consult-xref.elc
Binary files differ.
diff --git a/elpa/consult-0.13/consult.el b/elpa/consult-0.13/consult.el
@@ -1,4472 +0,0 @@
-;;; consult.el --- Consulting completing-read -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler and Consult contributors
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2020
-;; Version: 0.13
-;; Package-Requires: ((emacs "26.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, Icomplete, Selectrum, Vertico and Embark.
-
-;; 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-root-function nil
- "Function which returns project root 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'.
-This is 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-buffer
- consult--source-file
- consult--source-bookmark
- consult--source-project-buffer
- consult--source-project-file)
- "Sources used by `consult-buffer'.
-
-See `consult--multi' for a description of the source values."
- :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 --regexp"
- "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 102400
- "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-hooks
- '(epa-file-find-file-hook
- recentf-track-opened-file
- vc-refresh-state)
- "List of `find-file' hooks, which should not be executed during file preview.
-In particular we don't want to modify the list of recent files and we
-don't want to see epa password prompts."
- :type '(repeat 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))
- "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 to for line previews.")
-
-(defface consult-preview-match
- '((t :inherit match))
- "Face used to for match previews in `consult-grep'.")
-
-(defface consult-preview-cursor
- '((t :inherit consult-preview-match))
- "Face used to for cursor previews and marks in `consult-mark'.")
-
-(defface consult-preview-error
- '((t :inherit isearch-fail))
- "Face used to for cursor previews and marks in `consult-compile-error'.")
-
-(defface consult-preview-insertion
- '((t :inherit region))
- "Face used to 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--mode-command-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--read-config 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 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 #x100000
- "Special character used to encode line prefixes for disambiguation.
-We use the first character of the private unicode plane b.")
-
-(defconst consult--tofu-range #xFFFE
- "Special character range.
-Size of private unicode plane b.")
-
-(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-set (cmds prop val)
- "Set property PROP to VAL of commands CMDS."
- (dolist (cmd cmds)
- (cond
- ((and (boundp cmd) (consp (symbol-value cmd)))
- (set cmd (plist-put (symbol-value cmd) prop val)))
- ((functionp cmd)
- (setf (alist-get cmd consult--read-config)
- (plist-put (alist-get cmd consult--read-config) prop val)))
- (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-set ',cmds ,(car args) ,(cadr args)) setter)
- (setq args (cddr args)))))
- (macroexp-progn setter)))
-
-;;;; 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)
- "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'."
- (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)
- (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.
- ;; TODO Implement support to disable highlighting as in Vertico deferred highlighting.
- (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)
- (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 prompts."
- (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-1 (prompt dir)
- "Format PROMPT, expand directory DIR and return them as a pair."
- (let ((edir (file-name-as-directory (expand-file-name dir)))
- (ddir (file-name-as-directory (expand-file-name default-directory))))
- (cons
- (if (string= ddir edir)
- (concat prompt ": ")
- (format "%s (%s): " prompt (consult--abbreviate-directory dir)))
- edir)))
-
-(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-root-function' is tried.
-Otherwise the `default-directory' is returned."
- (cond
- ((stringp dir) (consult--directory-prompt-1 prompt dir))
- (dir (consult--directory-prompt-1
- prompt
- ;; 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))))
- ((when-let (root (consult--project-root))
- (cons (format "%s (Project %s): " prompt (consult--project-name root))
- root)))
- (t (consult--directory-prompt-1 prompt default-directory))))
-
-(defun consult--project-root ()
- "Return project root as absolute path."
- (when-let (root (and consult-project-root-function (funcall consult-project-root-function)))
- (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--lookup-member (_ candidates cand)
- "Lookup CAND in CANDIDATES list, return original element."
- (car (member cand candidates)))
-
-(defun consult--lookup-cons (_ candidates cand)
- "Lookup CAND in CANDIDATES alist, return cons."
- (assoc cand candidates))
-
-(defun consult--lookup-cdr (_ candidates cand)
- "Lookup CAND in CANDIDATES alist, return cdr of element."
- (cdr (assoc cand candidates)))
-
-(defun consult--lookup-location (_ candidates cand)
- "Lookup CAND in CANDIDATES list of 'consult-location category, return the marker."
- (when-let (found (member cand candidates))
- (car (get-text-property 0 'consult-location (car found)))))
-
-(defun consult--lookup-candidate (_ candidates cand)
- "Lookup CAND in CANDIDATES list and return property 'consult--candidate."
- (when-let (found (member cand 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-all' and `consult-line-project'.
-If TRANSFORM non-nil, return transformed CAND, otherwise return title."
- (if transform
- cand
- (buffer-name
- (marker-buffer
- (car (get-text-property 0 'consult-location cand))))))
-
-(defun consult--line-prefix (&optional curr-line)
- "Annotate `consult-location' candidates with line numbers given the current line
-CURR-LINE."
- (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."
- (setq cand (concat cand (consult--tofu-encode marker)))
- (add-text-properties 0 1 `(consult-location (,marker . ,line) ,@props) cand)
- cand)
-
-(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
- (progn
- (when fontify
- (consult--fontify-region beg end))
- (buffer-substring beg end))
- (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."
- (consult--region-with-cursor (line-beginning-position) (line-end-position) marker))
-
-;;;; Preview support
-
-(defun consult--kill-clean-buffer (buf)
- "Kill BUF if it has not been modified."
- (unless (buffer-modified-p buf)
- (kill-buffer buf)))
-
-(defun consult--temporary-files ()
- "Return a function to open files temporarily."
- (let* ((new-buffers)
- (dir default-directory))
- (lambda (&optional name)
- (if name
- (let ((default-directory dir))
- (or (get-file-buffer name)
- ;; 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)
- (prog1 nil
- (message "File `%s' (%s) is too large for preview"
- name (file-size-human-readable size)))
- (cl-letf* (((default-value 'find-file-hook)
- (seq-remove (lambda (x) (memq x consult-preview-excluded-hooks))
- (default-value 'find-file-hook)))
- (inhibit-message t)
- (non-essential t)
- (enable-dir-local-variables nil)
- (enable-local-variables (and enable-local-variables :safe))
- (buf (find-file-noselect
- name 'nowarn
- (> size consult-preview-raw-size))))
- (push buf new-buffers)
- ;; Only keep a few buffers alive
- (while (> (length new-buffers) consult-preview-max-count)
- (consult--kill-clean-buffer (car (last new-buffers)))
- (setq new-buffers (nbutlast new-buffers)))
- buf)))))
- (mapc #'consult--kill-clean-buffer new-buffers)))))
-
-(defun consult--invisible-open-permanently ()
- "Open overlays which hide the current line.
-See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'."
- (dolist (ov (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 (overlays-in (line-beginning-position) (line-end-position)) restore)
- (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 nil)
- (lambda () (funcall fun t)))
- (overlay-put ov 'invisible nil)
- (lambda () (overlay-put ov 'invisible inv)))
- restore))))))
-
-(defun consult--jump-nomark (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))
- (run-hooks 'consult-after-jump-hook))))
-
-(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-nomark pos)
- (consult--invisible-open-permanently))
- 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 ((overlays)
- (invisible)
- (face (or face 'consult-preview-cursor))
- (saved-min (point-min-marker))
- (saved-max (point-max-marker))
- (saved-pos (point-marker)))
- (set-marker-insertion-type saved-max t) ;; Grow when text is inserted
- (lambda (cand restore)
- (mapc #'funcall invisible)
- (mapc #'delete-overlay overlays)
- (setq invisible nil overlays nil)
- (cond
- (restore
- (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
- (cand
- (consult--jump-nomark 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)))))
- ;; If position cannot be previewed, return to saved position
- (t (consult--jump-nomark saved-pos))))))
-
-(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 (cand restore)
- (funcall preview cand restore)
- (when (and cand restore)
- (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 (cand restore)
- (funcall preview cand restore)
- (when (and cand restore)
- (,(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--to-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-pressed-p (preview-key cand)
- "Return t if PREVIEW-KEY has been pressed given the current candidate CAND."
- (when (and (consp preview-key) (memq :keys preview-key))
- (setq preview-key (funcall (plist-get preview-key :predicate) cand)))
- (setq preview-key (consult--preview-key-normalize preview-key))
- (let ((keys (this-single-command-keys)))
- (cdr (or (seq-find (lambda (x)
- (and (not (eq (car x) 'any))
- (equal (vconcat (car x)) keys)))
- preview-key)
- (assq 'any preview-key)))))
-
-(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 "") (selected) (timer))
- (consult--minibuffer-with-setup-hook
- (if (and state preview-key)
- (lambda ()
- (setq consult--preview-function
- (let ((last-preview))
- (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 input cand))
- (new-preview (cons input cand)))
- (when-let (debounce (consult--preview-key-pressed-p 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
- (funcall state transformed nil)
- (setq last-preview new-preview)))))))
- (funcall state transformed nil)
- (setq last-preview new-preview))))))))))))
- ;; symbol indirection because of bug#46407
- (let ((post-command-sym (make-symbol "consult--preview-post-command")))
- (fset post-command-sym (lambda ()
- (setq input (minibuffer-contents-no-properties))
- (funcall consult--preview-function)))
- (add-hook 'post-command-hook post-command-sym nil 'local)))
- (lambda ()
- ;; symbol indirection because of bug#46407
- (let ((post-command-sym (make-symbol "consult--preview-post-command")))
- (fset post-command-sym (lambda () (setq input (minibuffer-contents-no-properties))))
- (add-hook 'post-command-hook post-command-sym nil 'local))))
- (unwind-protect
- (cons (setq selected (when-let (result (funcall fun))
- (funcall transform input result)))
- input)
- (when timer
- (cancel-timer timer))
- ;; If there is a state function, always call restore!
- ;; The preview function should be seen as a stateful object,
- ;; and we call the destructor here.
- (when state
- (funcall state selected t))))))
-
-(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 preview function takes two arguments, the selected candidate and a restore
-flag. It is called every time with restore=nil after a preview-key keypress, as
-long as a new candidate is selected. Finally the preview function is called in
-any case with restore=t even if no preview has actually taken place. The
-candidate argument can be nil if the selection has been aborted."
- (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, defaults to twice
-`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))
- (setq-local completion-styles '(consult--split))
- (setq-local completion-category-defaults nil)
- (setq-local 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)) (orig-chunk))
- (consult--minibuffer-with-setup-hook
- (lambda ()
- (when (functionp ,async)
- (setq orig-chunk read-process-output-max
- read-process-output-max (max read-process-output-max consult--process-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 orig-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) (last-args) (indicator) (count))
- (lambda (action)
- (pcase action
- ("" ;; If no input is provided kill current process
- (when proc
- (delete-process proc)
- (setq proc nil))
- (setq last-args nil))
- ((pred stringp)
- (funcall async action)
- (let* ((args (funcall cmd action))
- (stderr-buffer (generate-new-buffer " *consult-async-stderr*"))
- (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 stderr-buffer)
- (insert "<<<<< stderr <<<<<\n")
- (kill-buffer stderr-buffer)))))
- (unless (equal args last-args)
- (setq last-args args)
- (when proc
- (delete-process proc)
- (setq proc 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 (apply #'make-process
- `(,@props
- :connection-type pipe
- :name ,(car args)
- ;;; XXX tramp bug, the stderr buffer must be empty
- :stderr ,stderr-buffer
- :noquery t
- :command ,args
- :filter ,proc-filter
- :sentinel ,proc-sentinel))))))
- nil)
- ('destroy
- (when proc
- (delete-process proc)
- (setq proc 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--to-list (list)
- "Ensure that LIST is a list."
- (if (listp list) list (list 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-preview-map (make-sparse-keymap)
- "Keymap added for commands with preview.")
-
-(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--to-list minibuffer-default)
- ;; then our custom items
- (remove "" (remq nil (consult--to-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)
- (and preview-key consult-preview-map)
- map))
- old-map))))
-
-(defun consult--fry-the-tofus (&rest _)
- "Fry the tofus in the minibuffer."
- (let* ((min (minibuffer-prompt-end))
- (max (point-max))
- (pos max)
- (high (+ consult--tofu-char consult--tofu-range -1)))
- (while (and (> pos min) (<= consult--tofu-char (char-before pos) high))
- (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 unicode characters in the supplementary private use
-;; plane b. By doing that, it is unlikely that accidential matching occurs.
-(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 (input cand)
- (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 the input, candidates and candidate string.
-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
- (alist-get this-command consult--read-config)
- options
- (list :prompt "Select: "
- :preview-key consult-preview-key
- :sort t
- :lookup (lambda (_input _cands x) x)))))
-
-;;;; 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 'consult-multi 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--to-list key)))
- sources))))
-
-(defun consult--multi-lookup (sources _ candidates cand)
- "Lookup CAND in CANDIDATES given SOURCES."
- (if-let (found (member cand candidates))
- (cons (cdr (get-text-property 0 'consult-multi (car found)))
- (consult--multi-source sources cand))
- (unless (string-blank-p cand)
- (list cand))))
-
-(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)))
- (add-text-properties 0 (length item) `(,@face consult-multi (,cat . ,item)) 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 (`(,cand . ,src) restore)
- ;; Get state function
- (let ((selected-fun (cdr (assq src states))))
- (if restore
- (progn
- ;; If the candidate source changed, destruct first the last source.
- (when (and last-fun (not (eq last-fun selected-fun)))
- (funcall last-fun nil t))
- ;; Destruct all the sources, except the last and selected source
- (dolist (state states)
- (let ((fun (cdr state)))
- (unless (or (eq fun last-fun) (eq fun selected-fun))
- (funcall fun nil t))))
- ;; Finally destruct the source with the selected candidate
- (when selected-fun (funcall selected-fun cand t)))
- ;; 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 nil nil))
- (setq last-fun selected-fun)
- ;; Call the state function.
- (when selected-fun (funcall selected-fun cand nil))))))))
-
-(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 function returns the selected candidate in the form (cons candidate
-source-value). 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 - Action function called with the selected candidate.
-* :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 'consult-multi
- :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)))
- (when-let (action (plist-get (cdr selected) :action))
- (funcall action (car 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 (inp _) (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
- (alist-get this-command consult--read-config)
- 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 (cand restore)
- (if restore
- (when ov (delete-overlay ov))
- (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"
- (cl-letf* ((config (alist-get #'consult-completion-in-region consult--read-config))
- ;; 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 (_inp cand)
- (substitute-in-file-name cand)))
- ;; Ensure that ./ prefix is kept for the shell (#356)
- ((string-match-p "\\`\\.\\.?/" initial)
- (lambda (_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 (_inp cand)
- (file-relative-name (substitute-in-file-name cand)))))
- (lambda (_inp cand) cand))
- ;; candidate function
- (apply-partially #'run-hook-with-args-until-success
- 'consult--completion-candidate-hook)
- (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
- (delete-region start end)
- (insert (substring-no-properties 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
-
-;;;###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
- (funcall
- (if-let (prefix (car consult-crm-prefix))
- (apply-partially #'mapcar (lambda (item) (propertize item 'line-prefix prefix)))
- #'identity)
- (all-completions "" table pred)))
- (format-item
- (lambda (item)
- ;; Restore original candidate in order to preserve formatting
- (setq item (propertize (or (car (member item orig-items)) item)
- 'consult--crm-selected t
- '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))
- 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))
- 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 (substring-no-properties result) separator 'omit-nulls)
- consult--crm-history (append selected hist-val)))))
- (remove-hook 'pre-command-hook hook)))
- (set hist-sym consult--crm-history)
- (when (consp def)
- (setq def (car def)))
- (if (and def (not (equal "" def)) (not selected))
- (split-string def separator 'omit-nulls)
- (mapcar #'substring-no-properties 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))))))
- (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)
- (point-marker) 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* ((cands (consult--with-increased-gc (consult--outline-candidates)))
- (min-level (- (apply #'min (mapcar
- (lambda (cand)
- (get-text-property 0 'consult--outline-level cand))
- cands))
- ?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
- cands
- :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--jump-state))))
-
-;;;;; 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)
- (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 (point-marker) 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 (input candidates cand)
- "Lookup position of match.
-
-INPUT is the input string entered by the user.
-CANDIDATES is the line candidates alist.
-CAND is the currently selected candidate."
- (when-let (pos (consult--lookup-location input candidates cand))
- (if (or (string-blank-p input)
- (eq consult-line-point-placement 'line-beginning))
- pos
- (let ((beg 0)
- (end (length cand))
- (high (+ consult--tofu-char consult--tofu-range -1)))
- ;; Ignore tofu-encoded unique line number suffix
- (while (and (> end 0) (<= consult--tofu-char (aref cand (1- end)) high))
- (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 cand 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 cand (+ 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--jump-state)))
-
-;;;###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* ((lines)
- (buffer-orig (current-buffer))
- (font-lock-orig font-lock-mode)
- (hl-line-orig (bound-and-true-p hl-line-mode))
- (point-orig (point))
- (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 (input restore)
- (with-current-buffer buffer-orig
- ;; Restoring content and point position
- (when (and restore 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 restore (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 restore
- (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 restore
- (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 restore
- (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)
- (barf-if-buffer-read-only)
- (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) (point-orig (point)))
- (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))))
- (consult--each-line beg end
- (push (buffer-substring-no-properties beg end) lines)
- (push (make-overlay beg (1+ end)) overlays))))
- (unless (use-region-p)
- (goto-char (point-min)))
- (lambda (input restore)
- ;; New input provided -> Update
- (when (and input (not (equal input last-input)))
- (if (string-match-p "\\`!? ?\\'" input)
- ;; Special case the empty input for performance.
- (progn
- (dolist (ov overlays)
- (overlay-put ov 'invisible nil))
- (setq last-input input))
- (let* ((not (string-prefix-p "! " input))
- (stripped (string-remove-prefix "! " input))
- ;; Heavy computation is interruptible if *not* committing!
- (ht (if restore
- (consult--string-hash (funcall filter stripped lines))
- (while-no-input
- (consult--string-hash (funcall filter stripped lines))))))
- (when (hash-table-p ht)
- (let ((ov overlays) (li lines))
- (while ov
- (overlay-put (car ov) 'invisible (eq not (gethash (car li) ht)))
- (setq li (cdr li) ov (cdr ov))))
- (setq last-input input)))))
- (when restore
- (cond
- ((not input)
- (goto-char point-orig))
- ((equal input "")
- (consult-focus-lines 'show))
- (t
- ;; Sucessfully terminated -> Remember invisible overlays
- (dolist (ov overlays)
- (if (overlay-get ov 'invisible)
- (push ov consult--focus-lines-overlays)
- (delete-overlay ov)))
- (setq overlays nil)))
- ;; Destroy remaining overlays
- (mapc #'delete-overlay overlays)))))
-
-;;;###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: "
- :state (let ((preview (consult--jump-preview)))
- (lambda (str restore)
- (funcall preview
- (consult--goto-line-position str #'ignore)
- restore))))
- #'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 (cand restore)
- (if restore
- (progn
- (funcall preview nil t)
- (funcall open))
- (funcall preview (and cand (funcall open cand)) nil)))))
-
-(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 'consult--mode-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
- nil kill-ring
- (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 'consult-yank
- :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))))))
-
-;; 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 (cand restore)
- (if restore
- (progn
- (funcall open)
- (funcall preview nil t))
- (funcall
- preview
- (when-let (bm (and cand (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)))
- 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
-
-(defun consult--current-history ()
- "Return 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
- ;; 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)
- (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)
- (symbol-value minibuffer-history-variable))) ;; (minibuffer-history-value) is Emacs 27 only
- ;; Otherwise we use a mode-specific history, see `consult-mode-histories'.
- (t (when-let (history
- (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)))
- (symbol-value (cdr history))))))
-
-(declare-function ring-elements "ring")
-;; 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
- (let ((history (or history (consult--current-history))))
- (or (consult--remove-dups (if (ring-p history)
- (ring-elements 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)
- :state
- (consult--insertion-preview (point) (point))
- :sort nil))))
- (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)
- ;; Emacs 27.1 uses settings on the search string, we can use that for narrowing.
- (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 (_ candidates str)
- (if-let (found (member str candidates)) (substring (car found) 0 -1) str))
- :state
- (lambda (cand restore)
- (unless restore
- (setq isearch-string cand)
- ;; Emacs 27.1 uses properties on the search string to store settings
- (when (fboundp 'isearch-update-from-string-properties)
- (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))))
-
-(define-obsolete-function-alias
- 'consult-isearch
- 'consult-isearch-history
- "0.12")
-
-;;;;; 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 nil (custom-available-themes))))
- (saved-theme (car custom-enabled-themes)))
- (consult--read
- (mapcar (lambda (x) (if x (symbol-name x) "default")) avail-themes)
- :prompt "Theme: "
- :require-match t
- :category 'theme
- :history 'consult--theme-history
- :lookup (lambda (_input _cands x)
- (unless (equal x "default")
- (or (when-let (cand (and x (intern-soft x)))
- (car (memq cand avail-themes)))
- saved-theme)))
- :state (lambda (cand restore)
- (consult-theme (if (and restore (not cand))
- saved-theme
- cand)))
- :default (symbol-name (or saved-theme 'default))))))
- (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.
- (when-let (root (or (consult--normalize-directory directory) t))
- (let ((buffers (buffer-list)))
- (when sort
- (setq buffers (funcall (intern (format "consult--buffer-sort-%s" sort)) buffers)))
- (when (or filter mode as (stringp root))
- (let ((mode (consult--to-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 (stringp 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)))
- (lambda (cand restore)
- (when (and (not restore)
- ;; Only preview in current window and other window.
- ;; Preview in frames and tabs is not possible since these don't get cleaned up.
- (or (eq consult--buffer-display #'switch-to-buffer)
- (eq consult--buffer-display #'switch-to-buffer-other-window)))
- (cond
- ((and cand (get-buffer cand)) (consult--buffer-action cand 'norecord))
- ((buffer-live-p orig-buf) (consult--buffer-action 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-root-function)
- :items
- ,(lambda ()
- (consult--buffer-query :sort 'visibility
- :directory 'project
- :as #'buffer-name)))
- "Project buffer candidate source for `consult-buffer'.")
-
-(defvar consult--source-project-file
- `(:name "Project File"
- :narrow (?p . "Project")
- :hidden t
- :category file
- :face consult-file
- :history file-name-history
- :state ,#'consult--file-state
- :enabled ,(lambda () (and consult-project-root-function
- recentf-mode))
- :items
- ,(lambda ()
- (when-let (root (consult--project-root))
- (let ((len (length root))
- (inv-root (propertize root 'invisible t))
- (ht (consult--buffer-file-hash)))
- (mapcar (lambda (x)
- (concat inv-root (substring x len)))
- (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-file
- `(:name "File"
- :narrow ?f
- :category file
- :face consult-file
- :history file-name-history
- :state ,#'consult--file-state
- :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 ()
- "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. Furthermore 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-root-function' is used. See `consult-buffer-sources' and
-`consult--multi' for the configuration of the virtual buffer sources."
- (interactive)
- (when-let (buffer (consult--multi consult-buffer-sources
- :require-match
- (confirm-nonexistent-file-or-buffer)
- :prompt "Switch to: "
- :history 'consult--buffer-history
- :sort nil))
- ;; When the buffer does not belong to a source,
- ;; create a new buffer with the name.
- (unless (cdr buffer)
- (consult--buffer-action (car buffer)))))
-
-;;;###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 preview state function."
- (let ((open (consult--temporary-files))
- (jump (consult--jump-state)))
- (lambda (cand restore)
- (when restore
- (funcall open))
- (funcall jump
- (consult--grep-position cand (and (not restore) open))
- restore))))
-
-(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))
- (read-process-output-max (max read-process-output-max (* 1024 1024))))
- (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)))
- (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 for regexp with grep in DIR with INITIAL input.
-
-The input string is split, the first part of the string 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 --.
-
-Example: #async-regexp -- grep-opts#filter-string
-
-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-root-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* ((`(,arg . ,opts) (consult--command-split input))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended)))
- (when re
- (list :command
- (append (split-string-and-unquote consult-git-grep-args)
- (cdr (mapcan (lambda (x) (list "--and" "-e" x)) re))
- opts)
- :highlight hl))))
-
-;;;###autoload
-(defun consult-git-grep (&optional dir initial)
- "Search for regexp with grep in DIR with INITIAL input.
-
-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)))
- (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 for regexp with rg in DIR with INITIAL input.
-
-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 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))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg type)))
- (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 regexp with find in DIR with 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 INPUT."
- (pcase-let* ((`(,arg . ,opts) (consult--command-split input))
- (`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic)))
- (when re
- (list :command
- (append (split-string-and-unquote consult-locate-args)
- (list (consult--join-regexps re 'basic))
- opts)
- :highlight hl))))
-
-;;;###autoload
-(defun consult-locate (&optional initial)
- "Search for regexp with locate with INITIAL input.
-
-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))))))
-
-(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 regexp with man with INITIAL input.
-
-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)))
- (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))
-
-;;; consult.el ends here
diff --git a/elpa/consult-0.13/consult.elc b/elpa/consult-0.13/consult.elc
Binary files differ.
diff --git a/elpa/corfu-0.16.signed b/elpa/corfu-0.16.signed
@@ -1 +0,0 @@
-Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2021-11-27T11:05:02+0100 using RSA
-\ No newline at end of file
diff --git a/elpa/corfu-0.16/LICENSE b/elpa/corfu-0.16/LICENSE
@@ -1,674 +0,0 @@
- 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/corfu-0.16/README.org b/elpa/corfu-0.16/README.org
@@ -1,211 +0,0 @@
-#+title: corfu.el - Completion Overlay Region FUnction
-#+author: Daniel Mendler
-#+language: en
-#+export_file_name: corfu.texi
-#+texinfo_dir_category: Emacs
-#+texinfo_dir_title: Corfu: (corfu).
-#+texinfo_dir_desc: Completion Overlay Region FUnction
-
-#+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/corfu.html"><img alt="GNU ELPA" src="https://elpa.gnu.org/packages/corfu.svg"/></a>
-#+html: <a href="http://elpa.gnu.org/devel/corfu.html"><img alt="GNU-devel ELPA" src="https://elpa.gnu.org/devel/corfu.svg"/></a>
-
-* Introduction
-
- Corfu enhances the default completion in region function with a completion
- overlay. The current candidates are shown in a popup below or above the point.
- Corfu is the minimalistic ~completion-in-region~ counterpart of the [[https://github.com/minad/vertico][Vertico]]
- minibuffer UI.
-
- Corfu is a minimal package, which relies on the Emacs completion facilities and
- concentrates on providing a polished completion UI. Completions are either
- provided by commands like ~dabbrev-completion~ or by pluggable backends
- (~completion-at-point-functions~, Capfs). Most programming language major modes
- implement a Capf. Furthermore the language server packages, [[https://github.com/joaotavora/eglot][Eglot]] and [[https://github.com/emacs-lsp/lsp-mode][Lsp-mode]],
- both use Capfs which talk to the LSP server to retrieve the completions.
-
- Corfu does not include custom completion backends. In contrast, the complex
- Company package includes custom completion backends, which deviate from the
- Emacs completion infrastructure. The Emacs built-in Capfs are mostly
- sufficient, but a few additional Capfs and completion functions are provided
- by the [[https://github.com/minad/cape][Cape]] package.
-
- *NOTE*: Corfu uses child frames to show the popup; on non-graphical displays it
- will fall back to the default setting of the ~completion-in-region-function~.
-
- [[https://github.com/minad/corfu/blob/screenshots/light.png?raw=true]]
-
- [[https://github.com/minad/corfu/blob/screenshots/dark.png?raw=true]]
-
-* Features
-
- - Timer-based auto-completions (/off/ by default, set ~corfu-auto~).
- - Popup display with scrollbar indicator and arrow key navigation.
- - The popup can be summoned explicitly by pressing =TAB= at any time.
- - The current candidate is inserted with =TAB= and selected with =RET=.
- - Candidates sorting by prefix, string length and alphabetically.
- - The selected candidate is previewed (configuable via ~corfu-preview-current~).
- - The selected candidate automatically committed on further input by default
- (configurable via ~corfu-commit-predicate~).
- - The [[https://github.com/oantolin/orderless][Orderless]] completion style is supported. The filter string can contain
- arbitrary characters, including spaces, if ~corfu-quit-at-boundary~ is nil.
- - Deferred completion style highlighting for performance.
- - Jumping to location/documentation of current candidate.
- - Show candidate documentation/signature string in the echo area.
- - Deprecated candidates are crossed out in the display.
- - Support for annotations (~annotation-function~, ~affixation-function~).
- - Icons can be provided by an external package via margin formatter functions.
-
-* Installation and Configuration
-
- Corfu is available from [[http://elpa.gnu.org/packages/corfu.html][GNU ELPA]], such that it can be installed directly via
- ~package-install~. After installation, the global minor mode can be enabled with
- =M-x corfu-global-mode=. In order to configure Corfu and other packages in your
- init.el, you may want to use ~use-package~.
-
- Corfu is highly flexible and customizable via ~corfu-*~ customization variables.
- For filtering I recommend to give Orderless completion a try, which is
- different from the familiar prefix TAB completion. Corfu can be used with the
- default completion styles, the use of Orderless is not a necessity. See also
- the [[https://github.com/minad/corfu/wiki][Corfu Wiki]] for additional configuration tips. In particular the Lsp-mode
- configuration is documented in the Wiki.
-
- Here is an example configuration:
-
- #+begin_src emacs-lisp
- (use-package corfu
- ;; Optional customizations
- ;; :custom
- ;; (corfu-cycle t) ;; Enable cycling for `corfu-next/previous'
- ;; (corfu-auto t) ;; Enable auto completion
- ;; (corfu-commit-predicate nil) ;; Do not commit selected candidates on next input
- ;; (corfu-quit-at-boundary t) ;; Automatically quit at word boundary
- ;; (corfu-quit-no-match t) ;; Automatically quit if there is no match
- ;; (corfu-preview-current nil) ;; Disable current candidate preview
- ;; (corfu-preselect-first nil) ;; Disable candidate preselection
- ;; (corfu-echo-documentation nil) ;; Disable documentation in the echo area
- ;; (corfu-scroll-margin 5) ;; Use scroll margin
-
- ;; You may want to enable Corfu only for certain modes.
- ;; :hook ((prog-mode . corfu-mode)
- ;; (shell-mode . corfu-mode)
- ;; (eshell-mode . corfu-mode))
-
- ;; Recommended: Enable Corfu globally.
- ;; This is recommended since dabbrev can be used globally (M-/).
- :init
- (corfu-global-mode))
-
- ;; Optionally use the `orderless' completion style. See `+orderless-dispatch'
- ;; in the Consult wiki for an advanced Orderless style dispatcher.
- ;; Enable `partial-completion' for files to allow path expansion.
- ;; You may prefer to use `initials' instead of `partial-completion'.
- (use-package orderless
- :init
- ;; Configure a custom style dispatcher (see the Consult wiki)
- ;; (setq orderless-style-dispatchers '(+orderless-dispatch)
- ;; orderless-component-separator #'orderless-escapable-split-on-space)
- (setq completion-styles '(orderless)
- completion-category-defaults nil
- completion-category-overrides '((file (styles . (partial-completion))))))
-
- ;; Use dabbrev with Corfu!
- (use-package dabbrev
- ;; Swap M-/ and C-M-/
- :bind (("M-/" . dabbrev-completion)
- ("C-M-/" . dabbrev-expand)))
-
- ;; A few more useful configurations...
- (use-package emacs
- :init
- ;; TAB cycle if there are only few candidates
- (setq completion-cycle-threshold 3)
-
- ;; Emacs 28: Hide commands in M-x which do not apply to the current mode.
- ;; Corfu commands are hidden, since they are not supposed to be used via M-x.
- ;; (setq read-extended-command-predicate
- ;; #'command-completion-default-include-p)
-
- ;; Enable indentation+completion using the TAB key.
- ;; `completion-at-point' is often bound to M-TAB.
- (setq tab-always-indent 'complete))
- #+end_src
-
-** TAB-and-Go completion
-
-You may be interested in configuring Corfu in TAB-and-Go style. Pressing TAB
-moves to the next candidate and further input will then commit the selection.
-
-#+begin_src emacs-lisp
- (use-package corfu
- ;; TAB-and-Go customizations
- :custom
- (corfu-cycle t) ;; Enable cycling for `corfu-next/previous'
- (corfu-preselect-first nil) ;; Disable candidate preselection
-
- ;; Use TAB for cycling, default is `corfu-complete'.
- :bind
- (:map corfu-map
- ("TAB" . corfu-next)
- ([tab] . corfu-next)
- ("S-TAB" . corfu-previous)
- ([backtab] . corfu-previous))
-
- :init
- (corfu-global-mode))
-#+end_src
-
-* Key bindings
-
- Corfu uses a transient keymap ~corfu-map~ which is active while the popup is shown.
- The keymap defines the following remappings and bindings:
-
- - ~beginning-of-buffer~ -> ~corfu-first~
- - ~end-of-buffer~ -> ~corfu-last~
- - ~scroll-down-command~ -> ~corfu-scroll-down~
- - ~scroll-up-command~ -> ~corfu-scroll-up~
- - ~next-line~, =down=, =M-n= -> ~corfu-next~
- - ~previous-line~, =up=, =M-p= -> ~corfu-previous~
- - ~completion-at-point~, =TAB= -> ~corfu-complete~
- - =RET= -> ~corfu-insert~
- - =M-g= -> ~corfu-show-location~
- - =M-h= -> ~corfu-show-documentation~
- - =C-g= -> ~corfu-quit~
- - ~keyboard-escape-quit~ -> ~corfu-reset~
-
-* Complementary packages
-
- Corfu works well together with all packages providing code completion via the
- ~completion-at-point-functions~. Furthermore it supports completion styles,
- including the advanced [[https://github.com/oantolin/orderless][Orderless]] completion style, where the filtering
- expressions are separated by spaces (see ~corfu-quit-at-boundary~).
-
- I collect additional Capf backends and =completion-in-region= commands in my
- small [[https://github.com/minad/cape][Cape]] package. For example the package provides a file name and a dabbrev
- completion backend.
-
- Icons are supported by Corfu via an external package. For example the
- [[https://github.com/jdtsmith/kind-icon][kind-icon]] package provides beautifully styled SVG icons based on monochromatic
- icon sets like material design.
-
- You may also want to look into my [[https://github.com/minad/vertico][Vertico]] package. Vertico is the minibuffer
- counterpart of Corfu.
-
-* Caveats
-
- Corfu is robust in most scenarios. There are a few known technical caveats.
-
- - Corfu falls back to the default Completion buffer on non-graphical displays,
- since Corfu requires child frames.
- - No sorting by history, since ~completion-at-point~ does not
- maintain a history (See branch =history= for a possible solution).
- - There is currently no equivalent for =company-quickhelp=. Documentation and source
- can be opened manually in a separate buffer.
- - Company has the ability to merge/group the candidates of multiple backends
- in some scenarios. This feature is implemented by the function
- ~cape-super-capf~ of the [[https://github.com/minad/cape][Cape]] package.
-
-* Contributions
-
- Since this package is part of [[http://elpa.gnu.org/packages/corfu.html][GNU ELPA]] contributions require a copyright
- assignment to the FSF.
diff --git a/elpa/corfu-0.16/corfu-autoloads.el b/elpa/corfu-0.16/corfu-autoloads.el
@@ -1,60 +0,0 @@
-;;; corfu-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-
-;;;### (autoloads nil "corfu" "corfu.el" (0 0 0 0))
-;;; Generated autoloads from corfu.el
-
-(autoload 'corfu-mode "corfu" "\
-Completion Overlay Region FUnction
-
-If called interactively, enable Corfu mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp,
-also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(put 'corfu-global-mode 'globalized-minor-mode t)
-
-(defvar corfu-global-mode nil "\
-Non-nil if Corfu-Global mode is enabled.
-See the `corfu-global-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `corfu-global-mode'.")
-
-(custom-autoload 'corfu-global-mode "corfu" nil)
-
-(autoload 'corfu-global-mode "corfu" "\
-Toggle Corfu mode in all buffers.
-With prefix ARG, enable Corfu-Global mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
-
-Corfu mode is enabled in all buffers where
-`corfu--on' would do it.
-See `corfu-mode' for more information on Corfu mode.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "corfu" '("corfu-")))
-
-;;;***
-
-;;;### (autoloads nil nil ("corfu-pkg.el") (0 0 0 0))
-
-;;;***
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; corfu-autoloads.el ends here
diff --git a/elpa/corfu-0.16/corfu-pkg.el b/elpa/corfu-0.16/corfu-pkg.el
@@ -1,2 +0,0 @@
-;; Generated package description from corfu.el -*- no-byte-compile: t -*-
-(define-package "corfu" "0.16" "Completion Overlay Region FUnction" '((emacs "27.1")) :authors '(("Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '("Daniel Mendler" . "mail@daniel-mendler.de") :url "https://github.com/minad/corfu")
diff --git a/elpa/corfu-0.16/corfu.el b/elpa/corfu-0.16/corfu.el
@@ -1,1193 +0,0 @@
-;;; corfu.el --- Completion Overlay Region FUnction -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.16
-;; Package-Requires: ((emacs "27.1"))
-;; Homepage: https://github.com/minad/corfu
-
-;; 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:
-
-;; Corfu enhances the default completion in region function with a
-;; completion overlay. The current candidates are shown in a popup
-;; below or above the point. Corfu can be considered the minimalistic
-;; completion-in-region counterpart of Vertico.
-
-;;; Code:
-
-(require 'seq)
-(eval-when-compile
- (require 'cl-lib)
- (require 'subr-x))
-
-(defgroup corfu nil
- "Completion Overlay Region FUnction."
- :group 'convenience
- :prefix "corfu-")
-
-(defcustom corfu-count 10
- "Maximal number of candidates to show."
- :type 'integer)
-
-(defcustom corfu-scroll-margin 2
- "Number of lines at the top and bottom when scrolling.
-The value should lie between 0 and corfu-count/2."
- :type 'integer)
-
-(defcustom corfu-min-width 15
- "Popup minimum width in characters."
- :type 'integer)
-
-(defcustom corfu-max-width 100
- "Popup maximum width in characters."
- :type 'integer)
-
-(defcustom corfu-cycle nil
- "Enable cycling for `corfu-next' and `corfu-previous'."
- :type 'boolean)
-
-(defcustom corfu-continue-commands
- ;; nil is undefined command
- '(nil ignore completion-at-point universal-argument universal-argument-more digit-argument
- "\\`corfu-" "\\`scroll-other-window")
- "Continue Corfu completion after executing these commands."
- :type '(repeat (choice regexp symbol)))
-
-(defcustom corfu-commit-predicate #'corfu-candidate-previewed-p
- "Automatically commit if the predicate returns t."
- :type '(choice (const nil) function))
-
-(defcustom corfu-preview-current t
- "Preview currently selected candidate."
- :type 'boolean)
-
-(defcustom corfu-preselect-first t
- "Preselect first candidate."
- :type 'boolean)
-
-(defcustom corfu-quit-at-boundary nil
- "Automatically quit at completion field/word boundary.
-If automatic quitting is disabled, Orderless filter strings with spaces
-are allowed."
- :type 'boolean)
-
-(defcustom corfu-quit-no-match 1.0
- "Automatically quit if no matching candidate is found.
-If a floating point number, quit on no match only if the auto-started
-completion began less than that number of seconds ago."
- :type '(choice boolean float))
-
-(defcustom corfu-excluded-modes nil
- "List of modes excluded by `corfu-global-mode'."
- :type '(repeat symbol))
-
-(defcustom corfu-left-margin-width 0.5
- "Width of the left margin in units of the character width."
- :type 'float)
-
-(defcustom corfu-right-margin-width 0.5
- "Width of the right margin in units of the character width."
- :type 'float)
-
-(defcustom corfu-bar-width 0.2
- "Width of the bar in units of the character width."
- :type 'float)
-
-(defcustom corfu-echo-documentation 0.5
- "Show documentation string in the echo area after that number of seconds."
- :type '(choice boolean float))
-
-(defcustom corfu-margin-formatters nil
- "Registry for margin formatter functions.
-Each function of the list is called with the completion metadata as
-argument until an appropriate formatter is found. The function should
-return a formatter function, which takes the candidate string and must
-return a string, possibly an icon."
- :type 'hook)
-
-(defcustom corfu-sort-function #'corfu-sort-length-alpha
- "Default sorting function, used if no `display-sort-function' is specified."
- :type `(choice
- (const :tag "No sorting" nil)
- (const :tag "By length and alpha" ,#'corfu-sort-length-alpha)
- (function :tag "Custom function")))
-
-(defcustom corfu-auto-prefix 3
- "Minimum length of prefix for auto completion.
-The completion backend can override this with
-:company-prefix-length."
- :type 'integer)
-
-(defcustom corfu-auto-delay 0.2
- "Delay for auto completion."
- :type 'float)
-
-(defcustom corfu-auto-commands
- '("self-insert-command\\'")
- "Commands which initiate auto completion."
- :type '(repeat (choice regexp symbol)))
-
-(defcustom corfu-auto nil
- "Enable auto completion."
- :type 'boolean)
-
-(defgroup corfu-faces nil
- "Faces used by Corfu."
- :group 'corfu
- :group 'faces)
-
-(defface corfu-default
- '((((class color) (min-colors 88) (background dark)) :background "#191a1b")
- (((class color) (min-colors 88) (background light)) :background "#f0f0f0")
- (t :background "gray"))
- "Default face used for the popup, in particular the background and foreground color.")
-
-(defface corfu-current
- '((((class color) (min-colors 88) (background dark))
- :background "#00415e" :foreground "white")
- (((class color) (min-colors 88) (background light))
- :background "#c0efff" :foreground "black")
- (t :background "blue" :foreground "white"))
- "Face used to highlight the currently selected candidate.")
-
-(defface corfu-bar
- '((((class color) (min-colors 88) (background dark)) :background "#a8a8a8")
- (((class color) (min-colors 88) (background light)) :background "#505050")
- (t :background "gray"))
- "The background color is used for the scrollbar indicator.")
-
-(defface corfu-border
- '((((class color) (min-colors 88) (background dark)) :background "#323232")
- (((class color) (min-colors 88) (background light)) :background "#d7d7d7")
- (t :background "gray"))
- "The background color used for the thin border.")
-
-(defface corfu-echo
- '((t :inherit completions-annotations))
- "Face used for echo area messages.")
-
-(defface corfu-annotations
- '((t :inherit completions-annotations))
- "Face used for annotations.")
-
-(defface corfu-deprecated
- '((t :inherit shadow :strike-through t))
- "Face used for deprecated candidates.")
-
-(defvar corfu-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap beginning-of-buffer] #'corfu-first)
- (define-key map [remap end-of-buffer] #'corfu-last)
- (define-key map [remap scroll-down-command] #'corfu-scroll-down)
- (define-key map [remap scroll-up-command] #'corfu-scroll-up)
- (define-key map [remap next-line] #'corfu-next)
- (define-key map [remap previous-line] #'corfu-previous)
- (define-key map [remap completion-at-point] #'corfu-complete)
- (define-key map [down] #'corfu-next)
- (define-key map [up] #'corfu-previous)
- (define-key map [remap keyboard-escape-quit] #'corfu-reset)
- ;; XXX [tab] is bound because of org-mode
- ;; The binding should be removed from org-mode-map.
- (define-key map [tab] #'corfu-complete)
- (define-key map "\en" #'corfu-next)
- (define-key map "\ep" #'corfu-previous)
- (define-key map "\C-g" #'corfu-quit)
- (define-key map "\r" #'corfu-insert)
- (define-key map "\t" #'corfu-complete)
- (define-key map "\eg" #'corfu-show-location)
- (define-key map "\eh" #'corfu-show-documentation)
- map)
- "Corfu keymap used when popup is shown.")
-
-(defvar corfu--auto-timer nil
- "Auto completion timer.")
-
-(defvar-local corfu--candidates nil
- "List of candidates.")
-
-(defvar-local corfu--metadata nil
- "Completion metadata.")
-
-(defvar-local corfu--base 0
- "Size of the base string, which is concatenated with the candidate.")
-
-(defvar-local corfu--total 0
- "Length of the candidate list `corfu--candidates'.")
-
-(defvar-local corfu--highlight #'identity
- "Deferred candidate highlighting function.")
-
-(defvar-local corfu--index -1
- "Index of current candidate or negative for prompt selection.")
-
-(defvar-local corfu--preselect -1
- "Index of preselected candidate, negative for prompt selection.")
-
-(defvar-local corfu--scroll 0
- "Scroll position.")
-
-(defvar-local corfu--input nil
- "Cons of last prompt contents and point or t.")
-
-(defvar-local corfu--preview-ov nil
- "Current candidate overlay.")
-
-(defvar-local corfu--extra nil
- "Extra completion properties.")
-
-(defvar-local corfu--change-group nil
- "Undo change group.")
-
-(defvar-local corfu--auto-start nil
- "Auto completion start time.")
-
-(defvar-local corfu--echo-timer nil
- "Echo area message timer.")
-
-(defvar-local corfu--echo-message nil
- "Last echo message.")
-
-(defvar corfu--frame nil
- "Popup frame.")
-
-(defconst corfu--state-vars
- '(corfu--base
- corfu--candidates
- corfu--highlight
- corfu--index
- corfu--preselect
- corfu--scroll
- corfu--input
- corfu--total
- corfu--preview-ov
- corfu--extra
- corfu--auto-start
- corfu--echo-timer
- corfu--echo-message
- corfu--change-group
- corfu--metadata)
- "Buffer-local state variables used by Corfu.")
-
-(defvar corfu--frame-parameters
- '((no-accept-focus . t)
- (no-focus-on-map . t)
- (min-width . t)
- (min-height . t)
- (width . 0)
- (height . 0)
- (border-width . 0)
- (child-frame-border-width . 1)
- (left-fringe . 0)
- (right-fringe . 0)
- (vertical-scroll-bars . nil)
- (horizontal-scroll-bars . nil)
- (menu-bar-lines . 0)
- (tool-bar-lines . 0)
- (tab-bar-lines . 0)
- (no-other-frame . t)
- (no-other-window . t)
- (no-delete-other-windows . t)
- (unsplittable . t)
- (undecorated . t)
- (cursor-type . nil)
- (visibility . nil)
- (no-special-glyphs . t)
- (desktop-dont-save . t))
- "Default child frame parameters.")
-
-(defvar corfu--buffer-parameters
- '((mode-line-format . nil)
- (header-line-format . nil)
- (tab-line-format . nil)
- (tab-bar-format . nil) ;; Emacs 28 tab-bar-format
- (frame-title-format . "")
- (truncate-lines . t)
- (cursor-in-non-selected-windows . nil)
- (cursor-type . nil)
- (show-trailing-whitespace . nil)
- (display-line-numbers . nil)
- (left-fringe-width . nil)
- (right-fringe-width . nil)
- (left-margin-width . 0)
- (right-margin-width . 0)
- (fringes-outside-margins . 0)
- (buffer-read-only . t))
- "Default child frame buffer parameters.")
-
-(defvar corfu--mouse-ignore-map
- (let ((map (make-sparse-keymap)))
- (dotimes (i 7)
- (dolist (k '(mouse down-mouse drag-mouse double-mouse triple-mouse))
- (define-key map (vector (intern (format "%s-%s" k (1+ i)))) #'ignore)))
- map)
- "Ignore all mouse clicks.")
-
-(defun corfu--popup-redirect-focus ()
- "Redirect focus from popup."
- (redirect-frame-focus corfu--frame (frame-parent corfu--frame)))
-
-(defun corfu--make-buffer (content)
- "Create corfu buffer with CONTENT."
- (let ((fr face-remapping-alist)
- (buffer (get-buffer-create " *corfu*")))
- (with-current-buffer buffer
- ;;; XXX HACK install redirect focus hook
- (add-hook 'pre-command-hook #'corfu--popup-redirect-focus nil 'local)
- ;;; XXX HACK install mouse ignore map
- (use-local-map corfu--mouse-ignore-map)
- (dolist (var corfu--buffer-parameters)
- (set (make-local-variable (car var)) (cdr var)))
- (setq-local face-remapping-alist (copy-tree fr))
- (cl-pushnew 'corfu-default (alist-get 'default face-remapping-alist))
- (let ((inhibit-modification-hooks t)
- (inhibit-read-only t))
- (erase-buffer)
- (insert content)
- (goto-char (point-min))))
- buffer))
-
-;; Function adapted from posframe.el by tumashu
-(defun corfu--make-frame (x y width height content)
- "Show child frame at X/Y with WIDTH/HEIGHT and CONTENT."
- (let* ((window-min-height 1)
- (window-min-width 1)
- (x-gtk-resize-child-frames
- (let ((case-fold-search t))
- (and
- ;; XXX HACK to fix resizing on gtk3/gnome taken from posframe.el
- ;; More information:
- ;; * https://github.com/minad/corfu/issues/17
- ;; * https://gitlab.gnome.org/GNOME/mutter/-/issues/840
- ;; * https://lists.gnu.org/archive/html/emacs-devel/2020-02/msg00001.html
- (string-match-p "gtk3" system-configuration-features)
- (string-match-p "gnome\\|cinnamon" (or (getenv "XDG_CURRENT_DESKTOP")
- (getenv "DESKTOP_SESSION") ""))
- 'resize-mode)))
- (after-make-frame-functions)
- (edge (window-inside-pixel-edges))
- (lh (default-line-height))
- (x (max 0 (min (+ (car edge) x
- (- (alist-get 'child-frame-border-width corfu--frame-parameters)))
- (- (frame-pixel-width) width))))
- (yb (+ (cadr edge) (window-tab-line-height) y lh))
- (y (if (> (+ yb height lh lh) (frame-pixel-height))
- (- yb height lh 1)
- yb))
- (buffer (corfu--make-buffer content)))
- (unless (and (frame-live-p corfu--frame)
- (eq (frame-parent corfu--frame) (window-frame)))
- (when corfu--frame (delete-frame corfu--frame))
- (setq corfu--frame (make-frame
- `((parent-frame . ,(window-frame))
- (minibuffer . ,(minibuffer-window (window-frame)))
- (line-spacing . ,line-spacing)
- ;; Set `internal-border-width' for Emacs 27
- (internal-border-width
- . ,(alist-get 'child-frame-border-width corfu--frame-parameters))
- ,@corfu--frame-parameters))))
- ;; XXX HACK Setting the same frame-parameter/face-background is not a nop (BUG!).
- ;; Check explicitly before applying the setting.
- ;; Without the check, the frame flickers on Mac.
- ;; XXX HACK We have to apply the face background before adjusting the frame parameter,
- ;; otherwise the border is not updated (BUG!).
- (let* ((face (if (facep 'child-frame-border) 'child-frame-border 'internal-border))
- (new (face-attribute 'corfu-border :background nil 'default)))
- (unless (equal (face-attribute face :background corfu--frame 'default) new)
- (set-face-background face new corfu--frame)))
- (let ((new (face-attribute 'corfu-default :background nil 'default)))
- (unless (equal (frame-parameter corfu--frame 'background-color) new)
- (set-frame-parameter corfu--frame 'background-color new)))
- (let ((win (frame-root-window corfu--frame)))
- (set-window-buffer win buffer)
- ;; Mark window as dedicated to prevent frame reuse (#60)
- (set-window-dedicated-p win t))
- ;; XXX HACK Make the frame invisible before moving the popup in order to avoid flicker.
- (unless (eq (cdr (frame-position corfu--frame)) y)
- (make-frame-invisible corfu--frame))
- (set-frame-position corfu--frame x y)
- (set-frame-size corfu--frame width height t)
- (make-frame-visible corfu--frame)))
-
-(defun corfu--popup-show (pos off width lines &optional curr lo bar)
- "Show LINES as popup at POS - OFF.
-WIDTH is the width of the popup.
-The current candidate CURR is highlighted.
-A scroll bar is displayed from LO to LO+BAR."
- (let* ((ch (default-line-height))
- (cw (default-font-width))
- (lm (ceiling (* cw corfu-left-margin-width)))
- (rm (ceiling (* cw corfu-right-margin-width)))
- (bw (ceiling (min rm (* cw corfu-bar-width))))
- (lmargin (and (> lm 0) (propertize " " 'display `(space :width (,lm)))))
- (rmargin (and (> rm 0) (propertize " " 'display `(space :align-to right))))
- (sbar (when (> bw 0)
- (concat (propertize " " 'display `(space :align-to (- right (,rm))))
- (propertize " " 'display `(space :width (,(- rm bw))))
- (propertize " " 'face 'corfu-bar 'display `(space :width (,bw))))))
- (row 0)
- (pos (posn-x-y (posn-at-point pos)))
- (x (or (car pos) 0))
- (y (or (cdr pos) 0)))
- (corfu--make-frame
- (- x lm (* cw off)) y
- (+ (* width cw) lm rm) (* (length lines) ch)
- (mapconcat (lambda (line)
- (let ((str (concat lmargin line
- (if (and lo (<= lo row (+ lo bar))) sbar rmargin))))
- (when (eq row curr)
- (add-face-text-property
- 0 (length str) 'corfu-current 'append str))
- (setq row (1+ row))
- str))
- lines "\n"))))
-
-(defun corfu--popup-hide ()
- "Hide Corfu popup."
- (when (frame-live-p corfu--frame)
- (make-frame-invisible corfu--frame)
- (with-current-buffer (window-buffer (frame-root-window corfu--frame))
- (let ((inhibit-read-only t))
- (erase-buffer)))))
-
-(defun corfu--move-to-front (elem list)
- "Move ELEM to front of LIST."
- (if-let (found (member elem list))
- (let ((head (list (car found))))
- (nconc head (delq (setcar found nil) list)))
- list))
-
-;; bug#47711: Deferred highlighting for `completion-all-completions'
-;; XXX There is one complication: `completion--twq-all' already adds `completions-common-part'.
-(defun corfu--all-completions (&rest args)
- "Compute all completions for ARGS with deferred highlighting."
- (cl-letf* ((orig-pcm (symbol-function #'completion-pcm--hilit-commonality))
- (orig-flex (symbol-function #'completion-flex-all-completions))
- ((symbol-function #'completion-flex-all-completions)
- (lambda (&rest args)
- ;; Unfortunately for flex we have to undo the deferred highlighting, since flex uses
- ;; the completion-score for sorting, which is applied during highlighting.
- (cl-letf (((symbol-function #'completion-pcm--hilit-commonality) orig-pcm))
- (apply orig-flex args))))
- ;; Defer the following highlighting functions
- (hl #'identity)
- ((symbol-function #'completion-hilit-commonality)
- (lambda (cands prefix &optional base)
- (setq hl (lambda (x) (nconc (completion-hilit-commonality x prefix base) nil)))
- (and cands (nconc cands base))))
- ((symbol-function #'completion-pcm--hilit-commonality)
- (lambda (pattern cands)
- (setq hl (lambda (x)
- ;; `completion-pcm--hilit-commonality' sometimes throws an internal error
- ;; for example when entering "/sudo:://u".
- (condition-case nil
- (completion-pcm--hilit-commonality pattern x)
- (t x))))
- cands)))
- ;; Only advise orderless after it has been loaded to avoid load order issues
- (if (and (fboundp 'orderless-highlight-matches) (fboundp 'orderless-pattern-compiler))
- (cl-letf (((symbol-function 'orderless-highlight-matches)
- (lambda (pattern cands)
- (let ((regexps (orderless-pattern-compiler pattern)))
- (setq hl (lambda (x) (orderless-highlight-matches regexps x))))
- cands)))
- (cons (apply #'completion-all-completions args) hl))
- (cons (apply #'completion-all-completions args) hl))))
-
-(defun corfu--sort-predicate (x y)
- "Sorting predicate which compares X and Y."
- (or (< (length x) (length y)) (and (= (length x) (length y)) (string< x y))))
-
-(defun corfu-sort-length-alpha (list)
- "Sort LIST by length and alphabetically."
- (sort list #'corfu--sort-predicate))
-
-(defmacro corfu--partition! (list form)
- "Evaluate FORM for every element and partition LIST."
- (let ((head1 (make-symbol "head1"))
- (head2 (make-symbol "head2"))
- (tail1 (make-symbol "tail1"))
- (tail2 (make-symbol "tail2")))
- `(let* ((,head1 (cons nil nil))
- (,head2 (cons nil nil))
- (,tail1 ,head1)
- (,tail2 ,head2))
- (while ,list
- (if (let ((it (car ,list))) ,form)
- (progn
- (setcdr ,tail1 ,list)
- (pop ,tail1))
- (setcdr ,tail2 ,list)
- (pop ,tail2))
- (pop ,list))
- (setcdr ,tail1 (cdr ,head2))
- (setcdr ,tail2 nil)
- (setq ,list (cdr ,head1)))))
-
-(defun corfu--move-prefix-candidates-to-front (field candidates)
- "Move CANDIDATES which match prefix of FIELD to the beginning."
- (let* ((word (replace-regexp-in-string " .*" "" field))
- (len (length word)))
- (corfu--partition! candidates
- (and (>= (length it) len)
- (eq t (compare-strings word 0 len it 0 len))))))
-
-(defun corfu--filter-files (files)
- "Filter FILES by `completion-ignored-extensions'."
- (let ((re (concat "\\(?:\\(?:\\`\\|/\\)\\.\\.?/\\|"
- (regexp-opt completion-ignored-extensions)
- "\\)\\'")))
- (or (seq-remove (lambda (x) (string-match-p re x)) files) files)))
-
-(defun corfu--sort-function ()
- "Return the sorting function."
- (or (corfu--metadata-get 'display-sort-function) corfu-sort-function))
-
-(defun corfu--recompute-candidates (str pt table pred)
- "Recompute candidates from STR, PT, TABLE and PRED."
- (pcase-let* ((before (substring str 0 pt))
- (after (substring str pt))
- (corfu--metadata (completion-metadata before table pred))
- ;; bug#47678: `completion-boundaries` fails for `partial-completion`
- ;; if the cursor is moved between the slashes of "~//".
- ;; See also vertico.el which has the same issue.
- (bounds (or (condition-case nil
- (completion-boundaries before table pred after)
- (t (cons 0 (length after))))))
- (field (substring str (car bounds) (+ pt (cdr bounds))))
- (completing-file (eq (corfu--metadata-get 'category) 'file))
- (`(,all . ,hl) (corfu--all-completions str table pred pt corfu--metadata))
- (base (or (when-let (z (last all)) (prog1 (cdr z) (setcdr z nil))) 0)))
- ;; Filter the ignored file extensions. We cannot use modified predicate for this filtering,
- ;; since this breaks the special casing in the `completion-file-name-table' for `file-exists-p'
- ;; and `file-directory-p'.
- (when completing-file (setq all (corfu--filter-files all)))
- (setq all (funcall (or (corfu--sort-function) #'identity) all))
- (unless (equal field "")
- (setq all (corfu--move-prefix-candidates-to-front field all))
- (when (and completing-file (not (string-suffix-p "/" field)))
- (setq all (corfu--move-to-front (concat field "/") all)))
- (setq all (corfu--move-to-front field all)))
- (list base all (length all) hl corfu--metadata
- ;; Select the prompt when the input is a valid completion
- ;; and if it is not equal to the first candidate.
- (if (or (not corfu-preselect-first) (not all)
- (and (not (equal field (car all)))
- (not (and completing-file (equal (concat field "/") (car all))))
- (test-completion str table pred)))
- -1 0))))
-
-(defun corfu--update-candidates (str pt table pred)
- "Update candidates from STR, PT, TABLE and PRED."
- ;; Redisplay such that the input becomes immediately visible before the
- ;; expensive candidate recomputation is performed (Issue #48). See also
- ;; corresponding vertico#89.
- (redisplay)
- (pcase (while-no-input (corfu--recompute-candidates str pt table pred))
- ('nil (keyboard-quit))
- (`(,base ,candidates ,total ,hl ,metadata ,preselect)
- (setq corfu--input (cons str pt)
- corfu--candidates candidates
- corfu--base base
- corfu--total total
- corfu--preselect preselect
- corfu--index preselect
- corfu--highlight hl
- corfu--metadata metadata))))
-
-(defun corfu--match-symbol-p (pattern sym)
- "Return non-nil if SYM is matching an element of the PATTERN list."
- (and (symbolp sym)
- (cl-loop for x in pattern
- thereis (if (symbolp x)
- (eq sym x)
- (string-match-p x (symbol-name sym))))))
-
-(defun corfu-quit ()
- "Quit Corfu completion."
- (interactive)
- (completion-in-region-mode -1))
-
-(defun corfu-reset ()
- "Reset Corfu completion.
-This command can be executed multiple times by hammering the ESC key. If a
-candidate is selected, unselect the candidate. Otherwise reset the input. If
-there hasn't been any input, then quit."
- (interactive)
- (if (/= corfu--index corfu--preselect)
- (progn
- (corfu--goto -1)
- (setq this-command #'corfu-first))
- ;; Cancel all changes and start new change group.
- (cancel-change-group corfu--change-group)
- (activate-change-group (setq corfu--change-group (prepare-change-group)))
- (when (eq last-command #'corfu-reset) (corfu-quit))))
-
-(defun corfu--affixate (cands)
- "Annotate CANDS with annotation function."
- (setq cands
- (if-let (aff (or (corfu--metadata-get 'affixation-function)
- (plist-get corfu--extra :affixation-function)))
- (funcall aff cands)
- (if-let (ann (or (corfu--metadata-get 'annotation-function)
- (plist-get corfu--extra :annotation-function)))
- (cl-loop for cand in cands collect
- (let ((suffix (or (funcall ann cand) "")))
- (list cand ""
- ;; The default completion UI adds the `completions-annotations' face
- ;; if no other faces are present. We use a custom `corfu-annotations'
- ;; face to allow further styling which fits better for popups.
- (if (text-property-not-all 0 (length suffix) 'face nil suffix)
- suffix
- (propertize suffix 'face 'corfu-annotations)))))
- (cl-loop for cand in cands collect (list cand "" "")))))
- (let* ((dep (plist-get corfu--extra :company-deprecated))
- (completion-extra-properties corfu--extra)
- (mf (run-hook-with-args-until-success 'corfu-margin-formatters corfu--metadata)))
- (cl-loop for x in cands for (c . _) = x do
- (when mf
- (setf (cadr x) (funcall mf c)))
- (when (and dep (funcall dep c))
- (setcar x (setq c (substring c)))
- (add-face-text-property 0 (length c) 'corfu-deprecated 'append c)))
- (cons mf cands)))
-
-(defun corfu--metadata-get (prop)
- "Return PROP from completion metadata."
- ;; Note: Do not use `completion-metadata-get' in order to avoid Marginalia.
- ;; The Marginalia annotators are too heavy for the Corfu popup!
- (cdr (assq prop corfu--metadata)))
-
-(defun corfu--format-candidates (cands)
- "Format annotated CANDS."
- (setq cands
- (cl-loop for c in cands collect
- (cl-loop for s in c collect
- (replace-regexp-in-string "[ \t]*\n[ \t]*" " " s))))
- (let* ((cw (cl-loop for x in cands maximize (string-width (car x))))
- (pw (cl-loop for x in cands maximize (string-width (cadr x))))
- (sw (cl-loop for x in cands maximize (string-width (caddr x))))
- (width (+ pw cw sw)))
- (when (< width corfu-min-width)
- (setq cw (+ cw (- corfu-min-width width))
- width corfu-min-width))
- ;; -4 because of margins and some additional safety
- (setq width (min width corfu-max-width (- (frame-width) 4)))
- (list pw width
- (cl-loop for (cand prefix suffix) in cands collect
- (truncate-string-to-width
- (concat prefix
- (make-string (- pw (string-width prefix)) ?\s)
- cand
- (when (/= sw 0)
- (make-string (+ (- cw (string-width cand))
- (- sw (string-width suffix)))
- ?\s))
- suffix)
- width)))))
-
-(defun corfu--update-scroll ()
- "Update scroll position."
- (let ((off (max (min corfu-scroll-margin (/ corfu-count 2)) 0))
- (corr (if (= corfu-scroll-margin (/ corfu-count 2)) (1- (mod corfu-count 2)) 0)))
- (setq corfu--scroll (min (max 0 (- corfu--total corfu-count))
- (max 0 (+ corfu--index off 1 (- corfu-count))
- (min (- corfu--index off corr) corfu--scroll))))))
-
-(defun corfu--candidates-popup (pos)
- "Show candidates popup at POS."
- (corfu--update-scroll)
- (pcase-let* ((last (min (+ corfu--scroll corfu-count) corfu--total))
- (bar (ceiling (* corfu-count corfu-count) corfu--total))
- (lo (min (- corfu-count bar 1) (floor (* corfu-count corfu--scroll) corfu--total)))
- (`(,mf . ,acands) (corfu--affixate (funcall corfu--highlight
- (seq-subseq corfu--candidates corfu--scroll last))))
- (`(,pw ,width ,fcands) (corfu--format-candidates acands))
- ;; Disable the left margin if a margin formatter is active.
- (corfu-left-margin-width (if mf 0 corfu-left-margin-width)))
- ;; Nonlinearity at the end and the beginning
- (when (/= corfu--scroll 0)
- (setq lo (max 1 lo)))
- (when (/= last corfu--total)
- (setq lo (min (- corfu-count bar 2) lo)))
- (corfu--popup-show (+ pos corfu--base) pw width fcands (- corfu--index corfu--scroll)
- (and (> corfu--total corfu-count) lo) bar)))
-
-(defun corfu--preview-current (beg end str)
- "Show current candidate as overlay given BEG, END and STR."
- (when-let (cand (and corfu-preview-current (>= corfu--index 0)
- (/= corfu--index corfu--preselect)
- (nth corfu--index corfu--candidates)))
- (setq corfu--preview-ov (make-overlay beg end nil t t))
- (overlay-put corfu--preview-ov 'priority 1000)
- (overlay-put corfu--preview-ov 'window (selected-window))
- (overlay-put corfu--preview-ov
- (if (= beg end) 'after-string 'display)
- (concat (substring str 0 corfu--base) cand))))
-
-(defun corfu--echo-refresh ()
- "Refresh echo message to prevent flicker during redisplay."
- (when corfu--echo-timer
- (cancel-timer corfu--echo-timer)
- (setq corfu--echo-timer nil))
- (when corfu--echo-message
- (corfu--echo-show corfu--echo-message)))
-
-(defun corfu--echo-show (msg)
- "Show MSG in echo area."
- (let ((message-log-max nil))
- (setq corfu--echo-message msg)
- (message "%s" (if (text-property-not-all 0 (length msg) 'face nil msg)
- msg
- (propertize msg 'face 'corfu-echo)))))
-
-(defun corfu--echo-documentation ()
- "Show documentation string of current candidate in echo area."
- (when corfu-echo-documentation
- (if-let* ((fun (plist-get corfu--extra :company-docsig))
- (cand (and (>= corfu--index 0) (nth corfu--index corfu--candidates)))
- (doc (funcall fun cand)))
- (if (or (eq corfu-echo-documentation t) corfu--echo-message)
- (corfu--echo-show doc)
- (setq corfu--echo-timer (run-with-idle-timer corfu-echo-documentation
- nil #'corfu--echo-show doc)))
- (when corfu--echo-message
- (corfu--echo-show "")))))
-
-(defun corfu--update ()
- "Refresh Corfu UI."
- (pcase-let* ((`(,beg ,end ,table ,pred) completion-in-region--data)
- (pt (- (point) beg))
- (str (buffer-substring-no-properties beg end))
- (initializing (not corfu--input))
- (continue (or (/= beg end)
- (corfu--match-symbol-p corfu-continue-commands
- this-command))))
- (corfu--echo-refresh)
- (cond
- ;; XXX Guard against errors during candidate generation.
- ;; Turn off completion immediately if there are errors
- ;; For example dabbrev throws error "No dynamic expansion ... found".
- ;; TODO Report this as a bug? Are completion tables supposed to throw errors?
- ((condition-case err
- ;; Only recompute when input changed and when input is non-empty
- (when (and continue (not (equal corfu--input (cons str pt))))
- (corfu--update-candidates str pt table pred)
- nil)
- (error (corfu-quit)
- (message "Corfu completion error: %s" (error-message-string err)))))
- ;; 1) Initializing, no candidates => Quit
- ((and initializing (not corfu--candidates))
- (corfu-quit))
- ;; 2) Single matching candidate and no further completion is possible
- ((and (not (equal str ""))
- (equal corfu--candidates (list str))
- (not (consp (completion-try-completion str table pred pt corfu--metadata))))
- (corfu--done str 'finished))
- ;; 3) There exist candidates
- ;; & Input is non-empty or continue command
- ;; => Show candidates popup
- ((and corfu--candidates continue)
- (corfu--candidates-popup beg)
- (corfu--echo-documentation)
- (corfu--preview-current beg end str))
- ;; 4) There are no candidates & corfu-quit-no-match => Confirmation popup
- ((not (or corfu--candidates
- ;; When `corfu-quit-no-match' is a number of seconds and the auto completion wasn't
- ;; initiated too long ago, quit directly without showing the "No match" popup.
- (if (and corfu--auto-start (numberp corfu-quit-no-match))
- (< (- (float-time) corfu--auto-start) corfu-quit-no-match)
- (eq t corfu-quit-no-match))))
- (corfu--popup-show beg 0 8 '(#("No match" 0 8 (face italic)))))
- (t (corfu-quit)))))
-
-(defun corfu--pre-command ()
- "Insert selected candidate unless command is marked to continue completion."
- (add-hook 'window-configuration-change-hook #'corfu-quit)
- (when corfu--preview-ov
- (delete-overlay corfu--preview-ov)
- (setq corfu--preview-ov nil))
- (when (and corfu-commit-predicate
- (not (corfu--match-symbol-p corfu-continue-commands this-command))
- (funcall corfu-commit-predicate))
- (corfu--insert 'exact)))
-
-(defun corfu-candidate-previewed-p ()
- "Return t if a candidate is selected and previewed."
- (and corfu-preview-current (/= corfu--index corfu--preselect)))
-
-(defun corfu--post-command ()
- "Refresh Corfu after last command."
- (remove-hook 'window-configuration-change-hook #'corfu-quit)
- (or (pcase completion-in-region--data
- (`(,beg ,end . ,_)
- (when (let ((pt (point)))
- (and (eq (marker-buffer beg) (current-buffer))
- (<= beg pt end)
- (save-excursion
- (goto-char beg)
- (<= (line-beginning-position) pt (line-end-position)))
- (or (not corfu-quit-at-boundary)
- (funcall completion-in-region-mode--predicate))))
- (corfu--update)
- t)))
- (corfu-quit)))
-
-(defun corfu--goto (index)
- "Go to candidate with INDEX."
- (setq corfu--index (max corfu--preselect (min index (1- corfu--total)))
- ;; Reset auto start in order to disable the `corfu-quit-no-match' timer
- corfu--auto-start nil))
-
-(defun corfu-next (&optional n)
- "Go forward N candidates."
- (interactive "p")
- (let ((index (+ corfu--index (or n 1))))
- (corfu--goto
- (cond
- ((not corfu-cycle) index)
- ((= corfu--total 0) -1)
- ((< corfu--preselect 0) (1- (mod (1+ index) (1+ corfu--total))))
- (t (mod index corfu--total))))))
-
-(defun corfu-previous (&optional n)
- "Go backward N candidates."
- (interactive "p")
- (corfu-next (- (or n 1))))
-
-(defun corfu-scroll-down (&optional n)
- "Go back by N pages."
- (interactive "p")
- (corfu--goto (max 0 (- corfu--index (* (or n 1) corfu-count)))))
-
-(defun corfu-scroll-up (&optional n)
- "Go forward by N pages."
- (interactive "p")
- (corfu-scroll-down (- (or n 1))))
-
-(defun corfu-first ()
- "Go to first candidate, or to the prompt when the first candidate is selected."
- (interactive)
- (corfu--goto (if (> corfu--index 0) 0 -1)))
-
-(defun corfu-last ()
- "Go to last candidate."
- (interactive)
- (corfu--goto (1- corfu--total)))
-
-(defun corfu--restore-on-next-command ()
- "Restore window configuration before next command."
- (let ((config (current-window-configuration))
- (other other-window-scroll-buffer)
- (restore (make-symbol "corfu--restore")))
- (fset restore
- (lambda ()
- (when (memq this-command '(corfu-quit corfu-reset))
- (setq this-command #'ignore))
- (remove-hook 'pre-command-hook restore)
- (setq other-window-scroll-buffer other)
- (set-window-configuration config)))
- (add-hook 'pre-command-hook restore)))
-
-;; Company support, taken from `company.el', see `company-show-doc-buffer'.
-(defun corfu-show-documentation ()
- "Show documentation of current candidate."
- (interactive)
- (when (< corfu--index 0)
- (user-error "No candidate selected"))
- (if-let* ((fun (plist-get corfu--extra :company-doc-buffer))
- (res (funcall fun (nth corfu--index corfu--candidates))))
- (let ((buf (or (car-safe res) res)))
- (corfu--restore-on-next-command)
- (setq other-window-scroll-buffer (get-buffer buf))
- (set-window-start (display-buffer buf t) (or (cdr-safe res) (point-min))))
- (user-error "No documentation available")))
-
-;; Company support, taken from `company.el', see `company-show-location'.
-(defun corfu-show-location ()
- "Show location of current candidate."
- (interactive)
- (when (< corfu--index 0)
- (user-error "No candidate selected"))
- (if-let* ((fun (plist-get corfu--extra :company-location))
- (loc (funcall fun (nth corfu--index corfu--candidates))))
- (let ((buf (or (and (bufferp (car loc)) (car loc)) (find-file-noselect (car loc) t))))
- (corfu--restore-on-next-command)
- (setq other-window-scroll-buffer buf)
- (with-selected-window (display-buffer buf t)
- (save-restriction
- (widen)
- (if (bufferp (car loc))
- (goto-char (cdr loc))
- (goto-char (point-min))
- (forward-line (1- (cdr loc))))
- (set-window-start nil (point)))))
- (user-error "No candidate location available")))
-
-(defun corfu-complete ()
- "Try to complete current input."
- (interactive)
- (pcase-let ((`(,beg ,end ,table ,pred) completion-in-region--data))
- (if completion-cycling
- ;; Proceed with cycling
- (let ((completion-extra-properties corfu--extra))
- (corfu--completion-in-region beg end table pred))
- (if (>= corfu--index 0)
- ;; Continue completion with selected candidate
- (corfu--insert nil)
- ;; Try to complete the current input string
- (let* ((pt (max 0 (- (point) beg)))
- (str (buffer-substring-no-properties beg end))
- (metadata (completion-metadata (substring str 0 pt) table pred)))
- (pcase (completion-try-completion str table pred pt metadata)
- (`(,newstr . ,newpt)
- (completion--replace beg end newstr)
- (goto-char (+ beg newpt))))))
- ;; No further completion is possible and the current string is a valid
- ;; match, exit with status 'finished.
- (let* ((pt (max 0 (- (point) beg)))
- (str (buffer-substring-no-properties beg end))
- (metadata (completion-metadata (substring str 0 pt) table pred)))
- (when (and (not (consp (completion-try-completion str table pred pt metadata)))
- (test-completion str table pred))
- (corfu--done str 'finished))))))
-
-(defun corfu--insert (status)
- "Insert current candidate, exit with STATUS if non-nil."
- (pcase-let* ((`(,beg ,end ,table ,pred) completion-in-region--data)
- (str (buffer-substring-no-properties beg end)))
- ;; Replace if candidate is selected or if current input is not valid completion.
- ;; For example str can be a valid path, e.g., ~/dir/.
- (when (or (>= corfu--index 0) (equal str "")
- (not (test-completion str table pred)))
- ;; XXX There is a small bug here, depending on interpretation.
- ;; When completing "~/emacs/master/li|/calc" where "|" is the
- ;; cursor, then the candidate only includes the prefix
- ;; "~/emacs/master/lisp/", but not the suffix "/calc". Default
- ;; completion has the same problem when selecting in the
- ;; *Completions* buffer. See bug#48356.
- (setq str (concat (substring str 0 corfu--base)
- (substring-no-properties (nth (max 0 corfu--index) corfu--candidates))))
- (completion--replace beg end str)
- (corfu--goto -1)) ;; Reset selection, but continue completion.
- (when status (corfu--done str status)))) ;; Exit with status
-
-(defun corfu--done (str status)
- "Call the `:exit-function' with STR and STATUS and exit completion."
- (let ((exit (plist-get corfu--extra :exit-function)))
- ;; For successfull completions, amalgamate undo operations,
- ;; such that completion can be undone in a single step.
- (undo-amalgamate-change-group corfu--change-group)
- (corfu-quit)
- ;; XXX Is the :exit-function handling sufficient?
- (when exit (funcall exit str status))))
-
-(defun corfu-insert ()
- "Insert current candidate."
- (interactive)
- (if (> corfu--total 0)
- (corfu--insert 'finished)
- (corfu-quit)))
-
-(defun corfu--setup ()
- "Setup Corfu completion state."
- (setq corfu--extra completion-extra-properties)
- (activate-change-group (setq corfu--change-group (prepare-change-group)))
- (setcdr (assq #'completion-in-region-mode minor-mode-overriding-map-alist) corfu-map)
- (add-hook 'pre-command-hook #'corfu--pre-command nil 'local)
- (add-hook 'post-command-hook #'corfu--post-command nil 'local)
- ;; Disable default post-command handling, since we have our own
- ;; checks in `corfu--post-command'.
- (remove-hook 'post-command-hook #'completion-in-region--postch)
- (let ((sym (make-symbol "corfu--teardown"))
- (buf (current-buffer)))
- (fset sym (lambda ()
- ;; Ensure that the teardown runs in the correct buffer, if still alive.
- (unless completion-in-region-mode
- (remove-hook 'completion-in-region-mode-hook sym)
- (with-current-buffer (if (buffer-live-p buf) buf (current-buffer))
- (corfu--teardown)))))
- (add-hook 'completion-in-region-mode-hook sym)))
-
-(defun corfu--teardown ()
- "Teardown Corfu."
- ;; Redisplay such that the input becomes immediately visible before the popup
- ;; hiding, which is slow (Issue #48). See also corresponding vertico#89.
- (redisplay)
- (corfu--popup-hide)
- (remove-hook 'window-configuration-change-hook #'corfu-quit)
- (remove-hook 'pre-command-hook #'corfu--pre-command 'local)
- (remove-hook 'post-command-hook #'corfu--post-command 'local)
- (when corfu--preview-ov (delete-overlay corfu--preview-ov))
- (when corfu--echo-timer (cancel-timer corfu--echo-timer))
- (when corfu--echo-message (corfu--echo-show ""))
- (accept-change-group corfu--change-group)
- (mapc #'kill-local-variable corfu--state-vars))
-
-(defun corfu--completion-message (msg)
- "Print completion MSG, do not hang like `completion--message'."
- (when (and completion-show-inline-help
- (member msg '("No match" "Sole completion")))
- (message msg)))
-
-(defun corfu--all-sorted-completions (&optional beg end)
- "Compute all sorted completions for string between BEG and END."
- (or completion-all-sorted-completions
- (pcase-let ((`(,base ,all . ,_) (corfu--recompute-candidates
- (buffer-substring-no-properties beg end)
- (max 0 (- (point) beg))
- minibuffer-completion-table
- minibuffer-completion-predicate)))
- (when all
- (completion--cache-all-sorted-completions
- beg end (nconc all base))))))
-
-(defun corfu--completion-in-region (&rest args)
- "Corfu completion in region function passing ARGS to `completion--in-region'."
- (barf-if-buffer-read-only)
- (if (not (display-graphic-p))
- ;; XXX Warning this can result in an endless loop when `completion-in-region-function'
- ;; is set *globally* to `corfu--completion-in-region'. This should never happen.
- (apply (default-value 'completion-in-region-function) args)
- ;; Restart the completion. This can happen for example if C-M-/
- ;; (`dabbrev-completion') is pressed while the Corfu popup is already open.
- (when (and completion-in-region-mode (not completion-cycling))
- (corfu-quit))
- (prog1
- (cl-letf* ((completion-auto-help nil)
- ;; Set the predicate to ensure that `completion-in-region-mode' is enabled.
- (completion-in-region-mode-predicate
- (or completion-in-region-mode-predicate (lambda () t)))
- ;; Overwrite to avoid hanging.
- ((symbol-function #'completion--message)
- #'corfu--completion-message)
- ;; Overwrite for performance and consistency.
- ((symbol-function #'completion-all-sorted-completions)
- #'corfu--all-sorted-completions))
- (apply #'completion--in-region args))
- (when (and completion-in-region-mode
- ;; Do not show Corfu when "trivially" cycling, i.e.,
- ;; when the completion is finished after the candidate.
- (not (and completion-cycling
- (pcase-let* ((`(,beg ,end ,table ,pred) completion-in-region--data)
- (pt (max 0 (- (point) beg)))
- (str (buffer-substring-no-properties beg end))
- (before (substring str 0 pt))
- (after (substring str pt)))
- (equal (completion-boundaries before table pred after) '(0 . 0))))))
- (corfu--setup)))))
-
-(defun corfu--auto-complete (buffer)
- "Initiate auto completion after delay in BUFFER."
- (setq corfu--auto-timer nil)
- (when (and (not completion-in-region-mode)
- (eq (current-buffer) buffer))
- (pcase (run-hook-wrapped 'completion-at-point-functions
- #'completion--capf-wrapper 'all)
- ((and `(,fun ,beg ,end ,table . ,plist)
- (guard (integer-or-marker-p beg))
- (guard (<= beg (point) end))
- (guard
- (let ((len (or (plist-get plist :company-prefix-length) (- (point) beg))))
- (or (eq len t) (>= len corfu-auto-prefix)))))
- (let ((completion-extra-properties plist)
- (completion-in-region-mode-predicate
- (lambda () (eq beg (car-safe (funcall fun))))))
- (setq completion-in-region--data `(,(copy-marker beg) ,(copy-marker end t)
- ,table ,(plist-get plist :predicate))
- corfu--auto-start (float-time))
- (undo-boundary) ;; Necessary to support `corfu-reset'
- (completion-in-region-mode 1)
- (corfu--setup)
- (corfu--update))))))
-
-(defun corfu--auto-post-command ()
- "Post command hook which initiates auto completion."
- (when corfu--auto-timer
- (cancel-timer corfu--auto-timer)
- (setq corfu--auto-timer nil))
- (when (and (not completion-in-region-mode)
- (corfu--match-symbol-p corfu-auto-commands this-command)
- (display-graphic-p))
- ;; NOTE: Do not use idle timer since this leads to unacceptable slowdowns,
- ;; in particular if flyspell-mode is enabled.
- (setq corfu--auto-timer (run-at-time corfu-auto-delay nil
- #'corfu--auto-complete
- (current-buffer)))))
-
-;;;###autoload
-(define-minor-mode corfu-mode
- "Completion Overlay Region FUnction"
- :global nil :group 'corfu
- (cond
- (corfu-mode
- ;; FIXME: Install advice which fixes `completion--capf-wrapper', such that
- ;; it respects the completion styles for non-exclusive capfs. See FIXME in
- ;; the `completion--capf-wrapper' function in minibuffer.el, where the
- ;; issue has been mentioned. We never uninstall this advice since the
- ;; advice is active *globally*.
- (advice-add #'completion--capf-wrapper :around #'corfu--capf-wrapper-advice)
- (advice-add #'eldoc-display-message-no-interference-p :before-while #'corfu--allow-eldoc)
- (and corfu-auto (add-hook 'post-command-hook #'corfu--auto-post-command nil 'local))
- (setq-local completion-in-region-function #'corfu--completion-in-region))
- (t
- (remove-hook 'post-command-hook #'corfu--auto-post-command 'local)
- (kill-local-variable 'completion-in-region-function))))
-
-(defun corfu--capf-wrapper-advice (orig fun which)
- "Around advice for `completion--capf-wrapper'.
-The ORIG function takes the FUN and WHICH arguments."
- (if corfu-mode ;; Only enable the advice when Corfu is active
- (let ((res (funcall fun)))
- (when (and (consp res) (integer-or-marker-p (car res)) ;; Valid capf result
- (pcase-let ((`(,beg ,end ,table . ,plist) res))
- (and (<= beg (point) end) ;; Sanity checking
- ;; For non-exclusive capfs, check for valid completion.
- (or (not (eq 'no (plist-get plist :exclusive)))
- (let* ((str (buffer-substring-no-properties beg end))
- (pt (- (point) beg))
- (pred (plist-get plist :predicate))
- (md (completion-metadata (substring str 0 pt) table pred)))
- (completion-try-completion str table pred pt md))))))
- (cons fun res)))
- (funcall orig fun which)))
-
-;;;###autoload
-(define-globalized-minor-mode corfu-global-mode corfu-mode corfu--on :group 'corfu)
-
-(defun corfu--on ()
- "Turn `corfu-mode' on."
- (unless (or noninteractive
- (eq (aref (buffer-name) 0) ?\s)
- (memq major-mode corfu-excluded-modes))
- (corfu-mode 1)))
-
-(defun corfu--allow-eldoc ()
- "Return non-nil if Corfu is currently not active."
- (not (and corfu-mode completion-in-region-mode)))
-
-;; Emacs 28: Do not show Corfu commands with M-X
-(dolist (sym '(corfu-next corfu-previous corfu-first corfu-last corfu-quit corfu-reset
- corfu-complete corfu-insert corfu-scroll-up corfu-scroll-down
- corfu-show-location corfu-show-documentation))
- (put sym 'completion-predicate #'ignore))
-
-(provide 'corfu)
-;;; corfu.el ends here
diff --git a/elpa/corfu-0.16/corfu.elc b/elpa/corfu-0.16/corfu.elc
Binary files differ.
diff --git a/elpa/corfu-0.16/corfu.info b/elpa/corfu-0.16/corfu.info
@@ -1,305 +0,0 @@
-This is corfu.info, produced by makeinfo version 6.7 from corfu.texi.
-
-INFO-DIR-SECTION Emacs
-START-INFO-DIR-ENTRY
-* Corfu: (corfu). Completion Overlay Region FUnction.
-END-INFO-DIR-ENTRY
-
-
-File: corfu.info, Node: Top, Next: Introduction, Up: (dir)
-
-corfu.el - Completion Overlay Region FUnction
-*********************************************
-
-* Menu:
-
-* Introduction::
-* Features::
-* Installation and Configuration::
-* Key bindings::
-* Complementary packages::
-* Caveats::
-* Contributions::
-
-— The Detailed Node Listing —
-
-Installation and Configuration
-
-* TAB-and-Go completion::
-
-
-
-File: corfu.info, Node: Introduction, Next: Features, Prev: Top, Up: Top
-
-1 Introduction
-**************
-
-Corfu enhances the default completion in region function with a
-completion overlay. The current candidates are shown in a popup below
-or above the point. Corfu is the minimalistic ‘completion-in-region’
-counterpart of the Vertico (https://github.com/minad/vertico) minibuffer
-UI.
-
- Corfu is a minimal package, which relies on the Emacs completion
-facilities and concentrates on providing a polished completion UI.
-Completions are either provided by commands like ‘dabbrev-completion’ or
-by pluggable backends (‘completion-at-point-functions’, Capfs). Most
-programming language major modes implement a Capf. Furthermore the
-language server packages, Eglot (https://github.com/joaotavora/eglot)
-and Lsp-mode (https://github.com/emacs-lsp/lsp-mode), both use Capfs
-which talk to the LSP server to retrieve the completions.
-
- Corfu does not include custom completion backends. In contrast, the
-complex Company package includes custom completion backends, which
-deviate from the Emacs completion infrastructure. The Emacs built-in
-Capfs are mostly sufficient, but a few additional Capfs and completion
-functions are provided by the Cape (https://github.com/minad/cape)
-package.
-
- *NOTE*: Corfu uses child frames to show the popup; on non-graphical
-displays it will fall back to the default setting of the
-‘completion-in-region-function’.
-
- <https://github.com/minad/corfu/blob/screenshots/light.png?raw=true>
-
- <https://github.com/minad/corfu/blob/screenshots/dark.png?raw=true>
-
-
-File: corfu.info, Node: Features, Next: Installation and Configuration, Prev: Introduction, Up: Top
-
-2 Features
-**********
-
- • Timer-based auto-completions (_off_ by default, set ‘corfu-auto’).
- • Popup display with scrollbar indicator and arrow key navigation.
- • The popup can be summoned explicitly by pressing ‘TAB’ at any time.
- • The current candidate is inserted with ‘TAB’ and selected with
- ‘RET’.
- • Candidates sorting by prefix, string length and alphabetically.
- • The selected candidate is previewed (configuable via
- ‘corfu-preview-current’).
- • The selected candidate automatically committed on further input by
- default (configurable via ‘corfu-commit-predicate’).
- • The Orderless (https://github.com/oantolin/orderless) completion
- style is supported. The filter string can contain arbitrary
- characters, including spaces, if ‘corfu-quit-at-boundary’ is nil.
- • Deferred completion style highlighting for performance.
- • Jumping to location/documentation of current candidate.
- • Show candidate documentation/signature string in the echo area.
- • Deprecated candidates are crossed out in the display.
- • Support for annotations (‘annotation-function’,
- ‘affixation-function’).
- • Icons can be provided by an external package via margin formatter
- functions.
-
-
-File: corfu.info, Node: Installation and Configuration, Next: Key bindings, Prev: Features, Up: Top
-
-3 Installation and Configuration
-********************************
-
-Corfu is available from GNU ELPA
-(http://elpa.gnu.org/packages/corfu.html), such that it can be installed
-directly via ‘package-install’. After installation, the global minor
-mode can be enabled with ‘M-x corfu-global-mode’. In order to configure
-Corfu and other packages in your init.el, you may want to use
-‘use-package’.
-
- Corfu is highly flexible and customizable via ‘corfu-*’ customization
-variables. For filtering I recommend to give Orderless completion a
-try, which is different from the familiar prefix TAB completion. Corfu
-can be used with the default completion styles, the use of Orderless is
-not a necessity. See also the Corfu Wiki
-(https://github.com/minad/corfu/wiki) for additional configuration tips.
-In particular the Lsp-mode configuration is documented in the Wiki.
-
- Here is an example configuration:
-
- (use-package corfu
- ;; Optional customizations
- ;; :custom
- ;; (corfu-cycle t) ;; Enable cycling for `corfu-next/previous'
- ;; (corfu-auto t) ;; Enable auto completion
- ;; (corfu-commit-predicate nil) ;; Do not commit selected candidates on next input
- ;; (corfu-quit-at-boundary t) ;; Automatically quit at word boundary
- ;; (corfu-quit-no-match t) ;; Automatically quit if there is no match
- ;; (corfu-preview-current nil) ;; Disable current candidate preview
- ;; (corfu-preselect-first nil) ;; Disable candidate preselection
- ;; (corfu-echo-documentation nil) ;; Disable documentation in the echo area
- ;; (corfu-scroll-margin 5) ;; Use scroll margin
-
- ;; You may want to enable Corfu only for certain modes.
- ;; :hook ((prog-mode . corfu-mode)
- ;; (shell-mode . corfu-mode)
- ;; (eshell-mode . corfu-mode))
-
- ;; Recommended: Enable Corfu globally.
- ;; This is recommended since dabbrev can be used globally (M-/).
- :init
- (corfu-global-mode))
-
- ;; Optionally use the `orderless' completion style. See `+orderless-dispatch'
- ;; in the Consult wiki for an advanced Orderless style dispatcher.
- ;; Enable `partial-completion' for files to allow path expansion.
- ;; You may prefer to use `initials' instead of `partial-completion'.
- (use-package orderless
- :init
- ;; Configure a custom style dispatcher (see the Consult wiki)
- ;; (setq orderless-style-dispatchers '(+orderless-dispatch)
- ;; orderless-component-separator #'orderless-escapable-split-on-space)
- (setq completion-styles '(orderless)
- completion-category-defaults nil
- completion-category-overrides '((file (styles . (partial-completion))))))
-
- ;; Use dabbrev with Corfu!
- (use-package dabbrev
- ;; Swap M-/ and C-M-/
- :bind (("M-/" . dabbrev-completion)
- ("C-M-/" . dabbrev-expand)))
-
- ;; A few more useful configurations...
- (use-package emacs
- :init
- ;; TAB cycle if there are only few candidates
- (setq completion-cycle-threshold 3)
-
- ;; Emacs 28: Hide commands in M-x which do not apply to the current mode.
- ;; Corfu commands are hidden, since they are not supposed to be used via M-x.
- ;; (setq read-extended-command-predicate
- ;; #'command-completion-default-include-p)
-
- ;; Enable indentation+completion using the TAB key.
- ;; `completion-at-point' is often bound to M-TAB.
- (setq tab-always-indent 'complete))
-
-* Menu:
-
-* TAB-and-Go completion::
-
-
-File: corfu.info, Node: TAB-and-Go completion, Up: Installation and Configuration
-
-3.1 TAB-and-Go completion
-=========================
-
-You may be interested in configuring Corfu in TAB-and-Go style.
-Pressing TAB moves to the next candidate and further input will then
-commit the selection.
-
- (use-package corfu
- ;; TAB-and-Go customizations
- :custom
- (corfu-cycle t) ;; Enable cycling for `corfu-next/previous'
- (corfu-preselect-first nil) ;; Disable candidate preselection
-
- ;; Use TAB for cycling, default is `corfu-complete'.
- :bind
- (:map corfu-map
- ("TAB" . corfu-next)
- ([tab] . corfu-next)
- ("S-TAB" . corfu-previous)
- ([backtab] . corfu-previous))
-
- :init
- (corfu-global-mode))
-
-
-File: corfu.info, Node: Key bindings, Next: Complementary packages, Prev: Installation and Configuration, Up: Top
-
-4 Key bindings
-**************
-
-Corfu uses a transient keymap ‘corfu-map’ which is active while the
-popup is shown. The keymap defines the following remappings and
-bindings:
-
- • ‘beginning-of-buffer’ -> ‘corfu-first’
- • ‘end-of-buffer’ -> ‘corfu-last’
- • ‘scroll-down-command’ -> ‘corfu-scroll-down’
- • ‘scroll-up-command’ -> ‘corfu-scroll-up’
- • ‘next-line’, ‘down’, ‘M-n’ -> ‘corfu-next’
- • ‘previous-line’, ‘up’, ‘M-p’ -> ‘corfu-previous’
- • ‘completion-at-point’, ‘TAB’ -> ‘corfu-complete’
- • ‘RET’ -> ‘corfu-insert’
- • ‘M-g’ -> ‘corfu-show-location’
- • ‘M-h’ -> ‘corfu-show-documentation’
- • ‘C-g’ -> ‘corfu-quit’
- • ‘keyboard-escape-quit’ -> ‘corfu-reset’
-
-
-File: corfu.info, Node: Complementary packages, Next: Caveats, Prev: Key bindings, Up: Top
-
-5 Complementary packages
-************************
-
-Corfu works well together with all packages providing code completion
-via the ‘completion-at-point-functions’. Furthermore it supports
-completion styles, including the advanced Orderless
-(https://github.com/oantolin/orderless) completion style, where the
-filtering expressions are separated by spaces (see
-‘corfu-quit-at-boundary’).
-
- I collect additional Capf backends and ‘completion-in-region’
-commands in my small Cape (https://github.com/minad/cape) package. For
-example the package provides a file name and a dabbrev completion
-backend.
-
- Icons are supported by Corfu via an external package. For example
-the kind-icon (https://github.com/jdtsmith/kind-icon) package provides
-beautifully styled SVG icons based on monochromatic icon sets like
-material design.
-
- You may also want to look into my Vertico
-(https://github.com/minad/vertico) package. Vertico is the minibuffer
-counterpart of Corfu.
-
-
-File: corfu.info, Node: Caveats, Next: Contributions, Prev: Complementary packages, Up: Top
-
-6 Caveats
-*********
-
-Corfu is robust in most scenarios. There are a few known technical
-caveats.
-
- • Corfu falls back to the default Completion buffer on non-graphical
- displays, since Corfu requires child frames.
- • No sorting by history, since ‘completion-at-point’ does not
- maintain a history (See branch ‘history’ for a possible solution).
- • There is currently no equivalent for ‘company-quickhelp’.
- Documentation and source can be opened manually in a separate
- buffer.
- • Company has the ability to merge/group the candidates of multiple
- backends in some scenarios. This feature is implemented by the
- function ‘cape-super-capf’ of the Cape
- (https://github.com/minad/cape) package.
-
-
-File: corfu.info, Node: Contributions, Prev: Caveats, Up: Top
-
-7 Contributions
-***************
-
-Since this package is part of GNU ELPA
-(http://elpa.gnu.org/packages/corfu.html) contributions require a
-copyright assignment to the FSF.
-
-
-
-Tag Table:
-Node: Top195
-Node: Introduction597
-Node: Features2215
-Node: Installation and Configuration3619
-Node: TAB-and-Go completion7339
-Node: Key bindings8149
-Node: Complementary packages9101
-Node: Caveats10175
-Node: Contributions11030
-
-End Tag Table
-
-
-Local Variables:
-coding: utf-8
-End:
diff --git a/elpa/corfu-0.16/dir b/elpa/corfu-0.16/dir
@@ -1,18 +0,0 @@
-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
-* Corfu: (corfu). Completion Overlay Region FUnction.
diff --git a/elpa/eglot-1.7/eglot-autoloads.el b/elpa/eglot-1.7/eglot-autoloads.el
@@ -1,56 +0,0 @@
-;;; eglot-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-
-;;;### (autoloads nil "eglot" "eglot.el" (0 0 0 0))
-;;; Generated autoloads from eglot.el
-
-(autoload 'eglot "eglot" "\
-Manage a project with a Language Server Protocol (LSP) server.
-
-The LSP server of CLASS started (or contacted) via CONTACT. If
-this operation is successful, current *and future* file buffers
-of MANAGED-MAJOR-MODE inside PROJECT automatically become
-\"managed\" by the LSP server, meaning information about their
-contents is exchanged periodically to provide enhanced
-code-analysis via `xref-find-definitions', `flymake-mode',
-`eldoc-mode', `completion-at-point', among others.
-
-Interactively, the command attempts to guess MANAGED-MAJOR-MODE
-from current buffer, CLASS and CONTACT from
-`eglot-server-programs' and PROJECT from `project-current'. If
-it can't guess, the user is prompted. With a single
-\\[universal-argument] prefix arg, it always prompt for COMMAND.
-With two \\[universal-argument] prefix args, also prompts for
-MANAGED-MAJOR-MODE.
-
-PROJECT is a project instance as returned by `project-current'.
-
-CLASS is a subclass of symbol `eglot-lsp-server'.
-
-CONTACT specifies how to contact the server. It is a
-keyword-value plist used to initialize CLASS or a plain list as
-described in `eglot-server-programs', which see.
-
-INTERACTIVE is t if called interactively.
-
-\(fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT &optional INTERACTIVE)" t nil)
-
-(autoload 'eglot-ensure "eglot" "\
-Start Eglot session for current buffer if there isn't one." nil nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eglot" '("eglot-")))
-
-;;;***
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; eglot-autoloads.el ends here
diff --git a/elpa/eglot-1.7/eglot-pkg.el b/elpa/eglot-1.7/eglot-pkg.el
@@ -1,2 +0,0 @@
-;;; Generated package description from eglot.el -*- no-byte-compile: t -*-
-(define-package "eglot" "1.7" "Client for Language Server Protocol (LSP) servers" '((emacs "26.1") (jsonrpc "1.0.14") (flymake "1.0.9") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0")) :commit "4edd4782f1c16c0516533b52e16b02b772812d16" :authors '(("João Távora" . "joaotavora@gmail.com")) :maintainer '("João Távora" . "joaotavora@gmail.com") :keywords '("convenience" "languages") :url "https://github.com/joaotavora/eglot")
diff --git a/elpa/eglot-1.7/eglot.el b/elpa/eglot-1.7/eglot.el
@@ -1,2753 +0,0 @@
-;;; eglot.el --- Client for Language Server Protocol (LSP) servers -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
-
-;; Version: 1.7
-;; Package-Version: 1.7
-;; Package-Commit: 4edd4782f1c16c0516533b52e16b02b772812d16
-;; Author: João Távora <joaotavora@gmail.com>
-;; Maintainer: João Távora <joaotavora@gmail.com>
-;; URL: https://github.com/joaotavora/eglot
-;; Keywords: convenience, languages
-;; Package-Requires: ((emacs "26.1") (jsonrpc "1.0.14") (flymake "1.0.9") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0"))
-
-;; 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:
-
-;; Simply M-x eglot should be enough to get you started, but here's a
-;; little info (see the accompanying README.md or the URL for more).
-;;
-;; M-x eglot starts a server via a shell-command guessed from
-;; `eglot-server-programs', using the current major-mode (for whatever
-;; language you're programming in) as a hint. If it can't guess, it
-;; prompts you in the mini-buffer for these things. Actually, the
-;; server needen't be locally started: you can connect to a running
-;; server via TCP by entering a <host:port> syntax.
-;;
-;; Anyway, if the connection is successful, you should see an `eglot'
-;; indicator pop up in your mode-line. More importantly, this means
-;; current *and future* file buffers of that major mode *inside your
-;; current project* automatically become \"managed\" by the LSP
-;; server, i.e. information about their contents is exchanged
-;; periodically to provide enhanced code analysis via
-;; `xref-find-definitions', `flymake-mode', `eldoc-mode',
-;; `completion-at-point', among others.
-;;
-;; To "unmanage" these buffers, shutdown the server with M-x
-;; eglot-shutdown.
-;;
-;; You can also do:
-;;
-;; (add-hook 'foo-mode-hook 'eglot-ensure)
-;;
-;; To attempt to start an eglot session automatically everytime a
-;; foo-mode buffer is visited.
-;;
-;;; Code:
-
-(require 'json)
-(require 'imenu)
-(require 'cl-lib)
-(require 'project)
-(require 'url-parse)
-(require 'url-util)
-(require 'pcase)
-(require 'compile) ; for some faces
-(require 'warnings)
-(require 'flymake)
-(require 'xref)
-(eval-when-compile
- (require 'subr-x))
-(require 'jsonrpc)
-(require 'filenotify)
-(require 'ert)
-(require 'array)
-
-;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are
-;; using the latest version from GNU Elpa when we load eglot.el. Use an
-;; heuristic to see if we need to `load' it in Emacs < 28.
-(if (and (< emacs-major-version 28)
- (not (boundp 'eldoc-documentation-strategy)))
- (load "eldoc")
- (require 'eldoc))
-
-;; forward-declare, but don't require (Emacs 28 doesn't seem to care)
-(defvar markdown-fontify-code-blocks-natively)
-(defvar company-backends)
-(defvar company-tooltip-align-annotations)
-
-
-
-;;; User tweakable stuff
-(defgroup eglot nil
- "Interaction with Language Server Protocol servers"
- :prefix "eglot-"
- :group 'applications)
-
-(defvar eglot-server-programs '((rust-mode . (eglot-rls "rls"))
- (python-mode . ("pyls"))
- ((js-mode
- typescript-mode)
- . ("javascript-typescript-stdio"))
- (sh-mode . ("bash-language-server" "start"))
- (php-mode
- . ("php" "vendor/felixfbecker/\
-language-server/bin/php-language-server.php"))
- ((c++-mode c-mode) . ("ccls"))
- ((caml-mode tuareg-mode reason-mode)
- . ("ocaml-language-server" "--stdio"))
- (ruby-mode
- . ("solargraph" "socket" "--port" :autoport))
- (haskell-mode
- . ("haskell-language-server-wrapper" "--lsp"))
- (elm-mode . ("elm-language-server"))
- (kotlin-mode . ("kotlin-language-server"))
- (go-mode . ("gopls"))
- ((R-mode ess-r-mode) . ("R" "--slave" "-e"
- "languageserver::run()"))
- (java-mode . eglot--eclipse-jdt-contact)
- (dart-mode . ("dart_language_server"))
- (elixir-mode . ("language_server.sh"))
- (ada-mode . ("ada_language_server"))
- (scala-mode . ("metals-emacs"))
- ((tex-mode context-mode texinfo-mode bibtex-mode)
- . ("digestif"))
- (erlang-mode . ("erlang_ls" "--transport" "stdio"))
- (gdscript-mode . ("localhost" 6008)))
- "How the command `eglot' guesses the server to start.
-An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
-is a mode symbol, or a list of mode symbols. The associated
-CONTACT specifies how to connect to a server for managing buffers
-of those modes. CONTACT can be:
-
-* In the most common case, a list of strings (PROGRAM [ARGS...]).
- PROGRAM is called with ARGS and is expected to serve LSP requests
- over the standard input/output channels.
-
-* A list (HOST PORT [TCP-ARGS...]) where HOST is a string and
- PORT is a positive integer for connecting to a server via TCP.
- Remaining ARGS are passed to `open-network-stream' for
- upgrading the connection with encryption or other capabilities.
-
-* A list (PROGRAM [ARGS...] :autoport [MOREARGS...]), whereupon a
- combination of the two previous options is used. First, an
- attempt is made to find an available server port, then PROGRAM
- is launched with ARGS; the `:autoport' keyword substituted for
- that number; and MOREARGS. Eglot then attempts to establish a
- TCP connection to that port number on the localhost.
-
-* A cons (CLASS-NAME . INITARGS) where CLASS-NAME is a symbol
- designating a subclass of `eglot-lsp-server', for representing
- experimental LSP servers. INITARGS is a keyword-value plist
- used to initialize the object of CLASS-NAME, or a plain list
- interpreted as the previous descriptions of CONTACT. In the
- latter case that plain list is used to produce a plist with a
- suitable :PROCESS initarg to CLASS-NAME. The class
- `eglot-lsp-server' descends from `jsonrpc-process-connection',
- which you should see for the semantics of the mandatory
- :PROCESS argument.
-
-* A function of a single argument producing any of the above
- values for CONTACT. The argument's value is non-nil if the
- connection was requested interactively (e.g. from the `eglot'
- command), and nil if it wasn't (e.g. from `eglot-ensure'). If
- the call is interactive, the function can ask the user for
- hints on finding the required programs, etc. Otherwise, it
- should not ask the user for any input, and return nil or signal
- an error if it can't produce a valid CONTACT.")
-
-(defface eglot-mode-line
- '((t (:inherit font-lock-constant-face :weight bold)))
- "Face for package-name in EGLOT's mode line.")
-
-(defcustom eglot-autoreconnect 3
- "Control ability to reconnect automatically to the LSP server.
-If t, always reconnect automatically (not recommended). If nil,
-never reconnect automatically after unexpected server shutdowns,
-crashes or network failures. A positive integer number says to
-only autoreconnect if the previous successful connection attempt
-lasted more than that many seconds."
- :type '(choice (boolean :tag "Whether to inhibit autoreconnection")
- (integer :tag "Number of seconds")))
-
-(defcustom eglot-connect-timeout 30
- "Number of seconds before timing out LSP connection attempts.
-If nil, never time out."
- :type 'number)
-
-(defcustom eglot-sync-connect 3
- "Control blocking of LSP connection attempts.
-If t, block for `eglot-connect-timeout' seconds. A positive
-integer number means block for that many seconds, and then wait
-for the connection in the background. nil has the same meaning
-as 0, i.e. don't block at all."
- :type '(choice (boolean :tag "Whether to inhibit autoreconnection")
- (integer :tag "Number of seconds")))
-
-(defcustom eglot-autoshutdown nil
- "If non-nil, shut down server after killing last managed buffer."
- :type 'boolean)
-
-(defcustom eglot-send-changes-idle-time 0.5
- "Don't tell server of changes before Emacs's been idle for this many seconds."
- :type 'number)
-
-(defcustom eglot-events-buffer-size 2000000
- "Control the size of the Eglot events buffer.
-If a number, don't let the buffer grow larger than that many
-characters. If 0, don't use an event's buffer at all. If nil,
-let the buffer grow forever."
- :type '(choice (const :tag "No limit" nil)
- (integer :tag "Number of characters")))
-
-(defcustom eglot-confirm-server-initiated-edits 'confirm
- "Non-nil if server-initiated edits should be confirmed with user."
- :type '(choice (const :tag "Don't show confirmation prompt" nil)
- (symbol :tag "Show confirmation prompt" 'confirm)))
-
-
-;;; Constants
-;;;
-(defconst eglot--symbol-kind-names
- `((1 . "File") (2 . "Module")
- (3 . "Namespace") (4 . "Package") (5 . "Class")
- (6 . "Method") (7 . "Property") (8 . "Field")
- (9 . "Constructor") (10 . "Enum") (11 . "Interface")
- (12 . "Function") (13 . "Variable") (14 . "Constant")
- (15 . "String") (16 . "Number") (17 . "Boolean")
- (18 . "Array") (19 . "Object") (20 . "Key")
- (21 . "Null") (22 . "EnumMember") (23 . "Struct")
- (24 . "Event") (25 . "Operator") (26 . "TypeParameter")))
-
-(defconst eglot--kind-names
- `((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor")
- (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface")
- (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value")
- (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color")
- (17 . "File") (18 . "Reference")))
-
-(defconst eglot--{} (make-hash-table) "The empty JSON object.")
-
-
-
-;;; Message verification helpers
-;;;
-(eval-and-compile
- (defvar eglot--lsp-interface-alist
- `(
- (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred))
- (ConfigurationItem () (:scopeUri :section))
- (Command ((:title . string) (:command . string)) (:arguments))
- (CompletionItem (:label)
- (:kind :detail :documentation :deprecated :preselect
- :sortText :filterText :insertText :insertTextFormat
- :textEdit :additionalTextEdits :commitCharacters
- :command :data))
- (Diagnostic (:range :message) (:severity :code :source :relatedInformation))
- (DocumentHighlight (:range) (:kind))
- (FileSystemWatcher (:globPattern) (:kind))
- (Hover (:contents) (:range))
- (InitializeResult (:capabilities) (:serverInfo))
- (Location (:uri :range))
- (LogMessageParams (:type :message))
- (MarkupContent (:kind :value))
- (ParameterInformation (:label) (:documentation))
- (Position (:line :character))
- (Range (:start :end))
- (Registration (:id :method) (:registerOptions))
- (Registration (:id :method) (:registerOptions))
- (ResponseError (:code :message) (:data))
- (ShowMessageParams (:type :message))
- (ShowMessageRequestParams (:type :message) (:actions))
- (SignatureHelp (:signatures) (:activeSignature :activeParameter))
- (SignatureInformation (:label) (:documentation :parameters))
- (SymbolInformation (:name :kind :location)
- (:deprecated :containerName))
- (DocumentSymbol (:name :range :selectionRange :kind)
- ;; `:containerName' isn't really allowed , but
- ;; it simplifies the impl of `eglot-imenu'.
- (:detail :deprecated :children :containerName))
- (TextDocumentEdit (:textDocument :edits) ())
- (TextEdit (:range :newText))
- (VersionedTextDocumentIdentifier (:uri :version) ())
- (WorkspaceEdit () (:changes :documentChanges))
- )
- "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
-
-INTERFACE-NAME is a symbol designated by the spec as
-\"interface\". INTERFACE is a list (REQUIRED OPTIONAL) where
-REQUIRED and OPTIONAL are lists of KEYWORD designating field
-names that must be, or may be, respectively, present in a message
-adhering to that interface. KEY can be a keyword or a cons (SYM
-TYPE), where type is used by `cl-typep' to check types at
-runtime.
-
-Here's what an element of this alist might look like:
-
- (Command ((:title . string) (:command . string)) (:arguments))"))
-
-(eval-and-compile
- (defvar eglot-strict-mode (if load-file-name '()
- '(disallow-non-standard-keys
- ;; Uncomment these two for fun at
- ;; compile-time or with flymake-mode.
- ;;
- ;; enforce-required-keys
- ;; enforce-optional-keys
- ))
- "How strictly to check LSP interfaces at compile- and run-time.
-
-Value is a list of symbols (if the list is empty, no checks are
-performed).
-
-If the symbol `disallow-non-standard-keys' is present, an error
-is raised if any extraneous fields are sent by the server. At
-compile-time, a warning is raised if a destructuring spec
-includes such a field.
-
-If the symbol `enforce-required-keys' is present, an error is
-raised if any required fields are missing from the message sent
-from the server. At compile-time, a warning is raised if a
-destructuring spec doesn't use such a field.
-
-If the symbol `enforce-optional-keys' is present, nothing special
-happens at run-time. At compile-time, a warning is raised if a
-destructuring spec doesn't use all optional fields.
-
-If the symbol `disallow-unknown-methods' is present, Eglot warns
-on unknown notifications and errors on unknown requests.
-"))
-
-(defun eglot--plist-keys (plist)
- (cl-loop for (k _v) on plist by #'cddr collect k))
-
-(cl-defun eglot--check-object (interface-name
- object
- &optional
- (enforce-required t)
- (disallow-non-standard t)
- (check-types t))
- "Check that OBJECT conforms to INTERFACE. Error otherwise."
- (cl-destructuring-bind
- (&key types required-keys optional-keys &allow-other-keys)
- (eglot--interface interface-name)
- (when-let ((missing (and enforce-required
- (cl-set-difference required-keys
- (eglot--plist-keys object)))))
- (eglot--error "A `%s' must have %s" interface-name missing))
- (when-let ((excess (and disallow-non-standard
- (cl-set-difference
- (eglot--plist-keys object)
- (append required-keys optional-keys)))))
- (eglot--error "A `%s' mustn't have %s" interface-name excess))
- (when check-types
- (cl-loop
- for (k v) on object by #'cddr
- for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type?
- unless (cl-typep v type)
- do (eglot--error "A `%s' must have a %s as %s, but has %s"
- interface-name )))
- t))
-
-(eval-and-compile
- (defun eglot--keywordize-vars (vars)
- (mapcar (lambda (var) (intern (format ":%s" var))) vars))
-
- (defun eglot--ensure-type (k) (if (consp k) k (cons k t)))
-
- (defun eglot--interface (interface-name)
- (let* ((interface (assoc interface-name eglot--lsp-interface-alist))
- (required (mapcar #'eglot--ensure-type (car (cdr interface))))
- (optional (mapcar #'eglot--ensure-type (cadr (cdr interface)))))
- (list :types (append required optional)
- :required-keys (mapcar #'car required)
- :optional-keys (mapcar #'car optional))))
-
- (defun eglot--check-dspec (interface-name dspec)
- "Check destructuring spec DSPEC against INTERFACE-NAME."
- (cl-destructuring-bind (&key required-keys optional-keys &allow-other-keys)
- (eglot--interface interface-name)
- (cond ((or required-keys optional-keys)
- (let ((too-many
- (and
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- (cl-set-difference
- (eglot--keywordize-vars dspec)
- (append required-keys optional-keys))))
- (ignored-required
- (and
- (memq 'enforce-required-keys eglot-strict-mode)
- (cl-set-difference
- required-keys (eglot--keywordize-vars dspec))))
- (missing-out
- (and
- (memq 'enforce-optional-keys eglot-strict-mode)
- (cl-set-difference
- optional-keys (eglot--keywordize-vars dspec)))))
- (when too-many (byte-compile-warn
- "Destructuring for %s has extraneous %s"
- interface-name too-many))
- (when ignored-required (byte-compile-warn
- "Destructuring for %s ignores required %s"
- interface-name ignored-required))
- (when missing-out (byte-compile-warn
- "Destructuring for %s is missing out on %s"
- interface-name missing-out))))
- (t
- (byte-compile-warn "Unknown LSP interface %s" interface-name))))))
-
-(cl-defmacro eglot--dbind (vars object &body body)
- "Destructure OBJECT, binding VARS in BODY.
-VARS is ([(INTERFACE)] SYMS...)
-Honour `eglot-strict-mode'."
- (declare (indent 2) (debug (sexp sexp &rest form)))
- (let ((interface-name (if (consp (car vars))
- (car (pop vars))))
- (object-once (make-symbol "object-once"))
- (fn-once (make-symbol "fn-once")))
- (cond (interface-name
- (eglot--check-dspec interface-name vars)
- `(let ((,object-once ,object))
- (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
- (eglot--check-object ',interface-name ,object-once
- (memq 'enforce-required-keys eglot-strict-mode)
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- (memq 'check-types eglot-strict-mode))
- ,@body)))
- (t
- `(let ((,object-once ,object)
- (,fn-once (lambda (,@vars) ,@body)))
- (if (memq 'disallow-non-standard-keys eglot-strict-mode)
- (cl-destructuring-bind (&key ,@vars) ,object-once
- (funcall ,fn-once ,@vars))
- (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
- (funcall ,fn-once ,@vars))))))))
-
-
-(cl-defmacro eglot--lambda (cl-lambda-list &body body)
- "Function of args CL-LAMBDA-LIST for processing INTERFACE objects.
-Honour `eglot-strict-mode'."
- (declare (indent 1) (debug (sexp &rest form)))
- (let ((e (cl-gensym "jsonrpc-lambda-elem")))
- `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
-
-(cl-defmacro eglot--dcase (obj &rest clauses)
- "Like `pcase', but for the LSP object OBJ.
-CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is
-treated as in `eglot-dbind'."
- (declare (indent 1) (debug (sexp &rest (sexp &rest form))))
- (let ((obj-once (make-symbol "obj-once")))
- `(let ((,obj-once ,obj))
- (cond
- ,@(cl-loop
- for (vars . body) in clauses
- for vars-as-keywords = (eglot--keywordize-vars vars)
- for interface-name = (if (consp (car vars))
- (car (pop vars)))
- for condition =
- (cond (interface-name
- (eglot--check-dspec interface-name vars)
- ;; In this mode, in runtime, we assume
- ;; `eglot-strict-mode' is partially on, otherwise we
- ;; can't disambiguate between certain types.
- `(ignore-errors
- (eglot--check-object
- ',interface-name ,obj-once
- t
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- t)))
- (t
- ;; In this interface-less mode we don't check
- ;; `eglot-strict-mode' at all: just check that the object
- ;; has all the keys the user wants to destructure.
- `(null (cl-set-difference
- ',vars-as-keywords
- (eglot--plist-keys ,obj-once)))))
- collect `(,condition
- (cl-destructuring-bind (&key ,@vars &allow-other-keys)
- ,obj-once
- ,@body)))
- (t
- (eglot--error "%S didn't match any of %S"
- ,obj-once
- ',(mapcar #'car clauses)))))))
-
-
-;;; API (WORK-IN-PROGRESS!)
-;;;
-(cl-defmacro eglot--when-live-buffer (buf &rest body)
- "Check BUF live, then do BODY in it." (declare (indent 1) (debug t))
- (let ((b (cl-gensym)))
- `(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b ,@body)))))
-
-(cl-defmacro eglot--when-buffer-window (buf &body body)
- "Check BUF showing somewhere, then do BODY in it" (declare (indent 1) (debug t))
- (let ((b (cl-gensym)))
- `(let ((,b ,buf))
- ;;notice the exception when testing with `ert'
- (when (or (get-buffer-window ,b) (ert-running-test))
- (with-current-buffer ,b ,@body)))))
-
-(cl-defmacro eglot--widening (&rest body)
- "Save excursion and restriction. Widen. Then run BODY." (declare (debug t))
- `(save-excursion (save-restriction (widen) ,@body)))
-
-(cl-defgeneric eglot-handle-request (server method &rest params)
- "Handle SERVER's METHOD request with PARAMS.")
-
-(cl-defgeneric eglot-handle-notification (server method &rest params)
- "Handle SERVER's METHOD notification with PARAMS.")
-
-(cl-defgeneric eglot-execute-command (server command arguments)
- "Ask SERVER to execute COMMAND with ARGUMENTS.")
-
-(cl-defgeneric eglot-initialization-options (server)
- "JSON object to send under `initializationOptions'"
- (:method (_s) eglot--{})) ; blank default
-
-(cl-defgeneric eglot-register-capability (server method id &rest params)
- "Ask SERVER to register capability METHOD marked with ID."
- (:method
- (_s method _id &rest _params)
- (eglot--warn "Server tried to register unsupported capability `%s'"
- method)))
-
-(cl-defgeneric eglot-unregister-capability (server method id &rest params)
- "Ask SERVER to register capability METHOD marked with ID."
- (:method
- (_s method _id &rest _params)
- (eglot--warn "Server tried to unregister unsupported capability `%s'"
- method)))
-
-(cl-defgeneric eglot-client-capabilities (server)
- "What the EGLOT LSP client supports for SERVER."
- (:method (_s)
- (list
- :workspace (list
- :applyEdit t
- :executeCommand `(:dynamicRegistration :json-false)
- :workspaceEdit `(:documentChanges :json-false)
- :didChangeWatchedFiles `(:dynamicRegistration t)
- :symbol `(:dynamicRegistration :json-false)
- :configuration t)
- :textDocument
- (list
- :synchronization (list
- :dynamicRegistration :json-false
- :willSave t :willSaveWaitUntil t :didSave t)
- :completion (list :dynamicRegistration :json-false
- :completionItem
- `(:snippetSupport
- ,(if (eglot--snippet-expansion-fn)
- t
- :json-false))
- :contextSupport t)
- :hover (list :dynamicRegistration :json-false
- :contentFormat
- (if (fboundp 'gfm-view-mode)
- ["markdown" "plaintext"]
- ["plaintext"]))
- :signatureHelp (list :dynamicRegistration :json-false
- :signatureInformation
- `(:parameterInformation
- (:labelOffsetSupport t)))
- :references `(:dynamicRegistration :json-false)
- :definition `(:dynamicRegistration :json-false)
- :declaration `(:dynamicRegistration :json-false)
- :implementation `(:dynamicRegistration :json-false)
- :typeDefinition `(:dynamicRegistration :json-false)
- :documentSymbol (list
- :dynamicRegistration :json-false
- :hierarchicalDocumentSymbolSupport t
- :symbolKind `(:valueSet
- [,@(mapcar
- #'car eglot--symbol-kind-names)]))
- :documentHighlight `(:dynamicRegistration :json-false)
- :codeAction (list
- :dynamicRegistration :json-false
- :codeActionLiteralSupport
- '(:codeActionKind
- (:valueSet
- ["quickfix"
- "refactor" "refactor.extract"
- "refactor.inline" "refactor.rewrite"
- "source" "source.organizeImports"]))
- :isPreferredSupport t)
- :formatting `(:dynamicRegistration :json-false)
- :rangeFormatting `(:dynamicRegistration :json-false)
- :rename `(:dynamicRegistration :json-false)
- :publishDiagnostics `(:relatedInformation :json-false))
- :experimental eglot--{})))
-
-(defclass eglot-lsp-server (jsonrpc-process-connection)
- ((project-nickname
- :documentation "Short nickname for the associated project."
- :accessor eglot--project-nickname
- :reader eglot-project-nickname)
- (major-mode
- :documentation "Major mode symbol."
- :accessor eglot--major-mode)
- (capabilities
- :documentation "JSON object containing server capabilities."
- :accessor eglot--capabilities)
- (server-info
- :documentation "JSON object containing server info."
- :accessor eglot--server-info)
- (shutdown-requested
- :documentation "Flag set when server is shutting down."
- :accessor eglot--shutdown-requested)
- (project
- :documentation "Project associated with server."
- :accessor eglot--project)
- (spinner
- :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
- :initform `(nil nil t) :accessor eglot--spinner)
- (inhibit-autoreconnect
- :initform t
- :documentation "Generalized boolean inhibiting auto-reconnection if true."
- :accessor eglot--inhibit-autoreconnect)
- (file-watches
- :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
- :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
- (managed-buffers
- :documentation "List of buffers managed by server."
- :accessor eglot--managed-buffers)
- (saved-initargs
- :documentation "Saved initargs for reconnection purposes."
- :accessor eglot--saved-initargs)
- (inferior-process
- :documentation "Server subprocess started automatically."
- :accessor eglot--inferior-process))
- :documentation
- "Represents a server. Wraps a process for LSP communication.")
-
-
-;;; Process management
-(defvar eglot--servers-by-project (make-hash-table :test #'equal)
- "Keys are projects. Values are lists of processes.")
-
-(defun eglot-shutdown (server &optional _interactive timeout preserve-buffers)
- "Politely ask SERVER to quit.
-Interactively, read SERVER from the minibuffer unless there is
-only one and it's managing the current buffer.
-
-Forcefully quit it if it doesn't respond within TIMEOUT seconds.
-Don't leave this function with the server still running.
-
-If PRESERVE-BUFFERS is non-nil (interactively, when called with a
-prefix argument), do not kill events and output buffers of
-SERVER. ."
- (interactive (list (eglot--read-server "Shutdown which server"
- (eglot-current-server))
- t nil current-prefix-arg))
- (eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
- (unwind-protect
- (progn
- (setf (eglot--shutdown-requested server) t)
- (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
- (jsonrpc-notify server :exit nil))
- ;; Now ask jsonrpc.el to shut down the server.
- (jsonrpc-shutdown server (not preserve-buffers))
- (unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server)))))
-
-(defun eglot--on-shutdown (server)
- "Called by jsonrpc.el when SERVER is already dead."
- ;; Turn off `eglot--managed-mode' where appropriate.
- (dolist (buffer (eglot--managed-buffers server))
- (let (;; Avoid duplicate shutdowns (github#389)
- (eglot-autoshutdown nil))
- (eglot--when-live-buffer buffer (eglot--managed-mode-off))))
- ;; Kill any expensive watches
- (maphash (lambda (_id watches)
- (mapcar #'file-notify-rm-watch watches))
- (eglot--file-watches server))
- ;; Kill any autostarted inferior processes
- (when-let (proc (eglot--inferior-process server))
- (delete-process proc))
- ;; Sever the project/server relationship for `server'
- (setf (gethash (eglot--project server) eglot--servers-by-project)
- (delq server
- (gethash (eglot--project server) eglot--servers-by-project)))
- (cond ((eglot--shutdown-requested server)
- t)
- ((not (eglot--inhibit-autoreconnect server))
- (eglot--warn "Reconnecting after unexpected server exit.")
- (eglot-reconnect server))
- ((timerp (eglot--inhibit-autoreconnect server))
- (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
-
-(defun eglot--all-major-modes ()
- "Return all known major modes."
- (let ((retval))
- (mapatoms (lambda (sym)
- (when (plist-member (symbol-plist sym) 'derived-mode-parent)
- (push sym retval))))
- retval))
-
-(defvar eglot--command-history nil
- "History of CONTACT arguments to `eglot'.")
-
-(defun eglot--guess-contact (&optional interactive)
- "Helper for `eglot'.
-Return (MANAGED-MODE PROJECT CLASS CONTACT). If INTERACTIVE is
-non-nil, maybe prompt user, else error as soon as something can't
-be guessed."
- (let* ((guessed-mode (if buffer-file-name major-mode))
- (managed-mode
- (cond
- ((and interactive
- (or (>= (prefix-numeric-value current-prefix-arg) 16)
- (not guessed-mode)))
- (intern
- (completing-read
- "[eglot] Start a server to manage buffers of what major mode? "
- (mapcar #'symbol-name (eglot--all-major-modes)) nil t
- (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
- ((not guessed-mode)
- (eglot--error "Can't guess mode to manage for `%s'" (current-buffer)))
- (t guessed-mode)))
- (project (or (project-current) `(transient . ,default-directory)))
- (guess (cdr (assoc managed-mode eglot-server-programs
- (lambda (m1 m2)
- (cl-find
- m2 (if (listp m1) m1 (list m1))
- :test #'provided-mode-derived-p)))))
- (guess (if (functionp guess)
- (funcall guess interactive)
- guess))
- (class (or (and (consp guess) (symbolp (car guess))
- (prog1 (car guess) (setq guess (cdr guess))))
- 'eglot-lsp-server))
- (program (and (listp guess)
- (stringp (car guess))
- ;; A second element might be the port of a (host, port)
- ;; pair, but in that case it is not a string.
- (or (null (cdr guess)) (stringp (cadr guess)))
- (car guess)))
- (base-prompt
- (and interactive
- "Enter program to execute (or <host>:<port>): "))
- (program-guess
- (and program
- (combine-and-quote-strings (cl-subst ":autoport:"
- :autoport guess))))
- (prompt
- (and base-prompt
- (cond (current-prefix-arg base-prompt)
- ((null guess)
- (format "[eglot] Sorry, couldn't guess for `%s'!\n%s"
- managed-mode base-prompt))
- ((and program (not (executable-find program)))
- (concat (format "[eglot] I guess you want to run `%s'"
- program-guess)
- (format ", but I can't find `%s' in PATH!" program)
- "\n" base-prompt)))))
- (contact
- (or (and prompt
- (let ((s (read-shell-command
- prompt
- program-guess
- 'eglot-command-history)))
- (if (string-match "^\\([^\s\t]+\\):\\([[:digit:]]+\\)$"
- (string-trim s))
- (list (match-string 1 s)
- (string-to-number (match-string 2 s)))
- (cl-subst
- :autoport ":autoport:" (split-string-and-unquote s)
- :test #'equal))))
- guess
- (eglot--error "Couldn't guess for `%s'!" managed-mode))))
- (list managed-mode project class contact)))
-
-;;;###autoload
-(defun eglot (managed-major-mode project class contact &optional interactive)
- "Manage a project with a Language Server Protocol (LSP) server.
-
-The LSP server of CLASS started (or contacted) via CONTACT. If
-this operation is successful, current *and future* file buffers
-of MANAGED-MAJOR-MODE inside PROJECT automatically become
-\"managed\" by the LSP server, meaning information about their
-contents is exchanged periodically to provide enhanced
-code-analysis via `xref-find-definitions', `flymake-mode',
-`eldoc-mode', `completion-at-point', among others.
-
-Interactively, the command attempts to guess MANAGED-MAJOR-MODE
-from current buffer, CLASS and CONTACT from
-`eglot-server-programs' and PROJECT from `project-current'. If
-it can't guess, the user is prompted. With a single
-\\[universal-argument] prefix arg, it always prompt for COMMAND.
-With two \\[universal-argument] prefix args, also prompts for
-MANAGED-MAJOR-MODE.
-
-PROJECT is a project instance as returned by `project-current'.
-
-CLASS is a subclass of symbol `eglot-lsp-server'.
-
-CONTACT specifies how to contact the server. It is a
-keyword-value plist used to initialize CLASS or a plain list as
-described in `eglot-server-programs', which see.
-
-INTERACTIVE is t if called interactively."
- (interactive (append (eglot--guess-contact t) '(t)))
- (let* ((current-server (eglot-current-server))
- (live-p (and current-server (jsonrpc-running-p current-server))))
- (if (and live-p
- interactive
- (y-or-n-p "[eglot] Live process found, reconnect instead? "))
- (eglot-reconnect current-server interactive)
- (when live-p (ignore-errors (eglot-shutdown current-server)))
- (eglot--connect managed-major-mode project class contact))))
-
-(defun eglot-reconnect (server &optional interactive)
- "Reconnect to SERVER.
-INTERACTIVE is t if called interactively."
- (interactive (list (eglot--current-server-or-lose) t))
- (when (jsonrpc-running-p server)
- (ignore-errors (eglot-shutdown server interactive nil 'preserve-buffers)))
- (eglot--connect (eglot--major-mode server)
- (eglot--project server)
- (eieio-object-class-name server)
- (eglot--saved-initargs server))
- (eglot--message "Reconnected!"))
-
-(defvar eglot--managed-mode) ; forward decl
-
-;;;###autoload
-(defun eglot-ensure ()
- "Start Eglot session for current buffer if there isn't one."
- (let ((buffer (current-buffer)))
- (cl-labels
- ((maybe-connect
- ()
- (remove-hook 'post-command-hook #'maybe-connect nil)
- (eglot--when-live-buffer buffer
- (unless eglot--managed-mode
- (apply #'eglot--connect (eglot--guess-contact))))))
- (when buffer-file-name
- (add-hook 'post-command-hook #'maybe-connect 'append nil)))))
-
-(defun eglot-events-buffer (server)
- "Display events buffer for SERVER.
-Use current server's or first available Eglot events buffer."
- (interactive (list (eglot-current-server)))
- (let ((buffer (if server (jsonrpc-events-buffer server)
- (cl-find "\\*EGLOT.*events\\*"
- (buffer-list)
- :key #'buffer-name :test #'string-match))))
- (if buffer (display-buffer buffer)
- (eglot--error "Can't find an Eglot events buffer!"))))
-
-(defun eglot-stderr-buffer (server)
- "Display stderr buffer for SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (display-buffer (jsonrpc-stderr-buffer server)))
-
-(defun eglot-forget-pending-continuations (server)
- "Forget pending requests for SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (jsonrpc-forget-pending-continuations server))
-
-(defvar eglot-connect-hook
- '(eglot-signal-didChangeConfiguration)
- "Hook run after connecting in `eglot--connect'.")
-
-(defvar eglot-server-initialized-hook
- '()
- "Hook run after a `eglot-lsp-server' instance is created.
-
-That is before a connection was established. Use
-`eglot-connect-hook' to hook into when a connection was
-successfully established and the server on the other side has
-received the initializing configuration.
-
-Each function is passed the server as an argument")
-
-(defun eglot--connect (managed-major-mode project class contact)
- "Connect to MANAGED-MAJOR-MODE, PROJECT, CLASS and CONTACT.
-This docstring appeases checkdoc, that's all."
- (let* ((default-directory (project-root project))
- (nickname (file-name-base (directory-file-name default-directory)))
- (readable-name (format "EGLOT (%s/%s)" nickname managed-major-mode))
- autostart-inferior-process
- (contact (if (functionp contact) (funcall contact) contact))
- (initargs
- (cond ((keywordp (car contact)) contact)
- ((integerp (cadr contact))
- `(:process ,(lambda ()
- (apply #'open-network-stream
- readable-name nil
- (car contact) (cadr contact)
- (cddr contact)))))
- ((and (stringp (car contact)) (memq :autoport contact))
- `(:process ,(lambda ()
- (pcase-let ((`(,connection . ,inferior)
- (eglot--inferior-bootstrap
- readable-name
- contact)))
- (setq autostart-inferior-process inferior)
- connection))))
- ((stringp (car contact))
- `(:process
- ,(lambda ()
- (let ((default-directory default-directory))
- (make-process
- :name readable-name
- :command contact
- :connection-type 'pipe
- :coding 'utf-8-emacs-unix
- :noquery t
- :stderr (get-buffer-create
- (format "*%s stderr*" readable-name)))))))))
- (spread (lambda (fn) (lambda (server method params)
- (apply fn server method (append params nil)))))
- (server
- (apply
- #'make-instance class
- :name readable-name
- :events-buffer-scrollback-size eglot-events-buffer-size
- :notification-dispatcher (funcall spread #'eglot-handle-notification)
- :request-dispatcher (funcall spread #'eglot-handle-request)
- :on-shutdown #'eglot--on-shutdown
- initargs))
- (cancelled nil)
- (tag (make-symbol "connected-catch-tag")))
- (setf (eglot--saved-initargs server) initargs)
- (setf (eglot--project server) project)
- (setf (eglot--project-nickname server) nickname)
- (setf (eglot--major-mode server) managed-major-mode)
- (setf (eglot--inferior-process server) autostart-inferior-process)
- (run-hook-with-args 'eglot-server-initialized-hook server)
- ;; Now start the handshake. To honour `eglot-sync-connect'
- ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
- ;; and mimic most of `jsonrpc-request'.
- (unwind-protect
- (condition-case _quit
- (let ((retval
- (catch tag
- (jsonrpc-async-request
- server
- :initialize
- (list :processId (unless (eq (jsonrpc-process-type server)
- 'network)
- (emacs-pid))
- :rootPath (expand-file-name default-directory)
- :rootUri (eglot--path-to-uri default-directory)
- :initializationOptions (eglot-initialization-options
- server)
- :capabilities (eglot-client-capabilities server))
- :success-fn
- (eglot--lambda ((InitializeResult) capabilities serverInfo)
- (unless cancelled
- (push server
- (gethash project eglot--servers-by-project))
- (setf (eglot--capabilities server) capabilities)
- (setf (eglot--server-info server) serverInfo)
- (jsonrpc-notify server :initialized eglot--{})
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- ;; No need to pass SERVER as an argument: it has
- ;; been registered in `eglot--servers-by-project',
- ;; so that it can be found (and cached) from
- ;; `eglot--maybe-activate-editing-mode' in any
- ;; managed buffer.
- (eglot--maybe-activate-editing-mode)))
- (setf (eglot--inhibit-autoreconnect server)
- (cond
- ((booleanp eglot-autoreconnect)
- (not eglot-autoreconnect))
- ((cl-plusp eglot-autoreconnect)
- (run-with-timer
- eglot-autoreconnect nil
- (lambda ()
- (setf (eglot--inhibit-autoreconnect server)
- (null eglot-autoreconnect)))))))
- (let ((default-directory (project-root project))
- (major-mode managed-major-mode))
- (hack-dir-local-variables-non-file-buffer)
- (run-hook-with-args 'eglot-connect-hook server))
- (eglot--message
- "Connected! Server `%s' now managing `%s' buffers \
-in project `%s'."
- (or (plist-get serverInfo :name)
- (jsonrpc-name server))
- managed-major-mode
- (eglot-project-nickname server))
- (when tag (throw tag t))))
- :timeout eglot-connect-timeout
- :error-fn (eglot--lambda ((ResponseError) code message)
- (unless cancelled
- (jsonrpc-shutdown server)
- (let ((msg (format "%s: %s" code message)))
- (if tag (throw tag `(error . ,msg))
- (eglot--error msg)))))
- :timeout-fn (lambda ()
- (unless cancelled
- (jsonrpc-shutdown server)
- (let ((msg (format "Timed out")))
- (if tag (throw tag `(error . ,msg))
- (eglot--error msg))))))
- (cond ((numberp eglot-sync-connect)
- (accept-process-output nil eglot-sync-connect))
- (eglot-sync-connect
- (while t (accept-process-output nil 30)))))))
- (pcase retval
- (`(error . ,msg) (eglot--error msg))
- (`nil (eglot--message "Waiting in background for server `%s'"
- (jsonrpc-name server))
- nil)
- (_ server)))
- (quit (jsonrpc-shutdown server) (setq cancelled 'quit)))
- (setq tag nil))))
-
-(defun eglot--inferior-bootstrap (name contact &optional connect-args)
- "Use CONTACT to start a server, then connect to it.
-Return a cons of two process objects (CONNECTION . INFERIOR).
-Name both based on NAME.
-CONNECT-ARGS are passed as additional arguments to
-`open-network-stream'."
- (let* ((port-probe (make-network-process :name "eglot-port-probe-dummy"
- :server t
- :host "localhost"
- :service 0))
- (port-number (unwind-protect
- (process-contact port-probe :service)
- (delete-process port-probe)))
- inferior connection)
- (unwind-protect
- (progn
- (setq inferior
- (make-process
- :name (format "autostart-inferior-%s" name)
- :stderr (format "*%s stderr*" name)
- :noquery t
- :command (cl-subst
- (format "%s" port-number) :autoport contact)))
- (setq connection
- (cl-loop
- repeat 10 for i from 1
- do (accept-process-output nil 0.5)
- while (process-live-p inferior)
- do (eglot--message
- "Trying to connect to localhost and port %s (attempt %s)"
- port-number i)
- thereis (ignore-errors
- (apply #'open-network-stream
- (format "autoconnect-%s" name)
- nil
- "localhost" port-number connect-args))))
- (cons connection inferior))
- (cond ((and (process-live-p connection)
- (process-live-p inferior))
- (eglot--message "Done, connected to %s!" port-number))
- (t
- (when inferior (delete-process inferior))
- (when connection (delete-process connection))
- (eglot--error "Could not start and connect to server%s"
- (if inferior
- (format " started with %s"
- (process-command inferior))
- "!")))))))
-
-
-;;; Helpers (move these to API?)
-;;;
-(defun eglot--error (format &rest args)
- "Error out with FORMAT with ARGS."
- (error "[eglot] %s" (apply #'format format args)))
-
-(defun eglot--message (format &rest args)
- "Message out with FORMAT with ARGS."
- (message "[eglot] %s" (apply #'format format args)))
-
-(defun eglot--warn (format &rest args)
- "Warning message with FORMAT and ARGS."
- (apply #'eglot--message (concat "(warning) " format) args)
- (let ((warning-minimum-level :error))
- (display-warning 'eglot (apply #'format format args) :warning)))
-
-(defun eglot-current-column () (- (point) (point-at-bol)))
-
-(defvar eglot-current-column-function #'eglot-lsp-abiding-column
- "Function to calculate the current column.
-
-This is the inverse operation of
-`eglot-move-to-column-function' (which see). It is a function of
-no arguments returning a column number. For buffers managed by
-fully LSP-compliant servers, this should be set to
-`eglot-lsp-abiding-column' (the default), and
-`eglot-current-column' for all others.")
-
-(defun eglot-lsp-abiding-column (&optional lbp)
- "Calculate current COLUMN as defined by the LSP spec.
-LBP defaults to `line-beginning-position'."
- (/ (- (length (encode-coding-region (or lbp (line-beginning-position))
- (point) 'utf-16 t))
- 2)
- 2))
-
-(defun eglot--pos-to-lsp-position (&optional pos)
- "Convert point POS to LSP position."
- (eglot--widening
- (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE
- :character (progn (when pos (goto-char pos))
- (funcall eglot-current-column-function)))))
-
-(defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column
- "Function to move to a column reported by the LSP server.
-
-According to the standard, LSP column/character offsets are based
-on a count of UTF-16 code units, not actual visual columns. So
-when LSP says position 3 of a line containing just \"aXbc\",
-where X is a multi-byte character, it actually means `b', not
-`c'. However, many servers don't follow the spec this closely.
-
-For buffers managed by fully LSP-compliant servers, this should
-be set to `eglot-move-to-lsp-abiding-column' (the default), and
-`eglot-move-to-column' for all others.")
-
-(defun eglot-move-to-column (column)
- "Move to COLUMN without closely following the LSP spec."
- ;; We cannot use `move-to-column' here, because it moves to *visual*
- ;; columns, which can be different from LSP columns in case of
- ;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296,
- ;; github#297)
- (goto-char (min (+ (line-beginning-position) column)
- (line-end-position))))
-
-(defun eglot-move-to-lsp-abiding-column (column)
- "Move to COLUMN abiding by the LSP spec."
- (save-restriction
- (cl-loop
- with lbp = (line-beginning-position)
- initially
- (narrow-to-region lbp (line-end-position))
- (move-to-column column)
- for diff = (- column
- (eglot-lsp-abiding-column lbp))
- until (zerop diff)
- do (condition-case eob-err
- (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2))
- (end-of-buffer (cl-return eob-err))))))
-
-(defun eglot--lsp-position-to-point (pos-plist &optional marker)
- "Convert LSP position POS-PLIST to Emacs point.
-If optional MARKER, return a marker instead"
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (forward-line (min most-positive-fixnum
- (plist-get pos-plist :line)))
- (unless (eobp) ;; if line was excessive leave point at eob
- (let ((tab-width 1)
- (col (plist-get pos-plist :character)))
- (unless (wholenump col)
- (eglot--warn
- "Caution: LSP server sent invalid character position %s. Using 0 instead."
- col)
- (setq col 0))
- (funcall eglot-move-to-column-function col)))
- (if marker (copy-marker (point-marker)) (point)))))
-
-(defun eglot--path-to-uri (path)
- "URIfy PATH."
- (url-hexify-string
- (concat "file://" (if (eq system-type 'windows-nt) "/") (file-truename path))
- url-path-allowed-chars))
-
-(defun eglot--uri-to-path (uri)
- "Convert URI to a file path."
- (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
- (let ((retval (url-filename (url-generic-parse-url (url-unhex-string uri)))))
- (if (eq system-type 'windows-nt) (substring retval 1) retval)))
-
-(defun eglot--snippet-expansion-fn ()
- "Compute a function to expand snippets.
-Doubles as an indicator of snippet support."
- (and (boundp 'yas-minor-mode)
- (symbol-value 'yas-minor-mode)
- 'yas-expand-snippet))
-
-(defun eglot--format-markup (markup)
- "Format MARKUP according to LSP's spec."
- (pcase-let ((`(,string ,mode)
- (if (stringp markup) (list markup 'gfm-view-mode)
- (list (plist-get markup :value)
- (pcase (plist-get markup :kind)
- ("markdown" 'gfm-view-mode)
- ("plaintext" 'text-mode)
- (_ major-mode))))))
- (with-temp-buffer
- (setq-local markdown-fontify-code-blocks-natively t)
- (insert string)
- (ignore-errors (delay-mode-hooks (funcall mode)))
- (font-lock-ensure)
- (string-trim (filter-buffer-substring (point-min) (point-max))))))
-
-(defcustom eglot-ignored-server-capabilites (list)
- "LSP server capabilities that Eglot could use, but won't.
-You could add, for instance, the symbol
-`:documentHighlightProvider' to prevent automatic highlighting
-under cursor."
- :type '(repeat
- (choice
- (const :tag "Documentation on hover" :hoverProvider)
- (const :tag "Code completion" :completionProvider)
- (const :tag "Function signature help" :signatureHelpProvider)
- (const :tag "Go to definition" :definitionProvider)
- (const :tag "Go to type definition" :typeDefinitionProvider)
- (const :tag "Go to implementation" :implementationProvider)
- (const :tag "Go to declaration" :implementationProvider)
- (const :tag "Find references" :referencesProvider)
- (const :tag "Highlight symbols automatically" :documentHighlightProvider)
- (const :tag "List symbols in buffer" :documentSymbolProvider)
- (const :tag "List symbols in workspace" :workspaceSymbolProvider)
- (const :tag "Execute code actions" :codeActionProvider)
- (const :tag "Code lens" :codeLensProvider)
- (const :tag "Format buffer" :documentFormattingProvider)
- (const :tag "Format portion of buffer" :documentRangeFormattingProvider)
- (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
- (const :tag "Rename symbol" :renameProvider)
- (const :tag "Highlight links in document" :documentLinkProvider)
- (const :tag "Decorate color references" :colorProvider)
- (const :tag "Fold regions of buffer" :foldingRangeProvider)
- (const :tag "Execute custom commands" :executeCommandProvider)
- (symbol :tag "Other"))))
-
-(defun eglot--server-capable (&rest feats)
- "Determine if current server is capable of FEATS."
- (unless (cl-some (lambda (feat)
- (memq feat eglot-ignored-server-capabilites))
- feats)
- (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
- then (cadr probe)
- for (feat . more) on feats
- for probe = (plist-member caps feat)
- if (not probe) do (cl-return nil)
- if (eq (cadr probe) :json-false) do (cl-return nil)
- if (not (listp (cadr probe))) do (cl-return (if more nil (cadr probe)))
- finally (cl-return (or (cadr probe) t)))))
-
-(defun eglot--range-region (range &optional markers)
- "Return region (BEG . END) that represents LSP RANGE.
-If optional MARKERS, make markers."
- (let* ((st (plist-get range :start))
- (beg (eglot--lsp-position-to-point st markers))
- (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
- (cons beg end)))
-
-(defun eglot--read-server (prompt &optional dont-if-just-the-one)
- "Read a running Eglot server from minibuffer using PROMPT.
-If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt
-and just return it. PROMPT shouldn't end with a question mark."
- (let ((servers (cl-loop for servers
- being hash-values of eglot--servers-by-project
- append servers))
- (name (lambda (srv)
- (format "%s/%s" (eglot-project-nickname srv)
- (eglot--major-mode srv)))))
- (cond ((null servers)
- (eglot--error "No servers!"))
- ((or (cdr servers) (not dont-if-just-the-one))
- (let* ((default (when-let ((current (eglot-current-server)))
- (funcall name current)))
- (read (completing-read
- (if default
- (format "%s (default %s)? " prompt default)
- (concat prompt "? "))
- (mapcar name servers)
- nil t
- nil nil
- default)))
- (cl-find read servers :key name :test #'equal)))
- (t (car servers)))))
-
-
-;;; Minor modes
-;;;
-(defvar eglot-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap display-local-help] 'eldoc-doc-buffer)
- map))
-
-(defvar-local eglot--current-flymake-report-fn nil
- "Current flymake report function for this buffer")
-
-(defvar-local eglot--saved-bindings nil
- "Bindings saved by `eglot--setq-saving'.")
-
-(defvar eglot-stay-out-of '()
- "List of Emacs things that Eglot should try to stay of.
-Each element is a string, a symbol, or a regexp which is matched
-against a variable's name. Examples include the string
-\"company\" or the symbol `xref'.
-
-Before Eglot starts \"managing\" a particular buffer, it
-opinionatedly sets some peripheral Emacs facilites, such as
-Flymake, Xref and Company. These overriding settings help ensure
-consistent Eglot behaviour and only stay in place until
-\"managing\" stops (usually via `eglot-shutdown'), whereupon the
-previous settings are restored.
-
-However, if you wish for Eglot to stay out of a particular Emacs
-facility that you'd like to keep control of add an element to
-this list and Eglot will refrain from setting it.
-
-For example, to keep your Company customization use
-
-(add-to-list 'eglot-stay-out-of 'company)")
-
-(defun eglot--stay-out-of-p (symbol)
- "Tell if EGLOT should stay of of SYMBOL."
- (cl-find (symbol-name symbol) eglot-stay-out-of
- :test (lambda (s thing)
- (let ((re (if (symbolp thing) (symbol-name thing) thing)))
- (string-match re s)))))
-
-(defmacro eglot--setq-saving (symbol binding)
- `(unless (or (not (boundp ',symbol)) (eglot--stay-out-of-p ',symbol))
- (push (cons ',symbol (symbol-value ',symbol)) eglot--saved-bindings)
- (setq-local ,symbol ,binding)))
-
-(defvar-local eglot--cached-server nil
- "A cached reference to the current EGLOT server.")
-
-(defun eglot-managed-p ()
- "Tell if current buffer is managed by EGLOT."
- eglot--managed-mode)
-
-(make-obsolete-variable
- 'eglot--managed-mode-hook 'eglot-managed-mode-hook "1.6")
-
-(defvar eglot-managed-mode-hook nil
- "A hook run by EGLOT after it started/stopped managing a buffer.
-Use `eglot-managed-p' to determine if current buffer is managed.")
-
-(define-minor-mode eglot--managed-mode
- "Mode for source buffers managed by some EGLOT project."
- nil nil eglot-mode-map
- (cond
- (eglot--managed-mode
- (add-hook 'after-change-functions 'eglot--after-change nil t)
- (add-hook 'before-change-functions 'eglot--before-change nil t)
- (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
- ;; Prepend "didClose" to the hook after the "nonoff", so it will run first
- (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t)
- (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t)
- (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t)
- (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t)
- (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t)
- (unless (eglot--stay-out-of-p 'xref)
- (add-hook 'xref-backend-functions 'eglot-xref-backend nil t))
- (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t)
- (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t)
- (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t)
- (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t)
- (eglot--setq-saving eldoc-documentation-functions
- '(eglot-signature-eldoc-function
- eglot-hover-eldoc-function))
- (eglot--setq-saving eldoc-documentation-strategy
- #'eldoc-documentation-enthusiast)
- (eglot--setq-saving xref-prompt-for-identifier nil)
- (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend t))
- (eglot--setq-saving company-backends '(company-capf))
- (eglot--setq-saving company-tooltip-align-annotations t)
- (unless (eglot--stay-out-of-p 'imenu)
- (add-function :before-until (local 'imenu-create-index-function)
- #'eglot-imenu))
- (flymake-mode 1)
- (eldoc-mode 1)
- (cl-pushnew (current-buffer) (eglot--managed-buffers eglot--cached-server)))
- (t
- (remove-hook 'after-change-functions 'eglot--after-change t)
- (remove-hook 'before-change-functions 'eglot--before-change t)
- (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
- (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t)
- (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t)
- (remove-hook 'after-revert-hook 'eglot--after-revert-hook t)
- (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t)
- (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t)
- (remove-hook 'xref-backend-functions 'eglot-xref-backend t)
- (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t)
- (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t)
- (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t)
- (remove-hook 'pre-command-hook 'eglot--pre-command-hook t)
- (cl-loop for (var . saved-binding) in eglot--saved-bindings
- do (set (make-local-variable var) saved-binding))
- (remove-function (local 'imenu-create-index-function) #'eglot-imenu)
- (setq eglot--current-flymake-report-fn nil)
- (let ((server eglot--cached-server))
- (setq eglot--cached-server nil)
- (when server
- (setf (eglot--managed-buffers server)
- (delq (current-buffer) (eglot--managed-buffers server)))
- (when (and eglot-autoshutdown
- (null (eglot--managed-buffers server)))
- (eglot-shutdown server))))))
- ;; Note: the public hook runs before the internal eglot--managed-mode-hook.
- (run-hooks 'eglot-managed-mode-hook))
-
-(defun eglot--managed-mode-off ()
- "Turn off `eglot--managed-mode' unconditionally."
- (eglot--managed-mode -1))
-
-(defun eglot-current-server ()
- "Return logical EGLOT server for current buffer, nil if none."
- eglot--cached-server)
-
-(defun eglot--current-server-or-lose ()
- "Return current logical EGLOT server connection or error."
- (or eglot--cached-server
- (jsonrpc-error "No current JSON-RPC connection")))
-
-(defvar-local eglot--unreported-diagnostics nil
- "Unreported Flymake diagnostics for this buffer.")
-
-(defvar revert-buffer-preserve-modes)
-(defun eglot--after-revert-hook ()
- "Eglot's `after-revert-hook'."
- (when revert-buffer-preserve-modes (eglot--signal-textDocument/didOpen)))
-
-(defun eglot--maybe-activate-editing-mode ()
- "Maybe activate `eglot--managed-mode'.
-
-If it is activated, also signal textDocument/didOpen."
- (unless eglot--managed-mode
- ;; Called when `revert-buffer-in-progress-p' is t but
- ;; `revert-buffer-preserve-modes' is nil.
- (when (and buffer-file-name
- (or
- eglot--cached-server
- (setq eglot--cached-server
- (cl-find major-mode
- (gethash (or (project-current)
- `(transient . ,default-directory))
- eglot--servers-by-project)
- :key #'eglot--major-mode))))
- (setq eglot--unreported-diagnostics `(:just-opened . nil))
- (eglot--managed-mode)
- (eglot--signal-textDocument/didOpen))))
-
-(add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode)
-(add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode)
-
-(defun eglot-clear-status (server)
- "Clear the last JSONRPC error for SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (setf (jsonrpc-last-error server) nil))
-
-
-;;; Mode-line, menu and other sugar
-;;;
-(defvar eglot--mode-line-format `(:eval (eglot--mode-line-format)))
-
-(put 'eglot--mode-line-format 'risky-local-variable t)
-
-(defun eglot--mouse-call (what)
- "Make an interactive lambda for calling WHAT from mode-line."
- (lambda (event)
- (interactive "e")
- (let ((start (event-start event))) (with-selected-window (posn-window start)
- (save-excursion
- (goto-char (or (posn-point start)
- (point)))
- (call-interactively what)
- (force-mode-line-update t))))))
-
-(defun eglot--mode-line-props (thing face defs &optional prepend)
- "Helper for function `eglot--mode-line-format'.
-Uses THING, FACE, DEFS and PREPEND."
- (cl-loop with map = (make-sparse-keymap)
- for (elem . rest) on defs
- for (key def help) = elem
- do (define-key map `[mode-line ,key] (eglot--mouse-call def))
- concat (format "%s: %s" key help) into blurb
- when rest concat "\n" into blurb
- finally (return `(:propertize ,thing
- face ,face
- keymap ,map help-echo ,(concat prepend blurb)
- mouse-face mode-line-highlight))))
-
-(defun eglot--mode-line-format ()
- "Compose the EGLOT's mode-line."
- (pcase-let* ((server (eglot-current-server))
- (nick (and server (eglot-project-nickname server)))
- (pending (and server (hash-table-count
- (jsonrpc--request-continuations server))))
- (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner server)))
- (last-error (and server (jsonrpc-last-error server))))
- (append
- `(,(eglot--mode-line-props "eglot" 'eglot-mode-line nil))
- (when nick
- `(":" ,(eglot--mode-line-props
- nick 'eglot-mode-line
- '((C-mouse-1 eglot-stderr-buffer "go to stderr buffer")
- (mouse-1 eglot-events-buffer "go to events buffer")
- (mouse-2 eglot-shutdown "quit server")
- (mouse-3 eglot-reconnect "reconnect to server")))
- ,@(when last-error
- `("/" ,(eglot--mode-line-props
- "error" 'compilation-mode-line-fail
- '((mouse-3 eglot-clear-status "clear this status"))
- (format "An error occured: %s\n" (plist-get last-error
- :message)))))
- ,@(when (and doing (not done-p))
- `("/" ,(eglot--mode-line-props doing
- 'compilation-mode-line-run '())))
- ,@(when (cl-plusp pending)
- `("/" ,(eglot--mode-line-props
- (format "%d" pending) 'warning
- '((mouse-3 eglot-forget-pending-continuations
- "forget pending continuations"))))))))))
-
-(add-to-list 'mode-line-misc-info
- `(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
-
-(put 'eglot-note 'flymake-category 'flymake-note)
-(put 'eglot-warning 'flymake-category 'flymake-warning)
-(put 'eglot-error 'flymake-category 'flymake-error)
-
-(defalias 'eglot--make-diag 'flymake-make-diagnostic)
-(defalias 'eglot--diag-data 'flymake-diagnostic-data)
-
-(cl-loop for i from 1
- for type in '(eglot-note eglot-warning eglot-error )
- do (put type 'flymake-overlay-control
- `((mouse-face . highlight)
- (priority . ,(+ 50 i))
- (keymap . ,(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1]
- (eglot--mouse-call 'eglot-code-actions))
- map)))))
-
-
-;;; Protocol implementation (Requests, notifications, etc)
-;;;
-(cl-defmethod eglot-handle-notification
- (_server method &key &allow-other-keys)
- "Handle unknown notification"
- (unless (or (string-prefix-p "$" (format "%s" method))
- (not (memq 'disallow-unknown-methods eglot-strict-mode)))
- (eglot--warn "Server sent unknown notification method `%s'" method)))
-
-(cl-defmethod eglot-handle-request
- (_server method &key &allow-other-keys)
- "Handle unknown request"
- (when (memq 'disallow-unknown-methods eglot-strict-mode)
- (jsonrpc-error "Unknown request method `%s'" method)))
-
-(cl-defmethod eglot-execute-command
- (server command arguments)
- "Execute COMMAND on SERVER with `:workspace/executeCommand'.
-COMMAND is a symbol naming the command."
- (jsonrpc-request server :workspace/executeCommand
- `(:command ,(format "%s" command) :arguments ,arguments)))
-
-(cl-defmethod eglot-handle-notification
- (_server (_method (eql window/showMessage)) &key type message)
- "Handle notification window/showMessage"
- (eglot--message (propertize "Server reports (type=%s): %s"
- 'face (if (<= type 1) 'error))
- type message))
-
-(cl-defmethod eglot-handle-request
- (_server (_method (eql window/showMessageRequest)) &key type message actions)
- "Handle server request window/showMessageRequest"
- (let ((label (completing-read
- (concat
- (format (propertize "[eglot] Server reports (type=%s): %s"
- 'face (if (<= type 1) 'error))
- type message)
- "\nChoose an option: ")
- (or (mapcar (lambda (obj) (plist-get obj :title)) actions)
- '("OK"))
- nil t (plist-get (elt actions 0) :title))))
- (if label `(:title ,label) :null)))
-
-(cl-defmethod eglot-handle-notification
- (_server (_method (eql window/logMessage)) &key _type _message)
- "Handle notification window/logMessage") ;; noop, use events buffer
-
-(cl-defmethod eglot-handle-notification
- (_server (_method (eql telemetry/event)) &rest _any)
- "Handle notification telemetry/event") ;; noop, use events buffer
-
-(cl-defmethod eglot-handle-notification
- (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
- &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
- "Handle notification publishDiagnostics"
- (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri))))
- (with-current-buffer buffer
- (cl-loop
- for diag-spec across diagnostics
- collect (eglot--dbind ((Diagnostic) range message severity source)
- diag-spec
- (setq message (concat source ": " message))
- (pcase-let
- ((sev severity)
- (`(,beg . ,end) (eglot--range-region range)))
- ;; Fallback to `flymake-diag-region' if server
- ;; botched the range
- (when (= beg end)
- (if-let* ((st (plist-get range :start))
- (diag-region
- (flymake-diag-region
- (current-buffer) (1+ (plist-get st :line))
- (plist-get st :character))))
- (setq beg (car diag-region) end (cdr diag-region))
- (eglot--widening
- (goto-char (point-min))
- (setq beg
- (point-at-bol
- (1+ (plist-get (plist-get range :start) :line))))
- (setq end
- (point-at-eol
- (1+ (plist-get (plist-get range :end) :line)))))))
- (eglot--make-diag (current-buffer) beg end
- (cond ((<= sev 1) 'eglot-error)
- ((= sev 2) 'eglot-warning)
- (t 'eglot-note))
- message `((eglot-lsp-diag . ,diag-spec)))))
- into diags
- finally (cond ((and flymake-mode eglot--current-flymake-report-fn)
- (save-restriction
- (widen)
- (funcall eglot--current-flymake-report-fn diags
- ;; If the buffer hasn't changed since last
- ;; call to the report function, flymake won't
- ;; delete old diagnostics. Using :region
- ;; keyword forces flymake to delete
- ;; them (github#159).
- :region (cons (point-min) (point-max))))
- (setq eglot--unreported-diagnostics nil))
- (t
- (setq eglot--unreported-diagnostics (cons t diags))))))
- (jsonrpc--debug server "Diagnostics received for unvisited %s" uri)))
-
-(cl-defun eglot--register-unregister (server things how)
- "Helper for `registerCapability'.
-THINGS are either registrations or unregisterations (sic)."
- (cl-loop
- for thing in (cl-coerce things 'list)
- do (eglot--dbind ((Registration) id method registerOptions) thing
- (apply (cl-ecase how
- (register 'eglot-register-capability)
- (unregister 'eglot-unregister-capability))
- server (intern method) id registerOptions))))
-
-(cl-defmethod eglot-handle-request
- (server (_method (eql client/registerCapability)) &key registrations)
- "Handle server request client/registerCapability"
- (eglot--register-unregister server registrations 'register))
-
-(cl-defmethod eglot-handle-request
- (server (_method (eql client/unregisterCapability))
- &key unregisterations) ;; XXX: "unregisterations" (sic)
- "Handle server request client/unregisterCapability"
- (eglot--register-unregister server unregisterations 'unregister))
-
-(cl-defmethod eglot-handle-request
- (_server (_method (eql workspace/applyEdit)) &key _label edit)
- "Handle server request workspace/applyEdit"
- (eglot--apply-workspace-edit edit eglot-confirm-server-initiated-edits))
-
-(defun eglot--TextDocumentIdentifier ()
- "Compute TextDocumentIdentifier object for current buffer."
- `(:uri ,(eglot--path-to-uri (or buffer-file-name
- (ignore-errors
- (buffer-file-name
- (buffer-base-buffer)))))))
-
-(defvar-local eglot--versioned-identifier 0)
-
-(defun eglot--VersionedTextDocumentIdentifier ()
- "Compute VersionedTextDocumentIdentifier object for current buffer."
- (append (eglot--TextDocumentIdentifier)
- `(:version ,eglot--versioned-identifier)))
-
-(defun eglot--TextDocumentItem ()
- "Compute TextDocumentItem object for current buffer."
- (append
- (eglot--VersionedTextDocumentIdentifier)
- (list :languageId
- (if (string-match "\\(.*\\)-mode" (symbol-name major-mode))
- (match-string 1 (symbol-name major-mode))
- "unknown")
- :text
- (eglot--widening
- (buffer-substring-no-properties (point-min) (point-max))))))
-
-(defun eglot--TextDocumentPositionParams ()
- "Compute TextDocumentPositionParams."
- (list :textDocument (eglot--TextDocumentIdentifier)
- :position (eglot--pos-to-lsp-position)))
-
-(defvar-local eglot--last-inserted-char nil
- "If non-nil, value of the last inserted character in buffer.")
-
-(defun eglot--post-self-insert-hook ()
- "Set `eglot--last-inserted-char'."
- (setq eglot--last-inserted-char last-input-event))
-
-(defun eglot--pre-command-hook ()
- "Reset `eglot--last-inserted-char'."
- (setq eglot--last-inserted-char nil))
-
-(defun eglot--CompletionParams ()
- (append
- (eglot--TextDocumentPositionParams)
- `(:context
- ,(if-let (trigger (and (characterp eglot--last-inserted-char)
- (cl-find eglot--last-inserted-char
- (eglot--server-capable :completionProvider
- :triggerCharacters)
- :key (lambda (str) (aref str 0))
- :test #'char-equal)))
- `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1)))))
-
-(defvar-local eglot--recent-changes nil
- "Recent buffer changes as collected by `eglot--before-change'.")
-
-(cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what)
- "Tell if SERVER is ready for WHAT in current buffer."
- (and (cl-call-next-method) (not eglot--recent-changes)))
-
-(defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.")
-
-(defun eglot--before-change (beg end)
- "Hook onto `before-change-functions' with BEG and END."
- (when (listp eglot--recent-changes)
- ;; Records BEG and END, crucially convert them into LSP
- ;; (line/char) positions before that information is lost (because
- ;; the after-change thingy doesn't know if newlines were
- ;; deleted/added). Also record markers of BEG and END
- ;; (github#259)
- (push `(,(eglot--pos-to-lsp-position beg)
- ,(eglot--pos-to-lsp-position end)
- (,beg . ,(copy-marker beg nil))
- (,end . ,(copy-marker end t)))
- eglot--recent-changes)))
-
-(defun eglot--after-change (beg end pre-change-length)
- "Hook onto `after-change-functions'.
-Records BEG, END and PRE-CHANGE-LENGTH locally."
- (cl-incf eglot--versioned-identifier)
- (pcase (and (listp eglot--recent-changes)
- (car eglot--recent-changes))
- (`(,lsp-beg ,lsp-end
- (,b-beg . ,b-beg-marker)
- (,b-end . ,b-end-marker))
- ;; github#259 and github#367: With `capitalize-word' or somesuch,
- ;; `before-change-functions' always records the whole word's
- ;; `b-beg' and `b-end'. Similarly, when coalescing two lines
- ;; into one, `fill-paragraph' they mark the end of the first line
- ;; up to the end of the second line. In both situations, args
- ;; received here contradict that information: `beg' and `end'
- ;; will differ by 1 and will likely only encompass the letter
- ;; that was capitalized or, in the sentence-joining situation,
- ;; the replacement of the newline with a space. That's we keep
- ;; markers _and_ positions so we're able to detect and correct
- ;; this. We ignore `beg', `len' and `pre-change-len' and send
- ;; "fuller" information about the region from the markers. I've
- ;; also experimented with doing this unconditionally but it seems
- ;; to break when newlines are added.
- (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
- (or (/= beg b-beg) (/= end b-end)))
- (setcar eglot--recent-changes
- `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
- ,(buffer-substring-no-properties b-beg-marker
- b-end-marker)))
- (setcar eglot--recent-changes
- `(,lsp-beg ,lsp-end ,pre-change-length
- ,(buffer-substring-no-properties beg end)))))
- (_ (setf eglot--recent-changes :emacs-messup)))
- (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer))
- (let ((buf (current-buffer)))
- (setq eglot--change-idle-timer
- (run-with-idle-timer
- eglot-send-changes-idle-time
- nil (lambda () (eglot--when-live-buffer buf
- (when eglot--managed-mode
- (eglot--signal-textDocument/didChange)
- (setq eglot--change-idle-timer nil))))))))
-
-;; HACK! Launching a deferred sync request with outstanding changes is a
-;; bad idea, since that might lead to the request never having a
-;; chance to run, because `jsonrpc-connection-ready-p'.
-(advice-add #'jsonrpc-request :before
- (cl-function (lambda (_proc _method _params &key
- deferred &allow-other-keys)
- (when (and eglot--managed-mode deferred)
- (eglot--signal-textDocument/didChange))))
- '((name . eglot--signal-textDocument/didChange)))
-
-(defvar-local eglot-workspace-configuration ()
- "Alist of (SECTION . VALUE) entries configuring the LSP server.
-SECTION should be a keyword or a string, value can be anything
-that can be converted to JSON.")
-
-(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
-
-(defun eglot-signal-didChangeConfiguration (server)
- "Send a `:workspace/didChangeConfiguration' signal to SERVER.
-When called interactively, use the currently active server"
- (interactive (list (eglot--current-server-or-lose)))
- (jsonrpc-notify
- server :workspace/didChangeConfiguration
- (list
- :settings
- (cl-loop for (section . v) in eglot-workspace-configuration
- collect (if (keywordp section)
- section
- (intern (format ":%s" section)))
- collect v))))
-
-(cl-defmethod eglot-handle-request
- (server (_method (eql workspace/configuration)) &key items)
- "Handle server request workspace/configuration."
- (apply #'vector
- (mapcar
- (eglot--lambda ((ConfigurationItem) scopeUri section)
- (with-temp-buffer
- (let* ((uri-path (eglot--uri-to-path scopeUri))
- (default-directory
- (if (and (not (string-empty-p uri-path))
- (file-directory-p uri-path))
- uri-path
- (project-root (eglot--project server)))))
- (setq-local major-mode (eglot--major-mode server))
- (hack-dir-local-variables-non-file-buffer)
- (alist-get section eglot-workspace-configuration
- nil nil
- (lambda (wsection section)
- (string=
- (if (keywordp wsection)
- (substring (symbol-name wsection) 1)
- wsection)
- section))))))
- items)))
-
-(defun eglot--signal-textDocument/didChange ()
- "Send textDocument/didChange to server."
- (when eglot--recent-changes
- (let* ((server (eglot--current-server-or-lose))
- (sync-capability (eglot--server-capable :textDocumentSync))
- (sync-kind (if (numberp sync-capability) sync-capability
- (plist-get sync-capability :change)))
- (full-sync-p (or (eq sync-kind 1)
- (eq :emacs-messup eglot--recent-changes))))
- (jsonrpc-notify
- server :textDocument/didChange
- (list
- :textDocument (eglot--VersionedTextDocumentIdentifier)
- :contentChanges
- (if full-sync-p
- (vector `(:text ,(eglot--widening
- (buffer-substring-no-properties (point-min)
- (point-max)))))
- (cl-loop for (beg end len text) in (reverse eglot--recent-changes)
- ;; github#259: `capitalize-word' and commands based
- ;; on `casify_region' will cause multiple duplicate
- ;; empty entries in `eglot--before-change' calls
- ;; without an `eglot--after-change' reciprocal.
- ;; Weed them out here.
- when (numberp len)
- vconcat `[,(list :range `(:start ,beg :end ,end)
- :rangeLength len :text text)]))))
- (setq eglot--recent-changes nil)
- (setf (eglot--spinner server) (list nil :textDocument/didChange t))
- (jsonrpc--call-deferred server))))
-
-(defun eglot--signal-textDocument/didOpen ()
- "Send textDocument/didOpen to server."
- (setq eglot--recent-changes nil eglot--versioned-identifier 0)
- (jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
-
-(defun eglot--signal-textDocument/didClose ()
- "Send textDocument/didClose to server."
- (with-demoted-errors
- "[eglot] error sending textDocument/didClose: %s"
- (jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier)))))
-
-(defun eglot--signal-textDocument/willSave ()
- "Send textDocument/willSave to server."
- (let ((server (eglot--current-server-or-lose))
- (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
- (jsonrpc-notify server :textDocument/willSave params)
- (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
- (ignore-errors
- (eglot--apply-text-edits
- (jsonrpc-request server :textDocument/willSaveWaitUntil params
- :timeout 0.5))))))
-
-(defun eglot--signal-textDocument/didSave ()
- "Send textDocument/didSave to server."
- (eglot--signal-textDocument/didChange)
- (jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didSave
- (list
- ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
- :text (buffer-substring-no-properties (point-min) (point-max))
- :textDocument (eglot--TextDocumentIdentifier))))
-
-(defun eglot-flymake-backend (report-fn &rest _more)
- "An EGLOT Flymake backend.
-Calls REPORT-FN maybe if server publishes diagnostics in time."
- (setq eglot--current-flymake-report-fn report-fn)
- ;; Report anything unreported
- (when eglot--unreported-diagnostics
- (funcall report-fn (cdr eglot--unreported-diagnostics))
- (setq eglot--unreported-diagnostics nil)))
-
-(defun eglot-xref-backend () "EGLOT xref backend." 'eglot)
-
-(defvar eglot--temp-location-buffers (make-hash-table :test #'equal)
- "Helper variable for `eglot--handling-xrefs'.")
-
-(defvar eglot-xref-lessp-function #'ignore
- "Compare two `xref-item' objects for sorting.")
-
-(cl-defmacro eglot--collecting-xrefs ((collector) &rest body)
- "Sort and handle xrefs collected with COLLECTOR in BODY."
- (declare (indent 1) (debug (sexp &rest form)))
- (let ((collected (cl-gensym "collected")))
- `(unwind-protect
- (let (,collected)
- (cl-flet ((,collector (xref) (push xref ,collected)))
- ,@body)
- (sort ,collected eglot-xref-lessp-function))
- (maphash (lambda (_uri buf) (kill-buffer buf)) eglot--temp-location-buffers)
- (clrhash eglot--temp-location-buffers))))
-
-(defun eglot--xref-make-match (name uri range)
- "Like `xref-make-match' but with LSP's NAME, URI and RANGE.
-Try to visit the target file for a richer summary line."
- (pcase-let*
- ((file (eglot--uri-to-path uri))
- (visiting (or (find-buffer-visiting file)
- (gethash uri eglot--temp-location-buffers)))
- (collect (lambda ()
- (eglot--widening
- (pcase-let* ((`(,beg . ,end) (eglot--range-region range))
- (bol (progn (goto-char beg) (point-at-bol)))
- (substring (buffer-substring bol (point-at-eol)))
- (hi-beg (- beg bol))
- (hi-end (- (min (point-at-eol) end) bol)))
- (add-face-text-property hi-beg hi-end 'highlight
- t substring)
- (list substring (1+ (current-line)) (eglot-current-column)
- (- end beg))))))
- (`(,summary ,line ,column ,length)
- (cond
- (visiting (with-current-buffer visiting (funcall collect)))
- ((file-readable-p file) (with-current-buffer
- (puthash uri (generate-new-buffer " *temp*")
- eglot--temp-location-buffers)
- (insert-file-contents file)
- (funcall collect)))
- (t ;; fall back to the "dumb strategy"
- (let* ((start (cl-getf range :start))
- (line (1+ (cl-getf start :line)))
- (start-pos (cl-getf start :character))
- (end-pos (cl-getf (cl-getf range :end) :character)))
- (list name line start-pos (- end-pos start-pos)))))))
- (xref-make-match summary (xref-make-file-location file line column) length)))
-
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
- (eglot--error "cannot (yet) provide reliable completion table for LSP symbols"))
-
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
- ;; JT@19/10/09: This is a totally dummy identifier that isn't even
- ;; passed to LSP. The reason for this particular wording is to
- ;; construct a readable message "No references for LSP identifier at
- ;; point.". See http://github.com/joaotavora/eglot/issues/314
- "LSP identifier at point.")
-
-(defvar eglot--lsp-xref-refs nil
- "`xref' objects for overriding `xref-backend-references''s.")
-
-(cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability)
- "Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY."
- (unless (eglot--server-capable
- (or capability
- (intern
- (format ":%sProvider"
- (cadr (split-string (symbol-name method)
- "/"))))))
- (eglot--error "Sorry, this server doesn't do %s" method))
- (let ((response
- (jsonrpc-request
- (eglot--current-server-or-lose)
- method (append (eglot--TextDocumentPositionParams) extra-params))))
- (eglot--collecting-xrefs (collect)
- (mapc
- (eglot--lambda ((Location) uri range)
- (collect (eglot--xref-make-match (symbol-name (symbol-at-point))
- uri range)))
- (if (vectorp response) response (list response))))))
-
-(cl-defun eglot--lsp-xref-helper (method &key extra-params capability )
- "Helper for `eglot-find-declaration' & friends."
- (let ((eglot--lsp-xref-refs (eglot--lsp-xrefs-for-method
- method
- :extra-params extra-params
- :capability capability)))
- (if eglot--lsp-xref-refs
- (xref-find-references "LSP identifier at point.")
- (eglot--message "%s returned no references" method))))
-
-(defun eglot-find-declaration ()
- "Find declaration for SYM, the identifier at point."
- (interactive)
- (eglot--lsp-xref-helper :textDocument/declaration))
-
-(defun eglot-find-implementation ()
- "Find implementation for SYM, the identifier at point."
- (interactive)
- (eglot--lsp-xref-helper :textDocument/implementation))
-
-(defun eglot-find-typeDefinition ()
- "Find type definition for SYM, the identifier at point."
- (interactive)
- (eglot--lsp-xref-helper :textDocument/typeDefinition))
-
-(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) _identifier)
- (eglot--lsp-xrefs-for-method :textDocument/definition))
-
-(cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier)
- (or
- eglot--lsp-xref-refs
- (eglot--lsp-xrefs-for-method
- :textDocument/references :extra-params `(:context (:includeDeclaration t)))))
-
-(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
- (when (eglot--server-capable :workspaceSymbolProvider)
- (eglot--collecting-xrefs (collect)
- (mapc
- (eglot--lambda ((SymbolInformation) name location)
- (eglot--dbind ((Location) uri range) location
- (collect (eglot--xref-make-match name uri range))))
- (jsonrpc-request (eglot--current-server-or-lose)
- :workspace/symbol
- `(:query ,pattern))))))
-
-(defun eglot-format-buffer ()
- "Format contents of current buffer."
- (interactive)
- (eglot-format nil nil))
-
-(defun eglot-format (&optional beg end)
- "Format region BEG END.
-If either BEG or END is nil, format entire buffer.
-Interactively, format active region, or entire buffer if region
-is not active."
- (interactive (and (region-active-p) (list (region-beginning) (region-end))))
- (pcase-let ((`(,method ,cap ,args)
- (cond
- ((and beg end)
- `(:textDocument/rangeFormatting
- :documentRangeFormattingProvider
- (:range ,(list :start (eglot--pos-to-lsp-position beg)
- :end (eglot--pos-to-lsp-position end)))))
- (t
- '(:textDocument/formatting :documentFormattingProvider nil)))))
- (unless (eglot--server-capable cap)
- (eglot--error "Server can't format!"))
- (eglot--apply-text-edits
- (jsonrpc-request
- (eglot--current-server-or-lose)
- method
- (cl-list*
- :textDocument (eglot--TextDocumentIdentifier)
- :options (list :tabSize tab-width
- :insertSpaces (if indent-tabs-mode :json-false t))
- args)
- :deferred method))))
-
-(defun eglot-completion-at-point ()
- "EGLOT's `completion-at-point' function."
- ;; Commit logs for this function help understand what's going on.
- (when-let (completion-capability (eglot--server-capable :completionProvider))
- (let* ((server (eglot--current-server-or-lose))
- (sort-completions
- (lambda (completions)
- (cl-sort completions
- #'string-lessp
- :key (lambda (c)
- (or (plist-get
- (get-text-property 0 'eglot--lsp-item c)
- :sortText)
- "")))))
- (metadata `(metadata . ((display-sort-function . ,sort-completions))))
- resp items (cached-proxies :none)
- (proxies
- (lambda ()
- (if (listp cached-proxies) cached-proxies
- (setq resp
- (jsonrpc-request server
- :textDocument/completion
- (eglot--CompletionParams)
- :deferred :textDocument/completion
- :cancel-on-input t))
- (setq items (append
- (if (vectorp resp) resp (plist-get resp :items))
- nil))
- (setq cached-proxies
- (mapcar
- (jsonrpc-lambda
- (&rest item &key label insertText insertTextFormat
- &allow-other-keys)
- (let ((proxy
- (cond ((and (eql insertTextFormat 2)
- (eglot--snippet-expansion-fn))
- (string-trim-left label))
- ((and insertText
- (not (string-empty-p insertText)))
- insertText)
- (t
- (string-trim-left label)))))
- (unless (zerop (length item))
- (put-text-property 0 1 'eglot--lsp-item item proxy))
- proxy))
- items)))))
- (resolved (make-hash-table))
- (resolve-maybe
- ;; Maybe completion/resolve JSON object `lsp-comp' into
- ;; another JSON object, if at all possible. Otherwise,
- ;; just return lsp-comp.
- (lambda (lsp-comp)
- (or (gethash lsp-comp resolved)
- (setf (gethash lsp-comp resolved)
- (if (and (eglot--server-capable :completionProvider
- :resolveProvider)
- (plist-get lsp-comp :data))
- (jsonrpc-request server :completionItem/resolve
- lsp-comp :cancel-on-input t)
- lsp-comp)))))
- (bounds (bounds-of-thing-at-point 'symbol)))
- (list
- (or (car bounds) (point))
- (or (cdr bounds) (point))
- (lambda (probe pred action)
- (cond
- ((eq action 'metadata) metadata) ; metadata
- ((eq action 'lambda) ; test-completion
- (member probe (funcall proxies)))
- ((eq (car-safe action) 'boundaries) nil) ; boundaries
- ((and (null action) ; try-completion
- (member probe (funcall proxies)) t))
- ((eq action t) ; all-completions
- (cl-remove-if-not
- (lambda (proxy)
- (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
- (filterText (plist-get item :filterText)))
- (and (or (null pred) (funcall pred proxy))
- (string-prefix-p
- probe (or filterText proxy) completion-ignore-case))))
- (funcall proxies)))))
- :annotation-function
- (lambda (proxy)
- (eglot--dbind ((CompletionItem) detail kind)
- (get-text-property 0 'eglot--lsp-item proxy)
- (let* ((detail (and (stringp detail)
- (not (string= detail ""))
- detail))
- (annotation
- (or detail
- (cdr (assoc kind eglot--kind-names)))))
- (when annotation
- (concat " "
- (propertize annotation
- 'face 'font-lock-function-name-face))))))
- :company-doc-buffer
- (lambda (proxy)
- (let* ((documentation
- (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)))
- (plist-get (funcall resolve-maybe lsp-comp) :documentation)))
- (formatted (and documentation
- (eglot--format-markup documentation))))
- (when formatted
- (with-current-buffer (get-buffer-create " *eglot doc*")
- (erase-buffer)
- (insert formatted)
- (current-buffer)))))
- :company-require-match 'never
- :company-prefix-length
- (save-excursion
- (when (car bounds) (goto-char (car bounds)))
- (when (listp completion-capability)
- (looking-back
- (regexp-opt
- (cl-coerce (cl-getf completion-capability :triggerCharacters) 'list))
- (line-beginning-position))))
- :exit-function
- (lambda (proxy _status)
- ;; To assist in using this whole `completion-at-point'
- ;; function inside `completion-in-region', ensure the exit
- ;; function runs in the buffer where the completion was
- ;; triggered from. This should probably be in Emacs itself.
- ;; (github#505)
- (with-current-buffer (if (minibufferp)
- (window-buffer (minibuffer-selected-window))
- (current-buffer))
- (eglot--dbind ((CompletionItem) insertTextFormat
- insertText textEdit additionalTextEdits label)
- (funcall
- resolve-maybe
- (or (get-text-property 0 'eglot--lsp-item proxy)
- ;; When selecting from the *Completions*
- ;; buffer, `proxy' won't have any properties.
- ;; A lookup should fix that (github#148)
- (get-text-property
- 0 'eglot--lsp-item
- (cl-find proxy (funcall proxies) :test #'string=))))
- (let ((snippet-fn (and (eql insertTextFormat 2)
- (eglot--snippet-expansion-fn))))
- (cond (textEdit
- ;; Undo (yes, undo) the newly inserted completion.
- ;; If before completion the buffer was "foo.b" and
- ;; now is "foo.bar", `proxy' will be "bar". We
- ;; want to delete only "ar" (`proxy' minus the
- ;; symbol whose bounds we've calculated before)
- ;; (github#160).
- (delete-region (+ (- (point) (length proxy))
- (if bounds (- (cdr bounds) (car bounds)) 0))
- (point))
- (eglot--dbind ((TextEdit) range newText) textEdit
- (pcase-let ((`(,beg . ,end) (eglot--range-region range)))
- (delete-region beg end)
- (goto-char beg)
- (funcall (or snippet-fn #'insert) newText)))
- (when (cl-plusp (length additionalTextEdits))
- (eglot--apply-text-edits additionalTextEdits)))
- (snippet-fn
- ;; A snippet should be inserted, but using plain
- ;; `insertText'. This requires us to delete the
- ;; whole completion, since `insertText' is the full
- ;; completion's text.
- (delete-region (- (point) (length proxy)) (point))
- (funcall snippet-fn (or insertText label)))))
- (eglot--signal-textDocument/didChange)
- (eldoc))))))))
-
-(defun eglot--hover-info (contents &optional range)
- (let ((heading (and range (pcase-let ((`(,beg . ,end) (eglot--range-region range)))
- (concat (buffer-substring beg end) ": "))))
- (body (mapconcat #'eglot--format-markup
- (if (vectorp contents) contents (list contents)) "\n")))
- (when (or heading (cl-plusp (length body))) (concat heading body))))
-
-(defun eglot--sig-info (sigs active-sig active-param)
- (cl-loop
- for (sig . moresigs) on (append sigs nil) for i from 0
- concat
- (eglot--dbind ((SignatureInformation) label documentation parameters) sig
- (with-temp-buffer
- (save-excursion (insert label))
- (let (params-start params-end)
- ;; Ad-hoc attempt to parse label as <name>(<params>)
- (when (looking-at "\\([^(]+\\)(\\([^)]+\\))")
- (setq params-start (match-beginning 2) params-end (match-end 2))
- (add-face-text-property (match-beginning 1) (match-end 1)
- 'font-lock-function-name-face))
- (when (eql i active-sig)
- ;; Decide whether to add one-line-summary to signature line
- (when (and (stringp documentation)
- (string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)"
- documentation))
- (setq documentation (match-string 1 documentation))
- (unless (string-prefix-p (string-trim documentation) label)
- (goto-char (point-max))
- (insert ": " (eglot--format-markup documentation))))
- ;; Decide what to do with the active parameter...
- (when (and (eql i active-sig) active-param
- (< -1 active-param (length parameters)))
- (eglot--dbind ((ParameterInformation) label documentation)
- (aref parameters active-param)
- ;; ...perhaps highlight it in the formals list
- (when params-start
- (goto-char params-start)
- (pcase-let
- ((`(,beg ,end)
- (if (stringp label)
- (let ((case-fold-search nil))
- (and (re-search-forward
- (concat "\\<" (regexp-quote label) "\\>")
- params-end t)
- (list (match-beginning 0) (match-end 0))))
- (mapcar #'1+ (append label nil)))))
- (if (and beg end)
- (add-face-text-property
- beg end
- 'eldoc-highlight-function-argument))))
- ;; ...and/or maybe add its doc on a line by its own.
- (when documentation
- (goto-char (point-max))
- (insert "\n"
- (propertize
- (if (stringp label)
- label
- (apply #'buffer-substring (mapcar #'1+ label)))
- 'face 'eldoc-highlight-function-argument)
- ": " (eglot--format-markup documentation))))))
- (buffer-string))))
- when moresigs concat "\n"))
-
-(defun eglot-signature-eldoc-function (cb)
- "A member of `eldoc-documentation-functions', for signatures."
- (when (eglot--server-capable :signatureHelpProvider)
- (let ((buf (current-buffer)))
- (jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/signatureHelp (eglot--TextDocumentPositionParams)
- :success-fn
- (eglot--lambda ((SignatureHelp)
- signatures activeSignature activeParameter)
- (eglot--when-buffer-window buf
- (funcall cb
- (unless (seq-empty-p signatures)
- (eglot--sig-info signatures
- activeSignature
- activeParameter)))))
- :deferred :textDocument/signatureHelp))
- t))
-
-(defun eglot-hover-eldoc-function (cb)
- "A member of `eldoc-documentation-functions', for hover."
- (when (eglot--server-capable :hoverProvider)
- (let ((buf (current-buffer)))
- (jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/hover (eglot--TextDocumentPositionParams)
- :success-fn (eglot--lambda ((Hover) contents range)
- (eglot--when-buffer-window buf
- (let ((info (unless (seq-empty-p contents)
- (eglot--hover-info contents range))))
- (funcall cb info :buffer t))))
- :deferred :textDocument/hover))
- (eglot--highlight-piggyback cb)
- t))
-
-(defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.")
-
-(defun eglot--highlight-piggyback (_cb)
- "Request and handle `:textDocument/documentHighlight'"
- ;; FIXME: Obviously, this is just piggy backing on eldoc's calls for
- ;; convenience, as shown by the fact that we just ignore cb.
- (let ((buf (current-buffer)))
- (when (eglot--server-capable :documentHighlightProvider)
- (jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/documentHighlight (eglot--TextDocumentPositionParams)
- :success-fn
- (lambda (highlights)
- (mapc #'delete-overlay eglot--highlights)
- (setq eglot--highlights
- (eglot--when-buffer-window buf
- (mapcar
- (eglot--lambda ((DocumentHighlight) range)
- (pcase-let ((`(,beg . ,end)
- (eglot--range-region range)))
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face 'highlight)
- (overlay-put ov 'evaporate t)
- ov)))
- highlights))))
- :deferred :textDocument/documentHighlight)
- nil)))
-
-(defun eglot-imenu ()
- "EGLOT's `imenu-create-index-function'."
- (cl-labels
- ((visit (_name one-obj-array)
- (imenu-default-goto-function
- nil (car (eglot--range-region
- (eglot--dcase (aref one-obj-array 0)
- (((SymbolInformation) location)
- (plist-get location :range))
- (((DocumentSymbol) selectionRange)
- selectionRange))))))
- (unfurl (obj)
- (eglot--dcase obj
- (((SymbolInformation)) (list obj))
- (((DocumentSymbol) name children)
- (cons obj
- (mapcar
- (lambda (c)
- (plist-put
- c :containerName
- (let ((existing (plist-get c :containerName)))
- (if existing (format "%s::%s" name existing)
- name))))
- (mapcan #'unfurl children)))))))
- (mapcar
- (pcase-lambda (`(,kind . ,objs))
- (cons
- (alist-get kind eglot--symbol-kind-names "Unknown")
- (mapcan (pcase-lambda (`(,container . ,objs))
- (let ((elems (mapcar (lambda (obj)
- (list (plist-get obj :name)
- `[,obj] ;; trick
- #'visit))
- objs)))
- (if container (list (cons container elems)) elems)))
- (seq-group-by
- (lambda (e) (plist-get e :containerName)) objs))))
- (seq-group-by
- (lambda (obj) (plist-get obj :kind))
- (mapcan #'unfurl
- (jsonrpc-request (eglot--current-server-or-lose)
- :textDocument/documentSymbol
- `(:textDocument
- ,(eglot--TextDocumentIdentifier))))))))
-
-(defun eglot--apply-text-edits (edits &optional version)
- "Apply EDITS for current buffer if at VERSION, or if it's nil."
- (unless (or (not version) (equal version eglot--versioned-identifier))
- (jsonrpc-error "Edits on `%s' require version %d, you have %d"
- (current-buffer) version eglot--versioned-identifier))
- (atomic-change-group
- (let* ((change-group (prepare-change-group))
- (howmany (length edits))
- (reporter (make-progress-reporter
- (format "[eglot] applying %s edits to `%s'..."
- howmany (current-buffer))
- 0 howmany))
- (done 0))
- (mapc (pcase-lambda (`(,newText ,beg . ,end))
- (let ((source (current-buffer)))
- (with-temp-buffer
- (insert newText)
- (let ((temp (current-buffer)))
- (with-current-buffer source
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
-
- ;; On emacs versions < 26.2,
- ;; `replace-buffer-contents' is buggy - it calls
- ;; change functions with invalid arguments - so we
- ;; manually call the change functions here.
- ;;
- ;; See emacs bugs #32237, #32278:
- ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237
- ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278
- (let ((inhibit-modification-hooks t)
- (length (- end beg))
- (beg (marker-position beg))
- (end (marker-position end)))
- (run-hook-with-args 'before-change-functions
- beg end)
- (replace-buffer-contents temp)
- (run-hook-with-args 'after-change-functions
- beg (+ beg (length newText))
- length))))
- (progress-reporter-update reporter (cl-incf done)))))))
- (mapcar (eglot--lambda ((TextEdit) range newText)
- (cons newText (eglot--range-region range 'markers)))
- (reverse edits)))
- (undo-amalgamate-change-group change-group)
- (progress-reporter-done reporter))))
-
-(defun eglot--apply-workspace-edit (wedit &optional confirm)
- "Apply the workspace edit WEDIT. If CONFIRM, ask user first."
- (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit
- (let ((prepared
- (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits)
- (eglot--dbind ((VersionedTextDocumentIdentifier) uri version)
- textDocument
- (list (eglot--uri-to-path uri) edits version)))
- documentChanges))
- edit)
- (cl-loop for (uri edits) on changes by #'cddr
- do (push (list (eglot--uri-to-path uri) edits) prepared))
- (if (or confirm
- (cl-notevery #'find-buffer-visiting
- (mapcar #'car prepared)))
- (unless (y-or-n-p
- (format "[eglot] Server wants to edit:\n %s\n Proceed? "
- (mapconcat #'identity (mapcar #'car prepared) "\n ")))
- (eglot--error "User cancelled server edit")))
- (while (setq edit (car prepared))
- (pcase-let ((`(,path ,edits ,version) edit))
- (with-current-buffer (find-file-noselect path)
- (eglot--apply-text-edits edits version))
- (pop prepared))
- t)
- (unwind-protect
- (if prepared (eglot--warn "Caution: edits of files %s failed."
- (mapcar #'car prepared))
- (eldoc)
- (eglot--message "Edit successful!"))))))
-
-(defun eglot-rename (newname)
- "Rename the current symbol to NEWNAME."
- (interactive
- (list (read-from-minibuffer (format "Rename `%s' to: " (symbol-at-point))
- nil nil nil nil
- (symbol-name (symbol-at-point)))))
- (unless (eglot--server-capable :renameProvider)
- (eglot--error "Server can't rename!"))
- (eglot--apply-workspace-edit
- (jsonrpc-request (eglot--current-server-or-lose)
- :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
- :newName ,newname))
- current-prefix-arg))
-
-
-(defun eglot-code-actions (beg &optional end)
- "Offer to execute code actions between BEG and END.
-Interactively, if a region is active, BEG and END are its bounds,
-else BEG is point and END is nil, which results in a request for
-code actions at point"
- (interactive
- (if (region-active-p) `(,(region-beginning) ,(region-end)) `(,(point) nil)))
- (unless (eglot--server-capable :codeActionProvider)
- (eglot--error "Server can't execute code actions!"))
- (let* ((server (eglot--current-server-or-lose))
- (actions
- (jsonrpc-request
- server
- :textDocument/codeAction
- (list :textDocument (eglot--TextDocumentIdentifier)
- :range (list :start (eglot--pos-to-lsp-position beg)
- :end (eglot--pos-to-lsp-position end))
- :context
- `(:diagnostics
- [,@(cl-loop for diag in (flymake-diagnostics beg end)
- when (cdr (assoc 'eglot-lsp-diag (eglot--diag-data diag)))
- collect it)]))))
- (menu-items
- (or (mapcar (jsonrpc-lambda (&rest all &key title &allow-other-keys)
- (cons title all))
- actions)
- (eglot--error "No code actions here")))
- (preferred-action (cl-find-if
- (jsonrpc-lambda (&key isPreferred &allow-other-keys)
- isPreferred)
- actions))
- (menu `("Eglot code actions:" ("dummy" ,@menu-items)))
- (action (if (listp last-nonmenu-event)
- (x-popup-menu last-nonmenu-event menu)
- (cdr (assoc (completing-read "[eglot] Pick an action: "
- menu-items nil t
- nil nil (or (plist-get
- preferred-action
- :title)
- (car menu-items)))
- menu-items)))))
- (eglot--dcase action
- (((Command) command arguments)
- (eglot-execute-command server (intern command) arguments))
- (((CodeAction) edit command)
- (when edit (eglot--apply-workspace-edit edit))
- (when command
- (eglot--dbind ((Command) command arguments) command
- (eglot-execute-command server (intern command) arguments)))))))
-
-
-
-;;; Dynamic registration
-;;;
-(defun eglot--wildcard-to-regexp (wildcard)
- "(Very lame attempt to) convert WILDCARD to a Elisp regexp."
- (cl-loop
- with substs = '(("{" . "\\\\(")
- ("}" . "\\\\)")
- ("," . "\\\\|"))
- with string = (wildcard-to-regexp wildcard)
- for (pattern . rep) in substs
- for target = string then result
- for result = (replace-regexp-in-string pattern rep target)
- finally return result))
-
-(cl-defmethod eglot-register-capability
- (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers)
- "Handle dynamic registration of workspace/didChangeWatchedFiles"
- (eglot-unregister-capability server method id)
- (let* (success
- (globs (mapcar (eglot--lambda ((FileSystemWatcher) globPattern)
- globPattern)
- watchers))
- (glob-dirs
- (delete-dups (mapcar #'file-name-directory
- (mapcan #'file-expand-wildcards globs)))))
- (cl-labels
- ((handle-event
- (event)
- (pcase-let ((`(,desc ,action ,file ,file1) event))
- (cond
- ((and (memq action '(created changed deleted))
- (cl-find file globs
- :test (lambda (f glob)
- (string-match (eglot--wildcard-to-regexp
- (expand-file-name glob))
- f))))
- (jsonrpc-notify
- server :workspace/didChangeWatchedFiles
- `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
- :type ,(cl-case action
- (created 1)
- (changed 2)
- (deleted 3)))))))
- ((eq action 'renamed)
- (handle-event `(,desc 'deleted ,file))
- (handle-event `(,desc 'created ,file1)))))))
- (unwind-protect
- (progn
- (dolist (dir glob-dirs)
- (push (file-notify-add-watch dir '(change) #'handle-event)
- (gethash id (eglot--file-watches server))))
- (setq
- success
- `(:message ,(format "OK, watching %s directories in %s watchers"
- (length glob-dirs) (length watchers)))))
- (unless success
- (eglot-unregister-capability server method id))))))
-
-(cl-defmethod eglot-unregister-capability
- (server (_method (eql workspace/didChangeWatchedFiles)) id)
- "Handle dynamic unregistration of workspace/didChangeWatchedFiles"
- (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches server)))
- (remhash id (eglot--file-watches server))
- (list t "OK"))
-
-
-;;; Rust-specific
-;;;
-(defclass eglot-rls (eglot-lsp-server) () :documentation "Rustlang's RLS.")
-
-(cl-defmethod jsonrpc-connection-ready-p ((server eglot-rls) what)
- "Except for :completion, RLS isn't ready until Indexing done."
- (and (cl-call-next-method)
- (or ;; RLS normally ready for this, even if building.
- (eq :textDocument/completion what)
- (pcase-let ((`(,_id ,what ,done ,_detail) (eglot--spinner server)))
- (and (equal "Indexing" what) done)))))
-
-(cl-defmethod eglot-handle-notification
- ((server eglot-rls) (_method (eql window/progress))
- &key id done title message &allow-other-keys)
- "Handle notification window/progress"
- (setf (eglot--spinner server) (list id title done message)))
-
-
-;;; eclipse-jdt-specific
-;;;
-(defclass eglot-eclipse-jdt (eglot-lsp-server) ()
- :documentation "Eclipse's Java Development Tools Language Server.")
-
-(cl-defmethod eglot-initialization-options ((server eglot-eclipse-jdt))
- "Passes through required jdt initialization options"
- `(:workspaceFolders
- [,@(cl-delete-duplicates
- (mapcar #'eglot--path-to-uri
- (let* ((root (project-root (eglot--project server))))
- (cons root
- (mapcar
- #'file-name-directory
- (append
- (file-expand-wildcards (concat root "*/pom.xml"))
- (file-expand-wildcards (concat root "*/build.gradle"))
- (file-expand-wildcards (concat root "*/.project")))))))
- :test #'string=)]
- ,@(if-let ((home (or (getenv "JAVA_HOME")
- (ignore-errors
- (expand-file-name
- ".."
- (file-name-directory
- (file-chase-links (executable-find "javac"))))))))
- `(:settings (:java (:home ,home)))
- (ignore (eglot--warn "JAVA_HOME env var not set")))))
-
-(defun eglot--eclipse-jdt-contact (interactive)
- "Return a contact for connecting to eclipse.jdt.ls server, as a cons cell.
-If INTERACTIVE, prompt user for details."
- (cl-labels
- ((is-the-jar
- (path)
- (and (string-match-p
- "org\\.eclipse\\.equinox\\.launcher_.*\\.jar$"
- (file-name-nondirectory path))
- (file-exists-p path))))
- (let* ((classpath (or (getenv "CLASSPATH") ":"))
- (cp-jar (cl-find-if #'is-the-jar (split-string classpath ":")))
- (jar cp-jar)
- (dir
- (cond
- (jar (file-name-as-directory
- (expand-file-name ".." (file-name-directory jar))))
- (interactive
- (expand-file-name
- (read-directory-name
- (concat "Path to eclipse.jdt.ls directory (could not"
- " find it in CLASSPATH): ")
- nil nil t)))
- (t (error "Could not find eclipse.jdt.ls jar in CLASSPATH"))))
- (repodir
- (concat dir
- "org.eclipse.jdt.ls.product/target/repository/"))
- (repodir (if (file-directory-p repodir) repodir dir))
- (config
- (concat
- repodir
- (cond
- ((string= system-type "darwin") "config_mac")
- ((string= system-type "windows-nt") "config_win")
- (t "config_linux"))))
- (project (or (project-current) `(transient . ,default-directory)))
- (workspace
- (expand-file-name (md5 (project-root project))
- (concat user-emacs-directory
- "eglot-eclipse-jdt-cache"))))
- (unless jar
- (setq jar
- (cl-find-if #'is-the-jar
- (directory-files (concat repodir "plugins") t))))
- (unless (and jar (file-exists-p jar) (file-directory-p config))
- (error "Could not find required eclipse.jdt.ls files (build required?)"))
- (when (and interactive (not cp-jar)
- (y-or-n-p (concat "Add path to the server program "
- "to CLASSPATH environment variable?")))
- (setenv "CLASSPATH" (concat (getenv "CLASSPATH") ":" jar)))
- (unless (file-directory-p workspace)
- (make-directory workspace t))
- (cons 'eglot-eclipse-jdt
- (list (executable-find "java")
- "-Declipse.application=org.eclipse.jdt.ls.core.id1"
- "-Dosgi.bundles.defaultStartLevel=4"
- "-Declipse.product=org.eclipse.jdt.ls.core.product"
- "-jar" jar
- "-configuration" config
- "-data" workspace)))))
-
-(cl-defmethod eglot-execute-command
- ((_server eglot-eclipse-jdt) (_cmd (eql java.apply.workspaceEdit)) arguments)
- "Eclipse JDT breaks spec and replies with edits as arguments."
- (mapc #'eglot--apply-workspace-edit arguments))
-
-(provide 'eglot)
-;;; eglot.el ends here
-
-;; Local Variables:
-;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"
-;; bug-reference-url-format: "https://github.com/joaotavora/eglot/issues/%s"
-;; checkdoc-force-docstrings-flag: nil
-;; End:
diff --git a/elpa/eglot-1.7/eglot.elc b/elpa/eglot-1.7/eglot.elc
Binary files differ.
diff --git a/elpa/eglot-1.8.signed b/elpa/eglot-1.8.signed
@@ -0,0 +1 @@
+Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-01-12T23:05:02+0100 using RSA
+\ No newline at end of file
diff --git a/elpa/eglot-1.8/.dir-locals.el b/elpa/eglot-1.8/.dir-locals.el
@@ -0,0 +1,13 @@
+;;; Directory Local Variables
+;;; For more information see (info "(emacs) Directory Variables")
+
+((nil . ((sentence-end-double-space . t)
+ (fill-column . 70)))
+ (log-edit-mode . ((log-edit-font-lock-gnu-style . t)
+ (log-edit-setup-add-author . t)))
+ (change-log-mode . ((add-log-time-zone-rule . t)
+ (fill-column . 74)))
+ (diff-mode . ((mode . whitespace)))
+ (emacs-lisp-mode . ((indent-tabs-mode . nil)
+ (electric-quote-comment . nil)
+ (electric-quote-string . nil))))
diff --git a/elpa/eglot-1.8/Makefile b/elpa/eglot-1.8/Makefile
@@ -0,0 +1,73 @@
+### Makefile for EGLOT
+###
+# Variables
+#
+EMACS?=emacs
+SELECTOR=t
+ERROR_ON_WARN=nil
+
+LOAD_PATH=-L .
+
+ELFILES := eglot.el eglot-tests.el
+ELCFILES := $(ELFILES:.el=.elc)
+
+ELPADEPS ?=--eval '(package-initialize)' \
+ --eval '(package-refresh-contents)' \
+ --eval '(defun install-latest (p) \
+ (package-install \
+ (cadr (assoc p \
+ package-archive-contents \
+ (quote equal)))))' \
+ --eval '(install-latest (quote jsonrpc))' \
+ --eval '(install-latest (quote project))' \
+ --eval '(install-latest (quote xref))' \
+ --eval '(install-latest (quote eldoc))' \
+ --eval '(unintern \
+ (quote eldoc-documentation-function))' \
+ --eval '(load "eldoc")' \
+ --eval '(install-latest (quote company))' \
+ --eval '(install-latest (quote yasnippet))' \
+ --eval '(install-latest (quote flymake))'
+
+BYTECOMP_ERROR_ON_WARN := \
+ --eval '(setq byte-compile-error-on-warn $(ERROR_ON_WARN))'
+
+all: compile
+
+# Compilation. Note BYTECOMP_ERROR_ON_WARN after ELPADEPS
+# so deps can still warn on compilation.
+#
+%.elc: %.el
+ $(EMACS) -Q $(ELPADEPS) $(BYTECOMP_ERROR_ON_WARN) $(LOAD_PATH) \
+ --batch -f batch-byte-compile $<
+
+compile: $(ELCFILES)
+
+# Automated tests
+#
+eglot-check: compile
+ $(EMACS) -Q --batch \
+ $(ELPADEPS) \
+ $(LOAD_PATH) \
+ -l eglot \
+ -l eglot-tests \
+ --eval '(setq ert-batch-backtrace-right-margin 200)' \
+ --eval '(ert-run-tests-batch-and-exit (quote $(SELECTOR)))'
+
+eglot-check-noelpa: ELPADEPS=-f package-initialize
+eglot-check-noelpa: eglot-check
+
+interactive: compile
+ $(EMACS) -Q \
+ $(ELPADEPS) \
+ $(LOAD_PATH) \
+ -l eglot \
+ -l eglot-tests \
+
+check: eglot-check-noelpa
+
+# Cleanup
+#
+clean:
+ find . -iname '*.elc' -exec rm {} \;
+.PHONY: all compile clean check
diff --git a/elpa/eglot-1.8/NEWS.md b/elpa/eglot-1.8/NEWS.md
@@ -0,0 +1,315 @@
+# 1.8 (12/1/2022)
+
+##### Multiple servers supported out-of-box for same major mode ([#688][github#688])
+
+In practice, this removes the need for Eglot to "officially" bless one
+server over another. Thanks to Felicián Németh for the original idea.
+
+##### TRAMP support ([#637][github#637], [#463][github#463], [#84][github#84])
+
+Thanks to Brian Cully for the minimalist approach.
+
+(also thanks to Felipe Lema who conducted many early experiments in
+[#463][github#463])
+
+##### `eglot-ignored-server-capabilities` now correctly spelled ([#724][github#724])
+
+This user-visible variable used to be spelled
+`eglot-ignored-server-capabilites`, which is still a valid but
+obsolete name.
+
+##### Manage cross-referenced files outside project ([#76][github#76], [#686][github#686], [#695][github#695])
+
+This is activated by a new customization option
+`eglot-extend-to-xref`, which defaults to nil.
+
+Thanks to Michael Livshin for the investigation an elegant solution.
+
+##### Code action shortcuts ([#411][github#411])
+
+`M-x eglot-code-actions` accepts an optional `action-kind` argument,
+specified interactively with `C-u`. Other shortcuts call specific
+actions directly (`eglot-code-action-inline`,
+`eglot-code-action-extract`, `eglot-code-action-rewrite`,
+`eglot-code-action-organize-imports` and
+`eglot-code-action-quickfix`). One can create own shortcuts for code
+actions with specific a kind by calling `eglot-code-actions` from
+elisp.
+
+##### New command `eglot-shutdown-server` ([#643][github#643])
+
+##### New variable `eglot-withhold-process-id` ([#722][github#722])
+If non-nil, Eglot will not send the Emacs process id to the language server.
+This can be useful when using docker to run a language server.
+
+##### Several new servers have been added to `eglot-server-programs`.
+- cmake-language-server ([#787][github#787])
+- css-languageserver ([#204][github#204], [#769][github#769])
+- fortls ([#603][github#603])
+- html-languageserver ([#204][github#204], [#769][github#769])
+- json-languageserver ([#204][github#204], [#769][github#769])
+- lua-lsp ([#721][github#721])
+- mint ls ([#750][github#750])
+- pyright ([#742][github#742])
+- vim-language-server ([#787][github#787])
+- yaml-language-server ([#751][github#751])
+- zls ([#646][github#646])
+
+# 1.7 (16/12/2020)
+
+##### Support hierarchical symbols in Imenu ([#303][github#303])
+
+Thanks to Ingo Lohmar for the original implementation.
+
+##### Handle multiple "documentation at point" sources ([#439][github#439], [#494][github#494], [#481][github#481], [#454][github#454])
+
+Such sources include as LSP's signature, hover and also the Flymake
+diagnostic messages. They can all be presented in the echo area
+(space permitting), or via `C-h .`. For now, composition of different
+sources can be customized using `eldoc-documentation-strategy`,
+`eldoc-echo-area-use-multiline-p` and `eldoc-prefer-doc-buffer`.
+
+The variables `eglot-put-doc-in-help-buffer` and
+`eglot-auto-display-help-buffer` have been removed.
+
+# 1.6 (16/04/2020)
+
+##### Column offset calculation is now LSP-conform ([#361][github#361])
+
+It seems the majority of servers now comply with the language server
+specification when it comes to handling non-ASCII texts. Therefore
+the default values of `eglot-move-to-column-function` and
+`eglot-current-column-function` have been changed. The documentations
+of these variables help to restore the old behavior.
+
+##### Support workspace/configuration requests ([#326][github#326])
+
+Also a new section "Per-project server configuration" in the README.md
+should answer some faq's in this regard.
+
+# 1.5 (20/10/2019)
+
+Thanks a lot to Felicián Németh, Ingo Lohmar, and everyone else who
+helped out!
+
+##### Take over Company configuration ([#324][github#324])
+
+Similar to what was already the case with Flymake, Eldoc and Xref, use
+just the backend that can do something useful in Eglot,
+`company-capf`. See `eglot-stay-out-of` to opt out of this.
+
+##### New option `eglot-autoshutdown` to disconnect after last buffer killed ([#217][github#217], [#270][github#270])
+
+##### Fix completion support ([#235][github#235], [#313][github#313], [#311][github#311], [#279][github#279])
+
+Among other things, consider LSP's "filterText" cookies, which enables
+a kind of poor-man's flex-matching for some backends.
+
+##### Support LSP's "goto declaration/implementation/typeDefinition" ([#302][github#302])
+
+##### New option `eglot-send-changes-idle-time` ([#258][github#258])
+
+##### Prevent Eldoc flicker when moving around ([#198][github#198])
+
+##### Show large docs in help buffer instead of echo area by default ([#198][github#198])
+
+Also add two new customization variables
+`eglot-put-doc-in-help-buffer` and `eglot-auto-display-help-buffer`.
+
+##### Add built-in support for Go, Elixir and Ada ([#304][github#304], [#264][github#264], [#316][github#316])
+
+# 1.4 (5/1/2019)
+
+##### Correct param highlighting in the first line of signature
+
+##### Display documentation strings with `gfm-view-mode`
+
+##### Remove hard dependencies on `flymake-mode`
+
+You can turn it off now in buffers managed by Eglot.
+
+##### Run connection hooks with proper directory local variables ([#196][github#196])
+
+This fixes issues with suspiciously empty `didChangeConfiguration`
+messages that are supposed to communicate parameters from a
+directory-set `eglot-workspace-configuration`.
+
+##### Fix completion sorting ([#190][github#190])
+
+##### Take over Flymake and Eldoc completely while managing buffers
+
+No longer try to add Eglot's facilities to existing facilities in
+these two domains.
+
+# 1.3 (10/12/2018)
+
+##### Control strictness towards incoming LSP messages ([#144][github#144], [#156][github#156])
+
+##### Add brief context after `xref-find-references` when available ([#52][github#52])
+
+##### Support `completionContext` to help servers like `ccls`.
+
+##### Use Flymake from GNU ELPA ([#178][github#178])
+
+# 1.2 (23/11/2018)
+
+##### Support snippet completions ([#50][github#50])
+
+Use `yasnippet.el` for this, if it is installed.
+
+##### Implement `workspace/didChangeConfiguration` ([#29][github#29])
+
+##### Handle experimental/unknown server methods gracefully ([#39][github#39])
+
+##### Accept functions as entries in `eglot-server-programs` ([#63][github#63])
+
+`CONTACT` in the `(MAJOR-MODE . CONTACT)` association in
+`eglot-server-programs` can now be a function of no arguments
+producing any value previously valid for contact. Functions can be
+interactive on non-interactive.
+
+##### Snappier completions that don't hinder typing ([#61][github#61])
+
+##### Consider `:triggerCharacters` in company completion ([#80][github#80])
+
+##### Add support for `TextEdit`s in completion
+
+##### Prefer ccls over cquery for C/C++ ([#94][github#94])
+
+##### `eglot-ignored-server-capabilites` is more user-friendly ([#126][github#126])
+
+##### Implement asynchronous server connection ([#68][github#68])
+
+A new defcustom `eglot-sync-connect` controls this feature.
+
+##### Add a generic `eglot-execute-command` API
+
+Work by Michał K.
+
+##### Prompt for server in `eglot-shutdown` ([#73][github#73])
+
+##### Add support for code action literals
+
+##### Add support for the Eclipse JDT language server ([#63][github#63])
+
+##### Add out-of-the-box support for Haskell, Kotlin, Go, Ocaml, R
+
+##### Add the ability to move to LSP-precise columns ([#124][github#124])
+
+Some servers like `clangd` follow the spec very closely here.
+
+##### Fix a potential security issue fontifying LSP doc ([#154][github#154])
+
+##### Fix many, many bugs
+
+[#44][github#44], [#48][github#48], [#54][github#54], [#58][github#58], [#64][github#64], [#74][github#74], [#81][github#81], [#82][github#82], [#86][github#86], [#87][github#87], [#83][github#83], [#93][github#93], [#100][github#100], [#115][github#115], [#120][github#120], [#121][github#121], [#126][github#126], [#138][github#138], [#144][github#144], [#158][github#158], [#160][github#160], [#167][github#167]
+
+# 1.1 (9/7/2018)
+
+##### Implement TCP autostart/autoconnect (and support Ruby's Solargraph)
+
+The `:autoport` symbol in the server incovation is replaced
+dynamically by a local port believed to be vacant, so that the ensuing
+TCP connection finds a listening server.
+
+##### Eglot now depends on Emacs library `jsonrpc.el`.
+
+##### Assorted bugfixes
+
+<!--- Now a bunch of references that I auto-generate with
+
+(cl-loop
+ with pivot
+ initially
+ (goto-char (point-min))
+ (search-forward-regexp "and now said bunch of references...\n")
+ (setq pivot (point))
+ (goto-char (point-min))
+ while (and (search-forward-regexp "github#\\([0-9]+\\)" nil t)
+ (< (point) pivot))
+ collect (string-to-number (match-string 1)) into refs
+ finally (setq refs (delete-dups refs))
+ (goto-char pivot)
+ (delete-region pivot (point-max))
+ (cl-loop for ref in (sort refs #'<)
+ do (insert (format "[github#%d]: https://github.com/joaotavora/eglot/issues/%d\n" ref ref))))
+
+and now said bunch of references-->
+[github#29]: https://github.com/joaotavora/eglot/issues/29
+[github#39]: https://github.com/joaotavora/eglot/issues/39
+[github#44]: https://github.com/joaotavora/eglot/issues/44
+[github#48]: https://github.com/joaotavora/eglot/issues/48
+[github#50]: https://github.com/joaotavora/eglot/issues/50
+[github#52]: https://github.com/joaotavora/eglot/issues/52
+[github#54]: https://github.com/joaotavora/eglot/issues/54
+[github#58]: https://github.com/joaotavora/eglot/issues/58
+[github#61]: https://github.com/joaotavora/eglot/issues/61
+[github#63]: https://github.com/joaotavora/eglot/issues/63
+[github#64]: https://github.com/joaotavora/eglot/issues/64
+[github#68]: https://github.com/joaotavora/eglot/issues/68
+[github#73]: https://github.com/joaotavora/eglot/issues/73
+[github#74]: https://github.com/joaotavora/eglot/issues/74
+[github#76]: https://github.com/joaotavora/eglot/issues/76
+[github#80]: https://github.com/joaotavora/eglot/issues/80
+[github#81]: https://github.com/joaotavora/eglot/issues/81
+[github#82]: https://github.com/joaotavora/eglot/issues/82
+[github#83]: https://github.com/joaotavora/eglot/issues/83
+[github#84]: https://github.com/joaotavora/eglot/issues/84
+[github#86]: https://github.com/joaotavora/eglot/issues/86
+[github#87]: https://github.com/joaotavora/eglot/issues/87
+[github#93]: https://github.com/joaotavora/eglot/issues/93
+[github#94]: https://github.com/joaotavora/eglot/issues/94
+[github#100]: https://github.com/joaotavora/eglot/issues/100
+[github#115]: https://github.com/joaotavora/eglot/issues/115
+[github#120]: https://github.com/joaotavora/eglot/issues/120
+[github#121]: https://github.com/joaotavora/eglot/issues/121
+[github#124]: https://github.com/joaotavora/eglot/issues/124
+[github#126]: https://github.com/joaotavora/eglot/issues/126
+[github#138]: https://github.com/joaotavora/eglot/issues/138
+[github#144]: https://github.com/joaotavora/eglot/issues/144
+[github#154]: https://github.com/joaotavora/eglot/issues/154
+[github#156]: https://github.com/joaotavora/eglot/issues/156
+[github#158]: https://github.com/joaotavora/eglot/issues/158
+[github#160]: https://github.com/joaotavora/eglot/issues/160
+[github#167]: https://github.com/joaotavora/eglot/issues/167
+[github#178]: https://github.com/joaotavora/eglot/issues/178
+[github#190]: https://github.com/joaotavora/eglot/issues/190
+[github#196]: https://github.com/joaotavora/eglot/issues/196
+[github#198]: https://github.com/joaotavora/eglot/issues/198
+[github#204]: https://github.com/joaotavora/eglot/issues/204
+[github#217]: https://github.com/joaotavora/eglot/issues/217
+[github#235]: https://github.com/joaotavora/eglot/issues/235
+[github#258]: https://github.com/joaotavora/eglot/issues/258
+[github#264]: https://github.com/joaotavora/eglot/issues/264
+[github#270]: https://github.com/joaotavora/eglot/issues/270
+[github#279]: https://github.com/joaotavora/eglot/issues/279
+[github#302]: https://github.com/joaotavora/eglot/issues/302
+[github#303]: https://github.com/joaotavora/eglot/issues/303
+[github#304]: https://github.com/joaotavora/eglot/issues/304
+[github#311]: https://github.com/joaotavora/eglot/issues/311
+[github#313]: https://github.com/joaotavora/eglot/issues/313
+[github#316]: https://github.com/joaotavora/eglot/issues/316
+[github#324]: https://github.com/joaotavora/eglot/issues/324
+[github#326]: https://github.com/joaotavora/eglot/issues/326
+[github#361]: https://github.com/joaotavora/eglot/issues/361
+[github#411]: https://github.com/joaotavora/eglot/issues/411
+[github#439]: https://github.com/joaotavora/eglot/issues/439
+[github#454]: https://github.com/joaotavora/eglot/issues/454
+[github#463]: https://github.com/joaotavora/eglot/issues/463
+[github#481]: https://github.com/joaotavora/eglot/issues/481
+[github#494]: https://github.com/joaotavora/eglot/issues/494
+[github#603]: https://github.com/joaotavora/eglot/issues/603
+[github#637]: https://github.com/joaotavora/eglot/issues/637
+[github#643]: https://github.com/joaotavora/eglot/issues/643
+[github#646]: https://github.com/joaotavora/eglot/issues/646
+[github#686]: https://github.com/joaotavora/eglot/issues/686
+[github#688]: https://github.com/joaotavora/eglot/issues/688
+[github#695]: https://github.com/joaotavora/eglot/issues/695
+[github#721]: https://github.com/joaotavora/eglot/issues/721
+[github#722]: https://github.com/joaotavora/eglot/issues/722
+[github#724]: https://github.com/joaotavora/eglot/issues/724
+[github#742]: https://github.com/joaotavora/eglot/issues/742
+[github#750]: https://github.com/joaotavora/eglot/issues/750
+[github#751]: https://github.com/joaotavora/eglot/issues/751
+[github#769]: https://github.com/joaotavora/eglot/issues/769
+[github#787]: https://github.com/joaotavora/eglot/issues/787
diff --git a/elpa/eglot-1.8/README.md b/elpa/eglot-1.8/README.md
@@ -0,0 +1,604 @@
+[](https://travis-ci.org/joaotavora/eglot)
+[](https://elpa.gnu.org/packages/eglot.html)
+[](https://melpa.org/#/eglot)
+
+# M-x Eglot
+
+*E*macs Poly*glot*: an Emacs [LSP][lsp] client that stays out of your
+way:
+
+* 📽 Scroll down this README for some [pretty gifs](#animated_gifs)
+* 📚 Read about [servers](#connecting), [commands and
+ keybindings](#commands), and [customization](#customization)
+* 📣 Read the [NEWS][news] file
+* 🏆 Folks over at Google [seem to like it][gospb]. Thanks!
+
+# _1-2-3_
+
+Install from [GNU ELPA][gnuelpa] or [MELPA][melpa]. Just type `M-x
+package-install RET eglot RET` into Emacs 26.1+.
+
+Now find some source file, any source file, and type `M-x eglot`.
+
+*That's it*. If you're lucky, this guesses the LSP program to start
+for the language you're using. Otherwise, it prompts you to enter one.
+
+### _1-2-3-pitfall!_
+
+By design, Eglot doesn't depend on anything but Emacs. But there
+_are_ ELPA dependencies to newer versions of so-called "core packages"
+developed _in the Emacs mainline_. So unless you're using a
+bleeding-edge Emacs, where loading `eglot.el` is all you'd need to do,
+make sure your package system pulls in and loads the newest
+`project.el`, `xref.el`, `eldoc.el`, etc... In case of trouble `M-x
+find-library` can help you tell if that happened.
+
+<a name="connecting"></a>
+# Connecting to a server
+
+`M-x eglot` can guess and work out-of-the-box with these servers:
+
+* Javascript's [TS & JS Language Server ][typescript-language-server]
+* Rust's [rls][rls]
+* Python's [pylsp][pylsp], [pyls][pyls] or [pyright][pyright]
+* Ruby's [solargraph][solargraph]
+* Java's [Eclipse JDT Language Server][eclipse-jdt]
+* Bash's [bash-language-server][bash-language-server]
+* PHP's [php-language-server][php-language-server]
+* C/C++'s [clangd][clangd] or [ccls][ccls]
+* Haskell's [haskell-language-server][haskell-language-server]
+* Elm's [elm-language-server][elm-language-server]
+* Mint's [mint-ls][mint-ls]
+* Kotlin's [kotlin-language-server][kotlin-language-server]
+* Go's [gopls][gopls]
+* Ocaml's [ocaml-lsp][ocaml-lsp]
+* R's [languageserver][r-languageserver]
+* Dart's [dart_language_server][dart_language_server]
+* Elixir's [elixir-ls][elixir-ls]
+* Erlang's [erlang_ls][erlang_ls]
+* Ada's [ada_language_server][ada_language_server]
+* Scala's [metals][metals]
+* TeX/LaTeX's [Digestif][digestif]
+* Nix's [rnix-lsp][rnix-lsp]
+* Godot Engine's [built-in LSP][godot]
+* Fortran's [fortls][fortls]
+* Zig's [zls][zls]
+* FSharp's [fsharp-mode][fsharp-mode] (Needs to `(require 'eglot-fsharp)` first)
+* YAML's [yaml-language-server][yaml-language-server]
+* Lua's [lua-lsp][lua-lsp]
+* HTML [html-languageserver][html-languageserver]
+* CSS's [css-languageserver][css-languageserver]
+* JSON's [vscode-json-languageserver][vscode-json-languageserver]
+* Dockerfile's [docker-langserver][docker-langserver]
+* CMake's [cmake-language-server][cmake-language-server]
+* VimScript's [vim-language-server][vim-language-server]
+
+I'll add to this list as I test more servers. In the meantime you can
+customize `eglot-server-programs`:
+
+```lisp
+(add-to-list 'eglot-server-programs '(foo-mode . ("foo-language-server" "--args")))
+```
+
+Let me know how well it works and we can add it to the list.
+
+To skip the guess and always be prompted use `C-u M-x eglot`.
+
+## Connecting automatically
+
+You can also do:
+
+```lisp
+ (add-hook 'foo-mode-hook 'eglot-ensure)
+```
+
+, to attempt to start an eglot session automatically every time a
+`foo-mode` buffer is visited.
+
+## Connecting via TCP
+
+The examples above use a "pipe" to talk to the server, which works
+fine on Linux and OSX but in some cases
+[*may not work on Windows*][windows-subprocess-hang].
+
+To circumvent this limitation, or if the server doesn't like pipes,
+you can use `C-u M-x eglot` and give it `server:port` pattern to
+connect to a previously started TCP server serving LSP information.
+
+If you don't want to start it manually every time, you can configure
+Eglot to start it and immediately connect to it. Ruby's
+[solargraph][solargraph] server already works this way out-of-the-box.
+
+For another example, suppose you also wanted start Python's `pyls`
+this way:
+
+```lisp
+(add-to-list 'eglot-server-programs
+ `(python-mode . ("pyls" "-v" "--tcp" "--host"
+ "localhost" "--port" :autoport)))
+```
+
+You can see that the element associated with `python-mode` is now a
+more complicated invocation of the `pyls` program, which requests that
+it be started as a server. Notice the `:autoport` symbol in there: it
+is replaced dynamically by a local port believed to be vacant, so that
+the ensuing TCP connection finds a listening server.
+
+## Per-project server configuration
+
+Most servers can guess good defaults and will operate nicely
+out-of-the-box, but some need to be configured specially via LSP
+interfaces. Additionally, in some situations, you may also want a
+particular server to operate differently across different projects.
+
+Per-project settings are realized with Emacs's _directory variables_
+and the Elisp variable `eglot-workspace-configuration`. To make a
+particular Python project always enable Pyls's snippet support, put a
+file named `.dir-locals.el` in the project's root:
+
+```lisp
+((python-mode
+ . ((eglot-workspace-configuration
+ . ((:pyls . (:plugins (:jedi_completion (:include_params t)))))))))
+```
+
+This tells Emacs that any `python-mode` buffers in that directory
+should have a particular buffer-local value of
+`eglot-workspace-configuration`. That variable's value should be
+_association list_ of _parameter sections_ which are presumably
+understood by the server. In this example, we associate section
+`pyls` with the parameters object `(:plugins (:jedi_completion
+(:include_params t)))`.
+
+Now, supposing that you also had some Go code in the very same
+project, you can configure the Gopls server in the same file. Adding
+a section for `go-mode`, the file's contents become:
+
+```lisp
+((python-mode
+ . ((eglot-workspace-configuration
+ . ((:pyls . (:plugins (:jedi_completion (:include_params t))))))))
+ (go-mode
+ . ((eglot-workspace-configuration
+ . ((:gopls . (:usePlaceholders t)))))))
+```
+
+If you can't afford an actual `.dir-locals.el` file, or if managing
+these files becomes cumbersome, the Emacs manual teaches you
+programmatic ways to leverage per-directory local variables.
+
+## Handling quirky servers
+
+Some servers need even more special hand-holding to operate correctly.
+If your server has some quirk or non-conformity, it's possible to
+extend Eglot via Elisp to adapt to it. Here's an example on how to
+get [cquery][cquery] working:
+
+```lisp
+(add-to-list 'eglot-server-programs '((c++ mode c-mode) . (eglot-cquery "cquery")))
+
+(defclass eglot-cquery (eglot-lsp-server) ()
+ :documentation "A custom class for cquery's C/C++ langserver.")
+
+(cl-defmethod eglot-initialization-options ((server eglot-cquery))
+ "Passes through required cquery initialization options"
+ (let* ((root (car (project-roots (eglot--project server))))
+ (cache (expand-file-name ".cquery_cached_index/" root)))
+ (list :cacheDirectory (file-name-as-directory cache)
+ :progressReportFrequencyMs -1)))
+```
+
+See `eglot.el`'s section on Java's JDT server for an even more
+sophisticated example.
+
+Similarly, some servers require the language identifier strings they
+are sent by `eglot` to match the exact strings used by VSCode. `eglot`
+usually guesses these identifiers from the major mode name
+(e.g. `elm-mode` → `"elm"`), but the mapping can be overridden using
+the `:LANGUAGE-ID` element in the syntax of `eglot-server-programs` if
+necessary.
+
+## TRAMP support
+
+Should just work. Try `M-x eglot` in a buffer visiting a remote file
+on a server where you've also installed the language server. Only
+supported on Emacs 27.1 or later.
+
+Emacs 27 users may find some language servers [fail to start up over
+TRAMP](https://github.com/joaotavora/eglot/issues/662). If you experience this
+issue, update TRAMP to 2.5.0.4 or later.
+
+<a name="reporting bugs"></a>
+# Reporting bugs
+
+Having trouble connecting to a server? Expected to have a certain
+capability supported by it (e.g. completion) but nothing happens? Or
+do you get spurious and annoying errors in an otherwise smooth
+operation? We may have help, so open a [new
+issue](https://github.com/joaotavora/eglot/issues) and try to be as
+precise and objective about the problem as you can:
+
+1. Include the invaluable **events transcript**. You can display that
+ buffer with `M-x eglot-events-buffer`. It contains the JSONRPC
+ messages exchanged between client and server, as well as the
+ messages the server prints to stderr.
+
+2. If Emacs errored (you saw -- and possibly heard -- an error
+ message), make sure you repeat the process using `M-x
+ toggle-debug-on-error` so you **get a backtrace** of the error that
+ you should also attach to the bug report.
+
+3. Try to replicate the problem with **as clean an Emacs run as
+ possible**. This means an empty `.emacs` init file or close to it
+ (just loading `eglot.el`, `company.el` and `yasnippet.el` for
+ example, and you don't even need `use-package.el` to do that).
+
+Some more notes: it is often the case the you will have to report the
+problem to the LSP server's developers, too, though it's
+understandable that you report it Eglot first, since it is the
+user-facing frontend first. If the problem is indeed on Eglot's side,
+we _do_ want to fix it, but because Eglot's developers have limited
+resources and no way to test all the possible server combinations,
+you'll sometimes have to do most of the testing.
+
+<a name="commands"></a>
+# Commands and keybindings
+
+Here's a summary of available commands:
+
+- `M-x eglot`, as described above;
+
+- `M-x eglot-reconnect` reconnects to current server;
+
+- `M-x eglot-shutdown` says bye-bye to server of your choice;
+
+- `M-x eglot-shutdown-all` says bye-bye to every server;
+
+- `M-x eglot-rename` ask the server to rename the symbol at point;
+
+- `M-x eglot-format` asks the server to format buffer or the active
+ region;
+
+- `M-x eglot-code-actions` asks the server for any "code actions" at
+ point. Can also be invoked by `mouse-1`-clicking some diagnostics.
+ Also `M-x eglot-code-action-<TAB>` for shortcuts to specific actions.
+
+- `M-x eldoc` asks the Eldoc system for help at point (this command
+ isn't specific to Eglot, by the way, it works in other contexts).
+
+- `M-x eglot-events-buffer` jumps to the events buffer for debugging
+ communication with the server.
+
+- `M-x eglot-stderr-buffer` if the LSP server is printing useful debug
+information in stderr, jumps to a buffer with these contents.
+
+- `M-x eglot-signal-didChangeConfiguration` updates the LSP server
+configuration according to the value of the variable
+`eglot-workspace-configuration`, which you may be set in a
+`.dir-locals` file, for example.
+
+There are *no keybindings* specific to Eglot, but you can bind stuff
+in `eglot-mode-map`, which is active as long as Eglot is managing a
+file in your project. The commands don't need to be Eglot-specific,
+either:
+
+```lisp
+(define-key eglot-mode-map (kbd "C-c r") 'eglot-rename)
+(define-key eglot-mode-map (kbd "C-c o") 'eglot-code-action-organize-imports)
+(define-key eglot-mode-map (kbd "C-c h") 'eldoc)
+(define-key eglot-mode-map (kbd "<f6>") 'xref-find-definitions)
+```
+
+<a name="customization"></a>
+# Customization
+
+Here's a quick summary of the customization options. In Eglot's
+customization group (`M-x customize-group`) there is more
+documentation on what these do.
+
+- `eglot-autoreconnect`: Control ability to reconnect automatically to
+ the LSP server;
+
+- `eglot-connect-timeout`: Number of seconds before timing out LSP
+ connection attempts;
+
+- `eglot-sync-connect`: Control blocking of LSP connection attempts;
+
+- `eglot-events-buffer-size`: Control the size of the Eglot events
+ buffer;
+
+- `eglot-ignored-server-capabilities`: LSP server capabilities that
+ Eglot could use, but won't;
+
+- `eglot-confirm-server-initiated-edits`: If non-nil, ask for confirmation
+ before allowing server to edit the source buffer's text;
+
+There are a couple more variables that you can customize via Emacs
+lisp:
+
+- `eglot-server-programs`: as described [above](#connecting);
+
+- `eglot-strict-mode`: Set to `nil` by default, meaning Eglot is
+ generally lenient about non-conforming servers. Set this to
+ `(disallow-non-standard-keys enforce-required-keys)` when debugging
+ servers.
+
+- `eglot-server-initialized-hook`: Hook run after server is
+ successfully initialized;
+
+- `eglot-managed-mode-hook`: Hook run after Eglot started or stopped
+ managing a buffer. Use `eglot-managed-p` to tell if current buffer
+ is still being managed.
+
+- `eglot-stay-out-of`: List of Emacs features that Eglot shouldn't
+ automatically try to manage on users' behalf. Useful when you need
+ non-LSP Flymake or Company backends. See docstring for examples.
+
+- `eglot-extend-to-xref`: If non-nil and `xref-find-definitions` lands
+ you in a file outside your project -- like a system-installed
+ library or header file -- transiently consider it managed by the
+ same LSP server. That file is still outside your project
+ (i.e. `project-find-file` won't find it).
+
+# How does Eglot work?
+
+`M-x eglot` starts a server via a shell-command guessed from
+`eglot-server-programs`, using the current major-mode (for whatever
+language you're programming in) as a hint.
+
+If the connection is successful, you see an `[eglot:<server>]`
+indicator pop up in your mode-line. More importantly, this means
+current *and future* file buffers of that major mode *inside your
+current project* automatically become \"managed\" by the LSP server,
+This means that information about these file's contents is exchanged
+periodically to provide enhanced coding assistance. Eglot works
+primarily with Emacs' built-in libraries and _not_ with third-party
+replacements for those facilities.
+
+* definitions can be found via `xref-find-definitions`;
+* on-the-fly diagnostics are given by `flymake-mode`;
+* function signature hints are given by `eldoc-mode`;
+* completion can be summoned with `completion-at-point`.
+* projects are discovered via `project.el`'s API;
+
+Some extra features are provided if certain libraries are installed
+and enabled, such as:
+
+* completion dropdowns via [company];
+* snippet completions via [yasnippet];
+* marked-up documentation via [markdown].
+
+Eglot doesn't _require_ these libraries to work effectively, but will
+use them automatically if they are found to be active.
+
+To "unmanage" a project's buffers, shutdown the server with `M-x
+eglot-shutdown`.
+
+# Supported Protocol features
+
+## General
+- [x] initialize
+- [x] initialized
+- [x] shutdown
+- [x] exit
+- [ ] $/cancelRequest
+
+## Window
+- [x] window/showMessage
+- [x] window/showMessageRequest
+- [x] window/logMessage
+- [x] telemetry/event
+
+## Client
+- [x] client/registerCapability (but only
+ `workspace/didChangeWatchedFiles`, like RLS asks)
+- [x] client/unregisterCapability (ditto)
+
+## Workspace
+- [ ] workspace/workspaceFolders (3.6.0)
+- [ ] workspace/didChangeWorkspaceFolders (3.6.0)
+- [x] workspace/didChangeConfiguration
+- [x] workspace/configuration (3.6.0)
+- [x] workspace/didChangeWatchedFiles
+- [x] workspace/symbol
+- [x] workspace/executeCommand
+- [x] workspace/applyEdit
+
+## Text Synchronization
+- [x] textDocument/didOpen
+- [x] textDocument/didChange (incremental or full)
+- [x] textDocument/willSave
+- [x] textDocument/willSaveWaitUntil
+- [x] textDocument/didSave
+- [x] textDocument/didClose
+
+## Diagnostics
+- [x] textDocument/publishDiagnostics
+
+## Language features
+- [x] textDocument/completion
+- [x] completionItem/resolve (works quite well with [company-mode][company-mode])
+- [x] textDocument/hover
+- [x] textDocument/signatureHelp (fancy stuff with Python's [pyls][pyls])
+- [x] textDocument/definition
+- [x] textDocument/typeDefinition (3.6.0)
+- [x] textDocument/implementation (3.6.0)
+- [x] textDocument/declaration (3.14)
+- [x] textDocument/references
+- [x] textDocument/documentHighlight
+- [x] textDocument/documentSymbol
+- [x] textDocument/codeAction
+- [ ] textDocument/codeLens
+- [ ] codeLens/resolve
+- [ ] textDocument/documentLink
+- [ ] documentLink/resolve
+- [ ] textDocument/documentColor
+- [ ] textDocument/colorPresentation (3.6.0)
+- [x] textDocument/formatting
+- [x] textDocument/rangeFormatting
+- [ ] textDocument/onTypeFormatting
+- [x] textDocument/rename
+
+<a name="animated_gifs"></a>
+# _Obligatory animated gif section_
+
+## Completion
+
+
+The animation shows [company-mode][company] presenting the completion
+candidates to the user, but Eglot works with the built-in
+`completion-at-point` function as well, which is usually bound to
+`C-M-i`.
+
+## Snippet completion
+
+
+Eglot provides template based completion if the server supports
+snippet completion and [yasnippet][yasnippet] is enabled _before_
+Eglot connects to the server. The animation shows
+[company-mode][company], but `completion-at-point` also works with
+snippets.
+
+## Diagnostics
+
+
+Eglot relays the diagnostics information received from the server to
+[flymake][flymake]. Command `display-local-help` (bound to `C-h .`)
+shows the diagnostic message under point, but flymake provides other
+convenient ways to handle diagnostic errors.
+
+When Eglot manages a buffer, it disables other flymake backends. See
+variable `eglot-stay-out-of` to change that.
+
+## Code Actions
+
+
+The server may provide code actions, for example, to fix a diagnostic
+error or to suggest refactoring edits. Command `eglot-code-actions`
+queries the server for possible code actions at point. See variable
+`eglot-confirm-server-initiated-edits` to customize its behavior.
+
+## Hover on symbol
+
+
+## Rename
+
+
+Type `M-x eglot-rename RET` to rename the symbol at point.
+
+## Find definition
+
+
+To jump to the definition of a symbol, use the built-in
+`xref-find-definitions` command, which is bound to `M-.`.
+
+## Find references
+
+
+Eglot here relies on emacs' built-in functionality as well.
+`xref-find-references` is bound to `M-?`. Additionally, Eglot
+provides the following similar commands: `eglot-find-declaration`,
+`eglot-find-implementation`, `eglot-find-typeDefinition`.
+
+# Historical differences to lsp-mode.el
+
+Around May 2018, I wrote a comparison of Eglot to `lsp-mode.el`, and
+was discussed with its then-maintainer. That mode has since been
+refactored/rewritten and now
+[purports to support](https://github.com/joaotavora/eglot/issues/180)
+a lot of features that differentiated Eglot from it. It may now be
+very different or very similar to Eglot, or even sing with the birds
+in the trees, so [go check it out][emacs-lsp]. That said, here's the
+original comparison, which I will not be updating any more.
+
+"Eglot is considerably less code and hassle than lsp-mode.el. In most
+cases, there's nothing to configure. It's a minimalist approach
+focused on user experience and performance.
+
+User-visible differences:
+
+- The single most visible difference is the friendly entry point `M-x
+ eglot`, not `M-x eglot-<language>`. Also, there are no
+ `eglot-<language>` extra packages.
+
+- There's no "whitelisting" or "blacklisting" directories to
+ languages. `M-x eglot` starts servers to handle file of a major
+ mode inside a specific project, using Emacs's built-in `project.el`
+ library to discover projects. Then it automatically detects current
+ and future opened files under that project and syncs with server;
+
+- Easy way to quit/restart a server, just middle/right click on the
+ connection name;
+- Pretty interactive mode-line section for live tracking of server
+ communication;
+- Automatically restarts frequently crashing servers (like RLS);
+- Slow-to-start servers start asynchronously in the background;
+- Server-initiated edits are confirmed with the user;
+- Diagnostics work out-of-the-box (no `flycheck.el` needed);
+- Smoother/more responsive (read below).
+
+Under the hood:
+
+- Message parser is much simpler.
+- Defers signature requests like `textDocument/hover` until server is
+ ready.
+- Sends `textDocument/didChange` for groups of edits, not
+ one per each tiny change.
+- Easier to read and maintain elisp. Yeah I know, *very subjective*,
+ so judge for yourself.
+- Doesn't *require* anything other than Emacs, but will automatically
+ upgrade to work with stuff outside Emacs, like `company`,
+ `markdown-mode`, if you happen to have these installed.
+- Has automated tests that check against actual LSP servers."
+
+[lsp]: https://microsoft.github.io/language-server-protocol/
+[rls]: https://github.com/rust-lang-nursery/rls
+[pyls]: https://github.com/palantir/python-language-server
+[pylsp]: https://github.com/python-lsp/python-lsp-server
+[pyright]: https://github.com/microsoft/pyright
+[gnuelpa]: https://elpa.gnu.org/packages/eglot.html
+[melpa]: https://melpa.org/#/eglot
+[typescript-language-server]: https://github.com/theia-ide/typescript-language-server
+[emacs-lsp]: https://github.com/emacs-lsp/lsp-mode
+[emacs-lsp-plugins]: https://github.com/emacs-lsp
+[bash-language-server]: https://github.com/mads-hartmann/bash-language-server
+[rnix-lsp]: https://github.com/nix-community/rnix-lsp
+[yaml-language-server]: https://github.com/redhat-developer/yaml-language-server
+[php-language-server]: https://github.com/felixfbecker/php-language-server
+[company-mode]: https://github.com/company-mode/company-mode
+[cquery]: https://github.com/cquery-project/cquery
+[ccls]: https://github.com/MaskRay/ccls
+[clangd]: https://clang.llvm.org/extra/clangd.html
+[solargraph]: https://github.com/castwide/solargraph
+[windows-subprocess-hang]: https://www.gnu.org/software/emacs/manual/html_node/efaq-w32/Subprocess-hang.html
+[haskell-language-server]: https://github.com/haskell/haskell-language-server
+[elm-language-server]: https://github.com/elm-tooling/elm-language-server
+[mint-ls]: https://www.mint-lang.com/
+[kotlin-language-server]: https://github.com/fwcd/KotlinLanguageServer
+[gopls]: https://github.com/golang/tools/tree/master/gopls
+[eclipse-jdt]: https://github.com/eclipse/eclipse.jdt.ls
+[ocaml-lsp]: https://github.com/ocaml/ocaml-lsp/
+[r-languageserver]: https://cran.r-project.org/package=languageserver
+[dart_language_server]: https://github.com/natebosch/dart_language_server
+[elixir-ls]: https://github.com/elixir-lsp/elixir-ls
+[erlang_ls]: https://github.com/erlang-ls/erlang_ls
+[html-languageserver]: https://github.com/hrsh7th/vscode-langservers-extracted
+[css-languageserver]: https://github.com/hrsh7th/vscode-langservers-extracted
+[vscode-json-languageserver]: https://github.com/hrsh7th/vscode-langservers-extracted
+[docker-langserver]: https://github.com/rcjsuen/dockerfile-language-server-nodejs
+[cmake-language-server]: https://github.com/regen100/cmake-language-server
+[vim-language-server]: https://github.com/iamcco/vim-language-server
+[news]: https://github.com/joaotavora/eglot/blob/master/NEWS.md
+[ada_language_server]: https://github.com/AdaCore/ada_language_server
+[metals]: https://scalameta.org/metals/
+[digestif]: https://github.com/astoff/digestif
+[company]: https://elpa.gnu.org/packages/company.html
+[flymake]: https://www.gnu.org/software/emacs/manual/html_node/flymake/index.html#Top
+[yasnippet]: https://elpa.gnu.org/packages/yasnippet.html
+[markdown]: https://github.com/defunkt/markdown-mode
+[godot]: https://godotengine.org
+[fortls]: https://github.com/hansec/fortran-language-server
+[gospb]: https://opensource.googleblog.com/2020/10/announcing-latest-google-open-source.html
+[zls]: https://github.com/zigtools/zls
+[fsharp-mode]: https://github.com/fsharp/emacs-fsharp-mode
+[lua-lsp]: https://github.com/Alloyed/lua-lsp
diff --git a/elpa/eglot-1.8/eglot-autoloads.el b/elpa/eglot-1.8/eglot-autoloads.el
@@ -0,0 +1,75 @@
+;;; eglot-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+
+;;;### (autoloads nil "eglot" "eglot.el" (0 0 0 0))
+;;; Generated autoloads from eglot.el
+
+(autoload 'eglot "eglot" "\
+Manage a project with a Language Server Protocol (LSP) server.
+
+The LSP server of CLASS is started (or contacted) via CONTACT.
+If this operation is successful, current *and future* file
+buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\"
+by the LSP server, meaning information about their contents is
+exchanged periodically to provide enhanced code-analysis via
+`xref-find-definitions', `flymake-mode', `eldoc-mode',
+`completion-at-point', among others.
+
+Interactively, the command attempts to guess MANAGED-MAJOR-MODE
+from current buffer, CLASS and CONTACT from
+`eglot-server-programs' and PROJECT from
+`project-find-functions'. The search for active projects in this
+context binds `eglot-lsp-context' (which see).
+
+If it can't guess, the user is prompted. With a single
+\\[universal-argument] prefix arg, it always prompt for COMMAND.
+With two \\[universal-argument] prefix args, also prompts for
+MANAGED-MAJOR-MODE.
+
+PROJECT is a project object as returned by `project-current'.
+
+CLASS is a subclass of `eglot-lsp-server'.
+
+CONTACT specifies how to contact the server. It is a
+keyword-value plist used to initialize CLASS or a plain list as
+described in `eglot-server-programs', which see.
+
+LANGUAGE-ID is the language ID string to send to the server for
+MANAGED-MAJOR-MODE, which matters to a minority of servers.
+
+INTERACTIVE is t if called interactively.
+
+\(fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT LANGUAGE-ID &optional INTERACTIVE)" t nil)
+
+(autoload 'eglot-ensure "eglot" "\
+Start Eglot session for current buffer if there isn't one." nil nil)
+
+(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eglot" '("eglot-")))
+
+;;;***
+
+;;;### (autoloads nil "eglot-tests" "eglot-tests.el" (0 0 0 0))
+;;; Generated autoloads from eglot-tests.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eglot-tests" '("eglot-")))
+
+;;;***
+
+;;;### (autoloads nil nil ("eglot-pkg.el") (0 0 0 0))
+
+;;;***
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; eglot-autoloads.el ends here
diff --git a/elpa/eglot-1.8/eglot-pkg.el b/elpa/eglot-1.8/eglot-pkg.el
@@ -0,0 +1,2 @@
+;; Generated package description from eglot.el -*- no-byte-compile: t -*-
+(define-package "eglot" "1.8" "Client for Language Server Protocol (LSP) servers" '((emacs "26.1") (jsonrpc "1.0.14") (flymake "1.0.9") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0")) :commit "132ea08f97f94ad2e050fc8d1628ecb41de7229a" :authors '(("João Távora" . "joaotavora@gmail.com")) :maintainer '("João Távora" . "joaotavora@gmail.com") :keywords '("convenience" "languages") :url "https://github.com/joaotavora/eglot")
diff --git a/elpa/eglot-1.8/eglot-tests.el b/elpa/eglot-1.8/eglot-tests.el
@@ -0,0 +1,1173 @@
+;;; eglot-tests.el --- Tests for eglot.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; Author: João Távora <joaotavora@gmail.com>
+;; Keywords: tests
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for eglot.el
+
+;;; Code:
+(require 'eglot)
+(require 'cl-lib)
+(require 'ert)
+(require 'ert-x) ; ert-simulate-command
+(require 'edebug)
+(require 'python) ; python-mode-hook
+(require 'company nil t)
+(require 'subr-x)
+
+;;; Helpers
+
+(defun eglot--have-eclipse-jdt-ls-p ()
+ (and (getenv "CLASSPATH")
+ (cl-some
+ (lambda (x)
+ (string-match-p "org\\.eclipse\\.equinox\\.launcher_.*\\.jar$" x))
+ (split-string (getenv "CLASSPATH") ":"))))
+
+(defmacro eglot--with-fixture (fixture &rest body)
+ "Setup FIXTURE, call BODY, teardown FIXTURE.
+FIXTURE is a list. Its elements are of the form (FILE . CONTENT)
+to create a readable FILE with CONTENT. FILE may be a directory
+name and CONTENT another (FILE . CONTENT) list to specify a
+directory hierarchy. FIXTURE's elements can also be (SYMBOL
+VALUE) meaning SYMBOL should be bound to VALUE during BODY and
+then restored."
+ (declare (indent 1) (debug t))
+ `(eglot--call-with-fixture
+ ,fixture #'(lambda () ,@body)))
+
+(defun eglot--make-file-or-dir (ass)
+ (let ((file-or-dir-name (car ass))
+ (content (cdr ass)))
+ (cond ((listp content)
+ (make-directory file-or-dir-name 'parents)
+ (let ((default-directory (concat default-directory "/" file-or-dir-name)))
+ (mapcan #'eglot--make-file-or-dir content)))
+ ((stringp content)
+ (with-temp-buffer
+ (insert content)
+ (write-region nil nil file-or-dir-name nil 'nomessage))
+ (list (expand-file-name file-or-dir-name)))
+ (t
+ (eglot--error "Expected a string or a directory spec")))))
+
+(defun eglot--call-with-fixture (fixture fn)
+ "Helper for `eglot--with-fixture'. Run FN under FIXTURE."
+ (let* ((fixture-directory (make-temp-file "eglot--fixture" t))
+ (default-directory fixture-directory)
+ file-specs created-files
+ syms-to-restore
+ new-servers
+ test-body-successful-p)
+ (dolist (spec fixture)
+ (cond ((symbolp spec)
+ (push (cons spec (symbol-value spec)) syms-to-restore)
+ (set spec nil))
+ ((symbolp (car spec))
+ (push (cons (car spec) (symbol-value (car spec))) syms-to-restore)
+ (set (car spec) (cadr spec)))
+ ((stringp (car spec)) (push spec file-specs))))
+ (unwind-protect
+ (let ((process-environment
+ ;; Prevent user-configuration to have an influence on
+ ;; language servers. (See github#441)
+ (cons "XDG_CONFIG_HOME=/dev/null" process-environment))
+ ;; Prevent "Can't guess python-indent-offset ..." messages.
+ (python-indent-guess-indent-offset-verbose . nil)
+ (eglot-server-initialized-hook
+ (lambda (server) (push server new-servers))))
+ (setq created-files (mapcan #'eglot--make-file-or-dir file-specs))
+ (prog1 (funcall fn)
+ (setq test-body-successful-p t)))
+ (eglot--message
+ "Test body was %s" (if test-body-successful-p "OK" "A FAILURE"))
+ (unwind-protect
+ (let ((eglot-autoreconnect nil))
+ (dolist (server new-servers)
+ (when (jsonrpc-running-p server)
+ (condition-case oops
+ (eglot-shutdown
+ server nil 3 (not test-body-successful-p))
+ (error
+ (eglot--message "Non-critical shutdown error after test: %S"
+ oops))))
+ (when (not test-body-successful-p)
+ ;; We want to do this after the sockets have
+ ;; shut down such that any pending data has been
+ ;; consumed and is available in the process
+ ;; buffers.
+ (let ((buffers (delq nil (list
+ ;; FIXME: Accessing "internal" symbol here.
+ (process-buffer (jsonrpc--process server))
+ (jsonrpc-stderr-buffer server)
+ (jsonrpc-events-buffer server)))))
+ (cond (noninteractive
+ (dolist (buffer buffers)
+ (eglot--message "%s:" (buffer-name buffer))
+ (princ (with-current-buffer buffer (buffer-string))
+ 'external-debugging-output)))
+ (t
+ (eglot--message "Preserved for inspection: %s"
+ (mapconcat #'buffer-name buffers ", "))))))))
+ (eglot--cleanup-after-test fixture-directory created-files syms-to-restore)))))
+
+(defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore)
+ (let ((buffers-to-delete
+ (delete nil (mapcar #'find-buffer-visiting created-files))))
+ (eglot--message "Killing %s, wiping %s, restoring %s"
+ buffers-to-delete
+ fixture-directory
+ (mapcar #'car syms-to-restore))
+ (cl-loop for (sym . val) in syms-to-restore
+ do (set sym val))
+ (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted
+ (with-current-buffer buf (save-buffer) (kill-buffer)))
+ (delete-directory fixture-directory 'recursive)))
+
+(cl-defmacro eglot--with-timeout (timeout &body body)
+ (declare (indent 1) (debug t))
+ `(eglot--call-with-timeout ,timeout (lambda () ,@body)))
+
+(defun eglot--call-with-timeout (timeout fn)
+ (let* ((tag (gensym "eglot-test-timeout"))
+ (timed-out (make-symbol "timeout"))
+ (timeout-and-message
+ (if (listp timeout) timeout
+ (list timeout "waiting for test to finish")))
+ (timeout (car timeout-and-message))
+ (message (cadr timeout-and-message))
+ (timer)
+ (retval))
+ (unwind-protect
+ (setq retval
+ (catch tag
+ (setq timer
+ (run-with-timer timeout nil
+ (lambda ()
+ (unless edebug-active
+ (throw tag timed-out)))))
+ (funcall fn)))
+ (cancel-timer timer)
+ (when (eq retval timed-out)
+ (error "%s" (concat "Timed out " message))))))
+
+(defun eglot--find-file-noselect (file &optional noerror)
+ (unless (or noerror
+ (file-readable-p file)) (error "%s does not exist" file))
+ (find-file-noselect file))
+
+(cl-defmacro eglot--sniffing ((&key server-requests
+ server-notifications
+ server-replies
+ client-requests
+ client-notifications
+ client-replies)
+ &rest body)
+ "Run BODY saving LSP JSON messages in variables, most recent first."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((log-event-ad-sym (make-symbol "eglot--event-sniff")))
+ `(unwind-protect
+ (let ,(delq nil (list server-requests
+ server-notifications
+ server-replies
+ client-requests
+ client-notifications
+ client-replies))
+ (advice-add
+ #'jsonrpc--log-event :before
+ (lambda (_proc message &optional type)
+ (cl-destructuring-bind (&key method id _error &allow-other-keys)
+ message
+ (let ((req-p (and method id))
+ (notif-p method)
+ (reply-p id))
+ (cond
+ ((eq type 'server)
+ (cond (req-p ,(when server-requests
+ `(push message ,server-requests)))
+ (notif-p ,(when server-notifications
+ `(push message ,server-notifications)))
+ (reply-p ,(when server-replies
+ `(push message ,server-replies)))))
+ ((eq type 'client)
+ (cond (req-p ,(when client-requests
+ `(push message ,client-requests)))
+ (notif-p ,(when client-notifications
+ `(push message ,client-notifications)))
+ (reply-p ,(when client-replies
+ `(push message ,client-replies)))))))))
+ '((name . ,log-event-ad-sym)))
+ ,@body)
+ (advice-remove #'jsonrpc--log-event ',log-event-ad-sym))))
+
+(cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body)
+ "Spin until FN match in EVENTS-SYM, flush events after it.
+Pass TIMEOUT to `eglot--with-timeout'."
+ (declare (indent 2) (debug (sexp sexp sexp &rest form)))
+ `(eglot--with-timeout '(,timeout ,(or message
+ (format "waiting for:\n%s" (pp-to-string body))))
+ (let ((event
+ (cl-loop thereis (cl-loop for json in ,events-sym
+ for method = (plist-get json :method)
+ when (keywordp method)
+ do (plist-put json :method
+ (substring
+ (symbol-name method)
+ 1))
+ when (funcall
+ (jsonrpc-lambda ,args ,@body) json)
+ return (cons json before)
+ collect json into before)
+ for i from 0
+ when (zerop (mod i 5))
+ ;; do (eglot--message "still struggling to find in %s"
+ ;; ,events-sym)
+ do
+ ;; `read-event' is essential to have the file
+ ;; watchers come through.
+ (read-event "[eglot] Waiting a bit..." nil 0.1)
+ (accept-process-output nil 0.1))))
+ (setq ,events-sym (cdr event))
+ (eglot--message "Event detected:\n%s"
+ (pp-to-string (car event))))))
+
+;; `rust-mode' is not a part of emacs. So define these two shims which
+;; should be more than enough for testing
+(unless (functionp 'rust-mode)
+ (define-derived-mode rust-mode prog-mode "Rust"))
+(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-mode))
+
+(defun eglot--tests-connect (&optional timeout)
+ (let* ((timeout (or timeout 2))
+ (eglot-sync-connect t)
+ (eglot-connect-timeout timeout))
+ (apply #'eglot--connect (eglot--guess-contact))))
+
+
+;;; Unit tests
+
+(ert-deftest eclipse-connect ()
+ "Connect to eclipse.jdt.ls server."
+ (skip-unless (eglot--have-eclipse-jdt-ls-p))
+ (eglot--with-fixture
+ '(("project/src/main/java/foo" . (("Main.java" . "")))
+ ("project/.git/" . nil))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/src/main/java/foo/Main.java")
+ (eglot--sniffing (:server-notifications s-notifs)
+ (should (eglot--tests-connect 20))
+ (eglot--wait-for (s-notifs 10)
+ (&key _id method &allow-other-keys)
+ (string= method "language/status"))))))
+
+(ert-deftest eclipse-workspace-folders ()
+ "Check eclipse connection with multi-root projects."
+ (skip-unless (eglot--have-eclipse-jdt-ls-p))
+ (eglot--with-fixture
+ '(("project/main/src/main/java/foo" . (("Main.java" . "")))
+ ("project/sub1/" . (("pom.xml" . "")))
+ ("project/sub2/" . (("build.gradle" . "")))
+ ("project/sub3/" . (("a.txt" . "")))
+ ("project/.git/" . nil))
+ (let ((root (file-name-as-directory default-directory)))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/main/src/main/java/foo/Main.java")
+ (eglot--sniffing (:client-requests c-reqs)
+ (should (eglot--tests-connect 10))
+ (eglot--wait-for (c-reqs 10)
+ (&key _id method params &allow-other-keys)
+ (when (string= method "initialize")
+ (let ((folders (plist-get
+ (plist-get params :initializationOptions)
+ :workspaceFolders))
+ (default-directory root))
+ (and
+ (cl-find (eglot--path-to-uri "project/") folders :test #'equal)
+ (cl-find (eglot--path-to-uri "project/sub1/") folders :test #'equal)
+ (cl-find (eglot--path-to-uri "project/sub2/") folders :test #'equal)
+ (= 3 (length folders)))))))))))
+
+(defun eglot-tests--auto-detect-running-server-1 ()
+ (let (server)
+ (eglot--with-fixture
+ `(("project" . (("coiso.py" . "bla")
+ ("merdix.py" . "bla")))
+ ("anotherproject" . (("cena.py" . "bla"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/coiso.py")
+ (should (setq server (eglot--tests-connect)))
+ (should (eglot-current-server)))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/merdix.py")
+ (should (eglot-current-server))
+ (should (eq (eglot-current-server) server)))
+ (with-current-buffer
+ (eglot--find-file-noselect "anotherproject/cena.py")
+ (should-error (eglot--current-server-or-lose))))))
+
+(ert-deftest auto-detect-running-server ()
+ "Visit a file and \\[eglot], then visit a neighbour."
+ (skip-unless (executable-find "pyls"))
+ (eglot-tests--auto-detect-running-server-1))
+
+(ert-deftest auto-shutdown ()
+ "Visit a file and \\[eglot], then kill buffer."
+ (skip-unless (executable-find "pyls"))
+ (let (server
+ buffer)
+ (eglot--with-fixture
+ `(("project" . (("coiso.py" . "def coiso: pass"))))
+ (with-current-buffer
+ (setq buffer (eglot--find-file-noselect "project/coiso.py"))
+ (should (setq server (eglot--tests-connect)))
+ (should (eglot-current-server))
+ (let ((eglot-autoshutdown nil)) (kill-buffer buffer))
+ (should (jsonrpc-running-p server))
+ ;; re-find file...
+ (setq buffer (eglot--find-file-noselect (buffer-file-name buffer)))
+ ;; ;; but now kill it with `eglot-autoshutdown' set to t
+ (let ((eglot-autoshutdown t)) (kill-buffer buffer))
+ (should (not (jsonrpc-running-p server)))))))
+
+(ert-deftest auto-reconnect ()
+ "Start a server. Kill it. Watch it reconnect."
+ (skip-unless (executable-find "pyls"))
+ (let (server (eglot-autoreconnect 1))
+ (eglot--with-fixture
+ `(("project" . (("coiso.py" . "bla")
+ ("merdix.py" . "bla"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/coiso.py")
+ (should (setq server (eglot--tests-connect)))
+ ;; In 1.2 seconds > `eglot-autoreconnect' kill servers. We
+ ;; should have a automatic reconnection.
+ (run-with-timer 1.2 nil (lambda () (delete-process
+ (jsonrpc--process server))))
+ (while (jsonrpc-running-p server) (accept-process-output nil 0.5))
+ (should (eglot-current-server))
+ ;; Now try again too quickly
+ (setq server (eglot-current-server))
+ (let ((proc (jsonrpc--process server)))
+ (run-with-timer 0.5 nil (lambda () (delete-process proc)))
+ (while (process-live-p proc) (accept-process-output nil 0.5)))
+ (should (not (eglot-current-server)))))))
+
+(ert-deftest rls-watches-files ()
+ "Start RLS server. Notify it when a critical file changes."
+ (skip-unless (executable-find "rls"))
+ (skip-unless (executable-find "cargo"))
+ (skip-unless (null (getenv "TRAVIS_TESTING")))
+ (let ((eglot-autoreconnect 1))
+ (eglot--with-fixture
+ '(("watch-project" . (("coiso.rs" . "bla")
+ ("merdix.rs" . "bla"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "watch-project/coiso.rs")
+ (should (zerop (shell-command "cargo init")))
+ (eglot--sniffing (
+ :server-requests s-requests
+ :client-notifications c-notifs
+ :client-replies c-replies
+ )
+ (should (eglot--tests-connect))
+ (let (register-id)
+ (eglot--wait-for (s-requests 1)
+ (&key id method &allow-other-keys)
+ (setq register-id id)
+ (string= method "client/registerCapability"))
+ (eglot--wait-for (c-replies 1)
+ (&key id error &allow-other-keys)
+ (and (eq id register-id) (null error))))
+ (delete-file "Cargo.toml")
+ (eglot--wait-for
+ (c-notifs 3 "waiting for didChangeWatchedFiles notification")
+ (&key method params &allow-other-keys)
+ (and (string= method "workspace/didChangeWatchedFiles")
+ (cl-destructuring-bind (&key uri type)
+ (elt (plist-get params :changes) 0)
+ (and (string= (eglot--path-to-uri "Cargo.toml") uri)
+ (= type 3))))))))))
+
+(ert-deftest basic-diagnostics ()
+ "Test basic diagnostics."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("diag-project" .
+ ; colon missing after True
+ (("main.py" . "def foo(): if True pass"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "diag-project/main.py")
+ (eglot--sniffing (:server-notifications s-notifs)
+ (eglot--tests-connect)
+ (eglot--wait-for (s-notifs 2)
+ (&key _id method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics"))
+ (flymake-start)
+ (goto-char (point-min))
+ (flymake-goto-next-error 1 '() t)
+ (should (eq 'flymake-error (face-at-point)))))))
+
+(defun eglot--eldoc-on-demand ()
+ ;; Trick Eldoc 1.1.0 into accepting on-demand calls.
+ (eldoc t))
+
+(defun eglot--tests-force-full-eldoc ()
+ ;; FIXME: This uses some Eldoc implementation defatils.
+ (when (buffer-live-p eldoc--doc-buffer)
+ (with-current-buffer eldoc--doc-buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
+ (eglot--eldoc-on-demand)
+ (cl-loop
+ repeat 10
+ for retval = (and (buffer-live-p eldoc--doc-buffer)
+ (with-current-buffer eldoc--doc-buffer
+ (let ((bs (buffer-string)))
+ (unless (zerop (length bs)) bs))))
+ when retval return retval
+ do (sit-for 0.1)
+ finally (error "eglot--tests-force-full-eldoc didn't deliver")))
+
+(ert-deftest rls-hover-after-edit ()
+ "Hover and highlightChanges are tricky in RLS."
+ (skip-unless (executable-find "rls"))
+ (skip-unless (executable-find "cargo"))
+ (skip-unless (null (getenv "TRAVIS_TESTING")))
+ (eglot--with-fixture
+ '(("hover-project" .
+ (("main.rs" .
+ "fn test() -> i32 { let test=3; return te; }"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "hover-project/main.rs")
+ (should (zerop (shell-command "cargo init")))
+ (eglot--sniffing (
+ :server-replies s-replies
+ :client-requests c-reqs
+ )
+ (eglot--tests-connect)
+ (goto-char (point-min))
+ (search-forward "return te")
+ (insert "st")
+ (progn
+ ;; simulate these two which don't happen when buffer isn't
+ ;; visible in a window.
+ (eglot--signal-textDocument/didChange)
+ (eglot--eldoc-on-demand))
+ (let (pending-id)
+ (eglot--wait-for (c-reqs 2)
+ (&key id method &allow-other-keys)
+ (setq pending-id id)
+ (string= method "textDocument/documentHighlight"))
+ (eglot--wait-for (s-replies 2)
+ (&key id &allow-other-keys)
+ (eq id pending-id)))))))
+
+(ert-deftest rename-a-symbol ()
+ "Test basic symbol renaming."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("rename-project"
+ . (("main.py" .
+ "def foo (bar) : 1 + bar\n\ndef bar() : pass"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "rename-project/main.py")
+ (eglot--tests-connect)
+ (goto-char (point-min)) (search-forward "bar")
+ (eglot-rename "bla")
+ (should (equal (buffer-string)
+ "def foo (bla) : 1 + bla\n\ndef bar() : pass")))))
+
+(ert-deftest basic-completions ()
+ "Test basic autocompletion in a python LSP."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "import sys\nsys.exi"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ (completion-at-point)
+ (should (looking-back "sys.exit")))))
+
+(ert-deftest non-unique-completions ()
+ "Test completion resulting in 'Complete, but not unique'."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ '(("project" . (("something.py" . "foo=1\nfoobar=2\nfoo"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ (completion-at-point))
+ ;; FIXME: `current-message' doesn't work here :-(
+ (with-current-buffer (messages-buffer)
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line -1)
+ (should (looking-at "Complete, but not unique"))))))
+
+(ert-deftest basic-xref ()
+ "Test basic xref functionality in a python LSP."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "def foo(): pass\ndef bar(): foo()"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ (search-forward "bar(): f")
+ (call-interactively 'xref-find-definitions)
+ (should (looking-at "foo(): pass")))))
+
+(defvar eglot--test-python-buffer
+ "\
+def foobarquux(a, b, c=True): pass
+def foobazquuz(d, e, f): pass
+")
+
+(ert-deftest snippet-completions ()
+ "Test simple snippet completion in a python LSP."
+ (skip-unless (and (executable-find "pyls")
+ (functionp 'yas-minor-mode)))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . ,eglot--test-python-buffer))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (yas-minor-mode 1)
+ (let ((eglot-workspace-configuration
+ `((:pyls . (:plugins (:jedi_completion (:include_params t)))))))
+ (should (eglot--tests-connect)))
+ (goto-char (point-max))
+ (insert "foobar")
+ (completion-at-point)
+ (should (looking-back "foobarquux("))
+ (should (looking-at "a, b)")))))
+
+(defvar company-candidates)
+
+(ert-deftest snippet-completions-with-company ()
+ "Test simple snippet completion in a python LSP."
+ (skip-unless (and (executable-find "pyls")
+ (functionp 'yas-minor-mode)
+ (functionp 'company-complete)))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . ,eglot--test-python-buffer))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (yas-minor-mode 1)
+ (let ((eglot-workspace-configuration
+ `((:pyls . (:plugins (:jedi_completion (:include_params t)))))))
+ (should (eglot--tests-connect)))
+ (goto-char (point-max))
+ (insert "foo")
+ (company-mode)
+ (company-complete)
+ (should (looking-back "fooba"))
+ (should (= 2 (length company-candidates)))
+ ;; this last one is brittle, since there it is possible that
+ ;; pyls will change the representation of this candidate
+ (should (member "foobazquuz(d, e, f)" company-candidates)))))
+
+(ert-deftest eglot-eldoc-after-completions ()
+ "Test documentation echo in a python LSP."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "import sys\nsys.exi"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ (completion-at-point)
+ (should (looking-back "sys.exit"))
+ (should (string-match "^exit" (eglot--tests-force-full-eldoc))))))
+
+(ert-deftest eglot-multiline-eldoc ()
+ "Test if suitable amount of lines of hover info are shown."
+ :expected-result (if (getenv "TRAVIS_TESTING") :failed :passed)
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("hover-first.py" . "from datetime import datetime"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/hover-first.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ ;; one-line
+ (let* ((eldoc-echo-area-use-multiline-p t)
+ (captured-message (eglot--tests-force-full-eldoc)))
+ (should (string-match "datetim" captured-message))
+ (should (cl-find ?\n captured-message))))))
+
+(ert-deftest eglot-single-line-eldoc ()
+ "Test if suitable amount of lines of hover info are shown."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("hover-first.py" . "from datetime import datetime"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/hover-first.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ ;; one-line
+ (let* ((eldoc-echo-area-use-multiline-p nil)
+ (captured-message (eglot--tests-force-full-eldoc)))
+ (should (string-match "datetim" captured-message))
+ (should (not (cl-find ?\n eldoc-last-message)))))))
+
+(ert-deftest python-autopep-formatting ()
+ "Test formatting in the pyls python LSP.
+pyls prefers autopep over yafp, despite its README stating the contrary."
+ ;; Beware, default autopep rules can change over time, which may
+ ;; affect this test.
+ (skip-unless (and (executable-find "pyls")
+ (executable-find "autopep8")))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "def a():pass\n\ndef b():pass"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ ;; Try to format just the second line
+ (search-forward "b():pa")
+ (eglot-format (point-at-bol) (point-at-eol))
+ (should (looking-at "ss"))
+ (should
+ (string= (buffer-string) "def a():pass\n\n\ndef b(): pass\n"))
+ ;; now format the whole buffer
+ (eglot-format-buffer)
+ (should
+ (string= (buffer-string) "def a(): pass\n\n\ndef b(): pass\n")))))
+
+(ert-deftest python-yapf-formatting ()
+ "Test formatting in the pyls python LSP."
+ (skip-unless (and (executable-find "pyls")
+ (not (executable-find "autopep8"))
+ (executable-find "yapf")))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "def a():pass\ndef b():pass"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ ;; Try to format just the second line
+ (search-forward "b():pa")
+ (eglot-format (point-at-bol) (point-at-eol))
+ (should (looking-at "ss"))
+ (should
+ (string= (buffer-string) "def a():pass\n\n\ndef b():\n pass\n"))
+ ;; now format the whole buffer
+ (eglot-format-buffer)
+ (should
+ (string= (buffer-string) "def a():\n pass\n\n\ndef b():\n pass\n")))))
+
+(ert-deftest javascript-basic ()
+ "Test basic autocompletion in a JavaScript LSP."
+ (skip-unless (executable-find "typescript-language-server"))
+ (eglot--with-fixture
+ '(("project" . (("hello.js" . "console.log('Hello world!');"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/hello.js")
+ (let ((eglot-server-programs
+ '((js-mode . ("typescript-language-server" "--stdio")))))
+ (goto-char (point-max))
+ (eglot--sniffing (:server-notifications
+ s-notifs
+ :client-notifications
+ c-notifs)
+ (should (eglot--tests-connect))
+ (eglot--wait-for (s-notifs 2) (&key method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics"))
+ (should (not (eq 'flymake-error (face-at-point))))
+ (insert "{")
+ (eglot--signal-textDocument/didChange)
+ (eglot--wait-for (c-notifs 1) (&key method &allow-other-keys)
+ (string= method "textDocument/didChange"))
+ (eglot--wait-for (s-notifs 2) (&key params method &allow-other-keys)
+ (and (string= method "textDocument/publishDiagnostics")
+ (cl-destructuring-bind (&key _uri diagnostics) params
+ (cl-find-if (jsonrpc-lambda (&key severity &allow-other-keys)
+ (= severity 1))
+ diagnostics)))))))))
+
+(ert-deftest json-basic ()
+ "Test basic autocompletion in vscode-json-languageserver."
+ (skip-unless (executable-find "vscode-json-languageserver"))
+ (eglot--with-fixture
+ '(("project" .
+ (("p.json" . "{\"foo.b")
+ ("s.json" . "{\"properties\":{\"foo.bar\":{\"default\":\"fb\"}}}")
+ (".git" . nil))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/p.json")
+ (yas-minor-mode)
+ (goto-char 2)
+ (insert "\"$schema\": \"file://"
+ (file-name-directory buffer-file-name) "s.json\",")
+ (let ((eglot-server-programs
+ '((js-mode . ("vscode-json-languageserver" "--stdio")))))
+ (goto-char (point-max))
+ (should (eglot--tests-connect))
+ (completion-at-point)
+ (should (looking-back "\"foo.bar\": \""))
+ (should (looking-at "fb\"$"))))))
+
+(defun eglot-tests--lsp-abiding-column-1 ()
+ (eglot--with-fixture
+ '(("project" .
+ (("foo.c" . "const char write_data[] = u8\"🚂🚃🚄🚅🚆🚈🚇🚈🚉🚊🚋🚌🚎🚝🚞🚟🚠🚡🛤🛲\";"))))
+ (let ((eglot-server-programs
+ '((c-mode . ("clangd")))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/foo.c")
+ (setq-local eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column)
+ (setq-local eglot-current-column-function #'eglot-lsp-abiding-column)
+ (eglot--sniffing (:client-notifications c-notifs)
+ (eglot--tests-connect)
+ (end-of-line)
+ (insert "p ")
+ (eglot--signal-textDocument/didChange)
+ (eglot--wait-for (c-notifs 2) (&key params &allow-other-keys)
+ (should (equal 71 (cadddr (cadadr (aref (cadddr params) 0))))))
+ (beginning-of-line)
+ (should (eq eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column))
+ (funcall eglot-move-to-column-function 71)
+ (should (looking-at "p")))))))
+
+(ert-deftest eglot-lsp-abiding-column ()
+ "Test basic `eglot-lsp-abiding-column' and `eglot-move-to-lsp-abiding-column'."
+ (skip-unless (executable-find "clangd"))
+ (eglot-tests--lsp-abiding-column-1))
+
+(ert-deftest eglot-ensure ()
+ "Test basic `eglot-ensure' functionality."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("foo.py" . "import sys\nsys.exi")
+ ("bar.py" . "import sys\nsys.exi")))
+ (python-mode-hook
+ (eglot-ensure
+ (lambda ()
+ (remove-hook 'flymake-diagnostic-functions 'python-flymake)))))
+ (let (server)
+ ;; need `ert-simulate-command' because `eglot-ensure'
+ ;; relies on `post-command-hook'.
+ (with-current-buffer
+ (ert-simulate-command
+ '(find-file "project/foo.py"))
+ ;; FIXME: This test fails without this sleep on my machine.
+ ;; Figure out why and solve this more cleanly.
+ (sleep-for 0.1)
+ (should (setq server (eglot-current-server))))
+ (with-current-buffer
+ (ert-simulate-command
+ '(find-file "project/bar.py"))
+ (should (eq server (eglot-current-server)))))))
+
+(ert-deftest slow-sync-connection-wait ()
+ "Connect with `eglot-sync-connect' set to t."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "import sys\nsys.exi"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (let ((eglot-sync-connect t)
+ (eglot-server-programs
+ `((python-mode . ("sh" "-c" "sleep 1 && pyls")))))
+ (should (eglot--tests-connect 3))))))
+
+(ert-deftest slow-sync-connection-intime ()
+ "Connect synchronously with `eglot-sync-connect' set to 2."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "import sys\nsys.exi"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (let ((eglot-sync-connect 2)
+ (eglot-server-programs
+ `((python-mode . ("sh" "-c" "sleep 1 && pyls")))))
+ (should (eglot--tests-connect 3))))))
+
+(ert-deftest slow-async-connection ()
+ "Connect asynchronously with `eglot-sync-connect' set to 2."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "import sys\nsys.exi"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (let ((eglot-sync-connect 1)
+ (eglot-server-programs
+ `((python-mode . ("sh" "-c" "sleep 2 && pyls")))))
+ (should-not (apply #'eglot--connect (eglot--guess-contact)))
+ (eglot--with-timeout 3
+ (while (not (eglot-current-server))
+ (accept-process-output nil 0.2))
+ (should (eglot-current-server)))))))
+
+(ert-deftest slow-sync-timeout ()
+ "Failed attempt at connection synchronously."
+ (skip-unless (executable-find "pyls"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "import sys\nsys.exi"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (let ((eglot-sync-connect t)
+ (eglot-connect-timeout 1)
+ (eglot-server-programs
+ `((python-mode . ("sh" "-c" "sleep 2 && pyls")))))
+ (should-error (apply #'eglot--connect (eglot--guess-contact)))))))
+
+(ert-deftest eglot-capabilities ()
+ "Unit test for `eglot--server-capable'."
+ (cl-letf (((symbol-function 'eglot--capabilities)
+ (lambda (_dummy)
+ ;; test data lifted from Golangserver example at
+ ;; https://github.com/joaotavora/eglot/pull/74
+ (list :textDocumentSync 2 :hoverProvider t
+ :completionProvider '(:triggerCharacters ["."])
+ :signatureHelpProvider '(:triggerCharacters ["(" ","])
+ :definitionProvider t :typeDefinitionProvider t
+ :referencesProvider t :documentSymbolProvider t
+ :workspaceSymbolProvider t :implementationProvider t
+ :documentFormattingProvider t :xworkspaceReferencesProvider t
+ :xdefinitionProvider t :xworkspaceSymbolByProperties t)))
+ ((symbol-function 'eglot--current-server-or-lose)
+ (lambda () nil)))
+ (should (eql 2 (eglot--server-capable :textDocumentSync)))
+ (should (eglot--server-capable :completionProvider :triggerCharacters))
+ (should (equal '(:triggerCharacters ["."]) (eglot--server-capable :completionProvider)))
+ (should-not (eglot--server-capable :foobarbaz))
+ (should-not (eglot--server-capable :textDocumentSync :foobarbaz))))
+
+
+(ert-deftest eglot-strict-interfaces ()
+ (let ((eglot--lsp-interface-alist
+ `((FooObject . ((:foo :bar) (:baz))))))
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode nil))
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar")
+ (cons foo bar)))))
+ (should-error
+ (let ((eglot-strict-mode '(disallow-non-standard-keys)))
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
+ (cons foo bar))))
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode nil))
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
+ (cons foo bar)))))
+ (should-error
+ (let ((eglot-strict-mode '(disallow-non-standard-keys)))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
+ (cons foo bar))))
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode '(disallow-non-standard-keys)))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz bargh)
+ (cons foo bar)))))
+ (should
+ (equal '("foo" . nil)
+ (let ((eglot-strict-mode nil))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
+ (cons foo bar)))))
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode '(enforce-required-keys)))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz bargh)
+ (cons foo bar)))))
+ (should-error
+ (let ((eglot-strict-mode '(enforce-required-keys)))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
+ (cons foo bar))))))
+
+(ert-deftest eglot-dcase ()
+ (let ((eglot--lsp-interface-alist
+ `((FooObject . ((:foo :bar) (:baz)))
+ (CodeAction (:title) (:kind :diagnostics :edit :command))
+ (Command ((:title . string) (:command . string)) (:arguments)))))
+ (should
+ (equal
+ "foo"
+ (eglot--dcase `(:foo "foo" :bar "bar")
+ (((FooObject) foo)
+ foo))))
+ (should
+ (equal
+ (list "foo" '(:title "hey" :command "ho") "some edit")
+ (eglot--dcase '(:title "foo"
+ :command (:title "hey" :command "ho")
+ :edit "some edit")
+ (((Command) _title _command _arguments)
+ (ert-fail "Shouldn't have destructured this object as a Command"))
+ (((CodeAction) title edit command)
+ (list title command edit)))))
+ (should
+ (equal
+ (list "foo" "some command" nil)
+ (eglot--dcase '(:title "foo" :command "some command")
+ (((Command) title command arguments)
+ (list title command arguments))
+ (((CodeAction) _title _edit _command)
+ (ert-fail "Shouldn't have destructured this object as a CodeAction")))))))
+
+(ert-deftest eglot-dcase-issue-452 ()
+ (let ((eglot--lsp-interface-alist
+ `((FooObject . ((:foo :bar) (:baz)))
+ (CodeAction (:title) (:kind :diagnostics :edit :command))
+ (Command ((string . :title) (:command . string)) (:arguments)))))
+ (should
+ (equal
+ (list "foo" '(:command "cmd" :title "alsofoo"))
+ (eglot--dcase '(:title "foo" :command (:command "cmd" :title "alsofoo"))
+ (((Command) _title _command _arguments)
+ (ert-fail "Shouldn't have destructured this object as a Command"))
+ (((CodeAction) title command)
+ (list title command)))))))
+
+(cl-defmacro eglot--guessing-contact ((interactive-sym
+ prompt-args-sym
+ guessed-class-sym guessed-contact-sym
+ &optional guessed-lang-id-sym)
+ &body body)
+ "Evaluate BODY twice, binding results of `eglot--guess-contact'.
+
+INTERACTIVE-SYM is bound to the boolean passed to
+`eglot--guess-contact' each time. If the user would have been
+prompted, PROMPT-ARGS-SYM is bound to the list of arguments that
+would have been passed to `read-shell-command', else nil.
+GUESSED-CLASS-SYM, GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM
+are bound to the useful return values of
+`eglot--guess-contact'. Unless the server program evaluates to
+\"a-missing-executable.exe\", this macro will assume it exists."
+ (declare (indent 1) (debug t))
+ (let ((i-sym (cl-gensym)))
+ `(dolist (,i-sym '(nil t))
+ (let ((,interactive-sym ,i-sym)
+ (buffer-file-name "_")
+ (,prompt-args-sym nil))
+ (cl-letf (((symbol-function 'executable-find)
+ (lambda (name &optional _remote)
+ (unless (string-equal name "a-missing-executable.exe")
+ (format "/totally-mock-bin/%s" name))))
+ ((symbol-function 'read-shell-command)
+ (lambda (&rest args) (setq ,prompt-args-sym args) "")))
+ (cl-destructuring-bind
+ (_ _ ,guessed-class-sym ,guessed-contact-sym
+ ,(or guessed-lang-id-sym '_))
+ (eglot--guess-contact ,i-sym)
+ ,@body))))))
+
+(ert-deftest eglot-server-programs-simple-executable ()
+ (let ((eglot-server-programs '((foo-mode "some-executable")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable"))))))
+
+(ert-deftest eglot-server-programs-simple-missing-executable ()
+ (let ((eglot-server-programs '((foo-mode "a-missing-executable.exe")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (interactive-p prompt-args guessed-class guessed-contact)
+ (should (equal (not prompt-args) (not interactive-p)))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("a-missing-executable.exe"))))))
+
+(ert-deftest eglot-server-programs-executable-multiple-major-modes ()
+ (let ((eglot-server-programs '(((bar-mode foo-mode) "some-executable")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable"))))))
+
+(ert-deftest eglot-server-programs-executable-with-arg ()
+ (let ((eglot-server-programs '((foo-mode "some-executable" "arg1")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable" "arg1"))))))
+
+(ert-deftest eglot-server-programs-executable-with-args-and-autoport ()
+ (let ((eglot-server-programs '((foo-mode "some-executable" "arg1"
+ :autoport "arg2")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable" "arg1"
+ :autoport "arg2"))))))
+
+(ert-deftest eglot-server-programs-host-and-port ()
+ (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777)))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("somehost.example.com" 7777))))))
+
+(ert-deftest eglot-server-programs-host-and-port-and-tcp-args ()
+ (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777
+ :type network)))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("somehost.example.com" 7777
+ :type network))))))
+
+(ert-deftest eglot-server-programs-class-name-and-plist ()
+ (let ((eglot-server-programs '((foo-mode bar-class :init-key init-val)))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'bar-class))
+ (should (equal guessed-contact '(:init-key init-val))))))
+
+(ert-deftest eglot-server-programs-class-name-and-contact-spec ()
+ (let ((eglot-server-programs '((foo-mode bar-class "some-executable" "arg1"
+ :autoport "arg2")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'bar-class))
+ (should (equal guessed-contact '("some-executable" "arg1"
+ :autoport "arg2"))))))
+
+(ert-deftest eglot-server-programs-function ()
+ (let ((eglot-server-programs '((foo-mode . (lambda (&optional _)
+ '("some-executable")))))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable"))))))
+
+(ert-deftest eglot-server-programs-guess-lang ()
+ (let ((major-mode 'foo-mode))
+ (let ((eglot-server-programs '((foo-mode . ("prog-executable")))))
+ (eglot--guessing-contact (_ _ _ _ guessed-lang)
+ (should (equal guessed-lang "foo"))))
+ (let ((eglot-server-programs '(((foo-mode :language-id "bar")
+ . ("prog-executable")))))
+ (eglot--guessing-contact (_ _ _ _ guessed-lang)
+ (should (equal guessed-lang "bar"))))
+ (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar"))
+ . ("prog-executable")))))
+ (eglot--guessing-contact (_ _ _ _ guessed-lang)
+ (should (equal guessed-lang "bar"))))))
+
+(defun eglot--glob-match (glob str)
+ (funcall (eglot--glob-compile glob t t) str))
+
+(ert-deftest eglot--glob-test ()
+ (should (eglot--glob-match "foo/**/baz" "foo/bar/baz"))
+ (should (eglot--glob-match "foo/**/baz" "foo/baz"))
+ (should-not (eglot--glob-match "foo/**/baz" "foo/bar"))
+ (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/baz/foo/quuz"))
+ (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/baz/foo/quuz"))
+ (should-not (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/ding/foo/quuz"))
+ (should (eglot--glob-match "*.js" "foo.js"))
+ (should-not (eglot--glob-match "*.js" "foo.jsx"))
+ (should (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.js"))
+ (should-not (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.jsx"))
+ (should (eglot--glob-match "*.{js,ts}" "foo.js"))
+ (should-not (eglot--glob-match "*.{js,ts}" "foo.xs"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}" "foo/bar/baz/foo.ts"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}x" "foo/bar/baz/foo.tsx"))
+ (should (eglot--glob-match "?oo.js" "foo.js"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz"))
+ (should (eglot--glob-match "example.[!0-9]" "example.a"))
+ (should-not (eglot--glob-match "example.[!0-9]" "example.0"))
+ (should (eglot--glob-match "example.[0-9]" "example.0"))
+ (should-not (eglot--glob-match "example.[0-9]" "example.a"))
+ (should (eglot--glob-match "**/bar/" "foo/bar/"))
+ (should-not (eglot--glob-match "foo.hs" "fooxhs"))
+
+ ;; Some more tests
+ (should (eglot--glob-match "**/.*" ".git"))
+ (should (eglot--glob-match ".?" ".o"))
+ (should (eglot--glob-match "**/.*" ".hidden.txt"))
+ (should (eglot--glob-match "**/.*" "path/.git"))
+ (should (eglot--glob-match "**/.*" "path/.hidden.txt"))
+ (should (eglot--glob-match "**/node_modules/**" "node_modules/"))
+ (should (eglot--glob-match "{foo,bar}/**" "foo/test"))
+ (should (eglot--glob-match "{foo,bar}/**" "bar/test"))
+ (should (eglot--glob-match "some/**/*" "some/foo.js"))
+ (should (eglot--glob-match "some/**/*" "some/folder/foo.js"))
+
+ ;; VSCode supposedly supports this, not sure if good idea.
+ ;;
+ ;; (should (eglot--glob-match "**/node_modules/**" "node_modules"))
+ ;; (should (eglot--glob-match "{foo,bar}/**" "foo"))
+ ;; (should (eglot--glob-match "{foo,bar}/**" "bar"))
+
+ ;; VSCode also supports nested blobs. Do we care?
+ ;;
+ ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "/testing/foo.js"))
+ ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "testing/foo.d.ts"))
+ ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js,foo.[0-9]}" "foo.5"))
+ ;; (should (eglot--glob-match "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}" "prefix/foo.8"))
+ )
+
+(ert-deftest eglot--tramp-test ()
+ "Ensure LSP servers can be used over TRAMP."
+ (skip-unless (and (>= emacs-major-version 27) (executable-find "pyls")))
+ ;; Set up a loopback TRAMP method that’s just a shell so the remote
+ ;; host is really just the local host.
+ (let ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path))
+ (tramp-methods '(("loopback"
+ (tramp-login-program "/bin/sh")
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c")))))
+ (temporary-file-directory (concat "/loopback::"
+ temporary-file-directory)))
+ ;; With ‘temporary-file-directory’ bound to the ‘loopback’ TRAMP
+ ;; method, fixtures will be automatically made “remote".
+ (eglot-tests--auto-detect-running-server-1)))
+
+(ert-deftest eglot--tramp-test-2 ()
+ "Ensure LSP servers can be used over TRAMP."
+ (skip-unless (and (>= emacs-major-version 27) (executable-find "clangd")))
+ ;; Set up a loopback TRAMP method that’s just a shell so the remote
+ ;; host is really just the local host.
+ (let ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path))
+ (tramp-methods '(("loopback"
+ (tramp-login-program "/bin/sh")
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c")))))
+ (temporary-file-directory (concat "/loopback::"
+ temporary-file-directory))
+ (eglot-server-programs '((c-mode "clangd"))))
+ (eglot-tests--lsp-abiding-column-1) ))
+
+(ert-deftest eglot--path-to-uri-windows ()
+ (should (string-prefix-p "file:///"
+ (eglot--path-to-uri "c:/Users/Foo/bar.lisp")))
+ (should (string-suffix-p "c%3A/Users/Foo/bar.lisp"
+ (eglot--path-to-uri "c:/Users/Foo/bar.lisp"))))
+
+(provide 'eglot-tests)
+;;; eglot-tests.el ends here
+
+;; Local Variables:
+;; checkdoc-force-docstrings-flag: nil
+;; End:
diff --git a/elpa/eglot-1.8/eglot-tests.elc b/elpa/eglot-1.8/eglot-tests.elc
Binary files differ.
diff --git a/elpa/eglot-1.8/eglot.el b/elpa/eglot-1.8/eglot.el
@@ -0,0 +1,3082 @@
+;;; eglot.el --- Client for Language Server Protocol (LSP) servers -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; Version: 1.8
+;; Author: João Távora <joaotavora@gmail.com>
+;; Maintainer: João Távora <joaotavora@gmail.com>
+;; URL: https://github.com/joaotavora/eglot
+;; Keywords: convenience, languages
+;; Package-Requires: ((emacs "26.1") (jsonrpc "1.0.14") (flymake "1.0.9") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0"))
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Simply M-x eglot should be enough to get you started, but here's a
+;; little info (see the accompanying README.md or the URL for more).
+;;
+;; M-x eglot starts a server via a shell-command guessed from
+;; `eglot-server-programs', using the current major-mode (for whatever
+;; language you're programming in) as a hint. If it can't guess, it
+;; prompts you in the mini-buffer for these things. Actually, the
+;; server needen't be locally started: you can connect to a running
+;; server via TCP by entering a <host:port> syntax.
+;;
+;; Anyway, if the connection is successful, you should see an `eglot'
+;; indicator pop up in your mode-line. More importantly, this means
+;; current *and future* file buffers of that major mode *inside your
+;; current project* automatically become \"managed\" by the LSP
+;; server, i.e. information about their contents is exchanged
+;; periodically to provide enhanced code analysis via
+;; `xref-find-definitions', `flymake-mode', `eldoc-mode',
+;; `completion-at-point', among others.
+;;
+;; To "unmanage" these buffers, shutdown the server with M-x
+;; eglot-shutdown.
+;;
+;; You can also do:
+;;
+;; (add-hook 'foo-mode-hook 'eglot-ensure)
+;;
+;; To attempt to start an eglot session automatically every time a
+;; foo-mode buffer is visited.
+;;
+;;; Code:
+
+(require 'json)
+(require 'imenu)
+(require 'cl-lib)
+(require 'project)
+(require 'seq)
+(require 'url-parse)
+(require 'url-util)
+(require 'pcase)
+(require 'compile) ; for some faces
+(require 'warnings)
+(require 'flymake)
+(require 'xref)
+(eval-when-compile
+ (require 'subr-x))
+(require 'jsonrpc)
+(require 'filenotify)
+(require 'ert)
+(require 'array)
+
+;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are
+;; using the latest version from GNU Elpa when we load eglot.el. Use an
+;; heuristic to see if we need to `load' it in Emacs < 28.
+(if (and (< emacs-major-version 28)
+ (not (boundp 'eldoc-documentation-strategy)))
+ (load "eldoc")
+ (require 'eldoc))
+
+;; forward-declare, but don't require (Emacs 28 doesn't seem to care)
+(defvar markdown-fontify-code-blocks-natively)
+(defvar company-backends)
+(defvar company-tooltip-align-annotations)
+
+
+
+;;; User tweakable stuff
+(defgroup eglot nil
+ "Interaction with Language Server Protocol servers."
+ :prefix "eglot-"
+ :group 'applications)
+
+(defun eglot-alternatives (alternatives)
+ "Compute server-choosing function for `eglot-server-programs'.
+Each element of ALTERNATIVES is a string PROGRAM or a list of
+strings (PROGRAM ARGS...) where program names an LSP server
+program to start with ARGS. Returns a function of one argument.
+When invoked, that function will return a list (ABSPATH ARGS),
+where ABSPATH is the absolute path of the PROGRAM that was
+chosen (interactively or automatically)."
+ (lambda (&optional interactive)
+ ;; JT@2021-06-13: This function is way more complicated than it
+ ;; could be because it accounts for the fact that
+ ;; `eglot--executable-find' may take much longer to execute on
+ ;; remote files.
+ (let* ((listified (cl-loop for a in alternatives
+ collect (if (listp a) a (list a))))
+ (err (lambda ()
+ (error "None of '%s' are valid executables"
+ (mapconcat #'car listified ", ")))))
+ (cond (interactive
+ (let* ((augmented (mapcar (lambda (a)
+ (let ((found (eglot--executable-find
+ (car a) t)))
+ (and found
+ (cons (car a) (cons found (cdr a))))))
+ listified))
+ (available (remove nil augmented)))
+ (cond ((cdr available)
+ (cdr (assoc
+ (completing-read
+ "[eglot] More than one server executable available:"
+ (mapcar #'car available)
+ nil t nil nil (car (car available)))
+ available #'equal)))
+ ((cdr (car available)))
+ (t
+ ;; Don't error when used interactively, let the
+ ;; Eglot prompt the user for alternative (github#719)
+ nil))))
+ (t
+ (cl-loop for (p . args) in listified
+ for probe = (eglot--executable-find p t)
+ when probe return (cons probe args)
+ finally (funcall err)))))))
+
+(defvar eglot-server-programs `((rust-mode . (eglot-rls "rls"))
+ (cmake-mode . ("cmake-language-server"))
+ (vimrc-mode . ("vim-language-server" "--stdio"))
+ (python-mode
+ . ,(eglot-alternatives
+ '("pylsp" "pyls" ("pyright-langserver" "--stdio"))))
+ ((js-mode typescript-mode)
+ . ("typescript-language-server" "--stdio"))
+ (sh-mode . ("bash-language-server" "start"))
+ ((php-mode phps-mode)
+ . ("php" "vendor/felixfbecker/\
+language-server/bin/php-language-server.php"))
+ ((c++-mode c-mode) . ,(eglot-alternatives
+ '("clangd" "ccls")))
+ (((caml-mode :language-id "ocaml")
+ (tuareg-mode :language-id "ocaml") reason-mode)
+ . ("ocamllsp"))
+ (ruby-mode
+ . ("solargraph" "socket" "--port" :autoport))
+ (haskell-mode
+ . ("haskell-language-server-wrapper" "--lsp"))
+ (elm-mode . ("elm-language-server"))
+ (mint-mode . ("mint" "ls"))
+ (kotlin-mode . ("kotlin-language-server"))
+ (go-mode . ("gopls"))
+ ((R-mode ess-r-mode) . ("R" "--slave" "-e"
+ "languageserver::run()"))
+ (java-mode . eglot--eclipse-jdt-contact)
+ (dart-mode . ("dart_language_server"))
+ (elixir-mode . ("language_server.sh"))
+ (ada-mode . ("ada_language_server"))
+ (scala-mode . ("metals-emacs"))
+ ((tex-mode context-mode texinfo-mode bibtex-mode)
+ . ("digestif"))
+ (erlang-mode . ("erlang_ls" "--transport" "stdio"))
+ (yaml-mode . ("yaml-language-server" "--stdio"))
+ (nix-mode . ("rnix-lsp"))
+ (gdscript-mode . ("localhost" 6008))
+ ((fortran-mode f90-mode) . ("fortls"))
+ (lua-mode . ("lua-lsp"))
+ (zig-mode . ("zls"))
+ (css-mode . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") ("css-languageserver" "--stdio"))))
+ (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio"))))
+ (json-mode . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio"))))
+ (dockerfile-mode . ("docker-langserver" "--stdio")))
+ "How the command `eglot' guesses the server to start.
+An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
+identifies the buffers that are to be managed by a specific
+language server. The associated CONTACT specifies how to connect
+to a server for those buffers.
+
+MAJOR-MODE can be:
+
+* In the most common case, a symbol such as `c-mode';
+
+* A list (MAJOR-MODE-SYMBOL :LANGUAGE-ID ID) where
+ MAJOR-MODE-SYMBOL is the aforementioned symbol and ID is a
+ string identifying the language to the server;
+
+* A list combining the previous two alternatives, meaning
+ multiple major modes will be associated with a single server
+ program.
+
+CONTACT can be:
+
+* In the most common case, a list of strings (PROGRAM [ARGS...]).
+ PROGRAM is called with ARGS and is expected to serve LSP requests
+ over the standard input/output channels.
+
+* A list (HOST PORT [TCP-ARGS...]) where HOST is a string and
+ PORT is a positive integer for connecting to a server via TCP.
+ Remaining ARGS are passed to `open-network-stream' for
+ upgrading the connection with encryption or other capabilities.
+
+* A list (PROGRAM [ARGS...] :autoport [MOREARGS...]), whereupon a
+ combination of the two previous options is used. First, an
+ attempt is made to find an available server port, then PROGRAM
+ is launched with ARGS; the `:autoport' keyword substituted for
+ that number; and MOREARGS. Eglot then attempts to establish a
+ TCP connection to that port number on the localhost.
+
+* A cons (CLASS-NAME . INITARGS) where CLASS-NAME is a symbol
+ designating a subclass of `eglot-lsp-server', for representing
+ experimental LSP servers. INITARGS is a keyword-value plist
+ used to initialize the object of CLASS-NAME, or a plain list
+ interpreted as the previous descriptions of CONTACT. In the
+ latter case that plain list is used to produce a plist with a
+ suitable :PROCESS initarg to CLASS-NAME. The class
+ `eglot-lsp-server' descends from `jsonrpc-process-connection',
+ which you should see for the semantics of the mandatory
+ :PROCESS argument.
+
+* A function of a single argument producing any of the above
+ values for CONTACT. The argument's value is non-nil if the
+ connection was requested interactively (e.g. from the `eglot'
+ command), and nil if it wasn't (e.g. from `eglot-ensure'). If
+ the call is interactive, the function can ask the user for
+ hints on finding the required programs, etc. Otherwise, it
+ should not ask the user for any input, and return nil or signal
+ an error if it can't produce a valid CONTACT.")
+
+(defface eglot-highlight-symbol-face
+ '((t (:inherit bold)))
+ "Face used to highlight the symbol at point.")
+
+(defface eglot-mode-line
+ '((t (:inherit font-lock-constant-face :weight bold)))
+ "Face for package-name in EGLOT's mode line.")
+
+(defcustom eglot-autoreconnect 3
+ "Control ability to reconnect automatically to the LSP server.
+If t, always reconnect automatically (not recommended). If nil,
+never reconnect automatically after unexpected server shutdowns,
+crashes or network failures. A positive integer number says to
+only autoreconnect if the previous successful connection attempt
+lasted more than that many seconds."
+ :type '(choice (boolean :tag "Whether to inhibit autoreconnection")
+ (integer :tag "Number of seconds")))
+
+(defcustom eglot-connect-timeout 30
+ "Number of seconds before timing out LSP connection attempts.
+If nil, never time out."
+ :type 'number)
+
+(defcustom eglot-sync-connect 3
+ "Control blocking of LSP connection attempts.
+If t, block for `eglot-connect-timeout' seconds. A positive
+integer number means block for that many seconds, and then wait
+for the connection in the background. nil has the same meaning
+as 0, i.e. don't block at all."
+ :type '(choice (boolean :tag "Whether to inhibit autoreconnection")
+ (integer :tag "Number of seconds")))
+
+(defcustom eglot-autoshutdown nil
+ "If non-nil, shut down server after killing last managed buffer."
+ :type 'boolean)
+
+(defcustom eglot-send-changes-idle-time 0.5
+ "Don't tell server of changes before Emacs's been idle for this many seconds."
+ :type 'number)
+
+(defcustom eglot-events-buffer-size 2000000
+ "Control the size of the Eglot events buffer.
+If a number, don't let the buffer grow larger than that many
+characters. If 0, don't use an event's buffer at all. If nil,
+let the buffer grow forever."
+ :type '(choice (const :tag "No limit" nil)
+ (integer :tag "Number of characters")))
+
+(defcustom eglot-confirm-server-initiated-edits 'confirm
+ "Non-nil if server-initiated edits should be confirmed with user."
+ :type '(choice (const :tag "Don't show confirmation prompt" nil)
+ (symbol :tag "Show confirmation prompt" 'confirm)))
+
+(defcustom eglot-extend-to-xref nil
+ "If non-nil, activate Eglot in cross-referenced non-project files."
+ :type 'boolean)
+
+(defvar eglot-withhold-process-id nil
+ "If non-nil, Eglot will not send the Emacs process id to the language server.
+This can be useful when using docker to run a language server.")
+
+;; Customizable via `completion-category-overrides'.
+(when (assoc 'flex completion-styles-alist)
+ (add-to-list 'completion-category-defaults '(eglot (styles flex basic))))
+
+
+;;; Constants
+;;;
+(defconst eglot--symbol-kind-names
+ `((1 . "File") (2 . "Module")
+ (3 . "Namespace") (4 . "Package") (5 . "Class")
+ (6 . "Method") (7 . "Property") (8 . "Field")
+ (9 . "Constructor") (10 . "Enum") (11 . "Interface")
+ (12 . "Function") (13 . "Variable") (14 . "Constant")
+ (15 . "String") (16 . "Number") (17 . "Boolean")
+ (18 . "Array") (19 . "Object") (20 . "Key")
+ (21 . "Null") (22 . "EnumMember") (23 . "Struct")
+ (24 . "Event") (25 . "Operator") (26 . "TypeParameter")))
+
+(defconst eglot--kind-names
+ `((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor")
+ (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface")
+ (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value")
+ (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color")
+ (17 . "File") (18 . "Reference") (19 . "Folder") (20 . "EnumMember")
+ (21 . "Constant") (22 . "Struct") (23 . "Event") (24 . "Operator")
+ (25 . "TypeParameter")))
+
+(defconst eglot--{} (make-hash-table) "The empty JSON object.")
+
+(defun eglot--executable-find (command &optional remote)
+ "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26."
+ (if (>= emacs-major-version 27) (executable-find command remote)
+ (executable-find command)))
+
+
+;;; Message verification helpers
+;;;
+(eval-and-compile
+ (defvar eglot--lsp-interface-alist
+ `(
+ (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred))
+ (ConfigurationItem () (:scopeUri :section))
+ (Command ((:title . string) (:command . string)) (:arguments))
+ (CompletionItem (:label)
+ (:kind :detail :documentation :deprecated :preselect
+ :sortText :filterText :insertText :insertTextFormat
+ :textEdit :additionalTextEdits :commitCharacters
+ :command :data))
+ (Diagnostic (:range :message) (:severity :code :source :relatedInformation :codeDescription))
+ (DocumentHighlight (:range) (:kind))
+ (FileSystemWatcher (:globPattern) (:kind))
+ (Hover (:contents) (:range))
+ (InitializeResult (:capabilities) (:serverInfo))
+ (Location (:uri :range))
+ (LocationLink (:targetUri :targetRange :targetSelectionRange) (:originSelectionRange))
+ (LogMessageParams (:type :message))
+ (MarkupContent (:kind :value))
+ (ParameterInformation (:label) (:documentation))
+ (Position (:line :character))
+ (Range (:start :end))
+ (Registration (:id :method) (:registerOptions))
+ (ResponseError (:code :message) (:data))
+ (ShowMessageParams (:type :message))
+ (ShowMessageRequestParams (:type :message) (:actions))
+ (SignatureHelp (:signatures) (:activeSignature :activeParameter))
+ (SignatureInformation (:label) (:documentation :parameters :activeParameter))
+ (SymbolInformation (:name :kind :location)
+ (:deprecated :containerName))
+ (DocumentSymbol (:name :range :selectionRange :kind)
+ ;; `:containerName' isn't really allowed , but
+ ;; it simplifies the impl of `eglot-imenu'.
+ (:detail :deprecated :children :containerName))
+ (TextDocumentEdit (:textDocument :edits) ())
+ (TextEdit (:range :newText))
+ (VersionedTextDocumentIdentifier (:uri :version) ())
+ (WorkspaceEdit () (:changes :documentChanges))
+ )
+ "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
+
+INTERFACE-NAME is a symbol designated by the spec as
+\"interface\". INTERFACE is a list (REQUIRED OPTIONAL) where
+REQUIRED and OPTIONAL are lists of KEYWORD designating field
+names that must be, or may be, respectively, present in a message
+adhering to that interface. KEY can be a keyword or a cons (SYM
+TYPE), where type is used by `cl-typep' to check types at
+runtime.
+
+Here's what an element of this alist might look like:
+
+ (Command ((:title . string) (:command . string)) (:arguments))"))
+
+(eval-and-compile
+ (defvar eglot-strict-mode (if load-file-name '()
+ '(disallow-non-standard-keys
+ ;; Uncomment these two for fun at
+ ;; compile-time or with flymake-mode.
+ ;;
+ ;; enforce-required-keys
+ ;; enforce-optional-keys
+ ))
+ "How strictly to check LSP interfaces at compile- and run-time.
+
+Value is a list of symbols (if the list is empty, no checks are
+performed).
+
+If the symbol `disallow-non-standard-keys' is present, an error
+is raised if any extraneous fields are sent by the server. At
+compile-time, a warning is raised if a destructuring spec
+includes such a field.
+
+If the symbol `enforce-required-keys' is present, an error is
+raised if any required fields are missing from the message sent
+from the server. At compile-time, a warning is raised if a
+destructuring spec doesn't use such a field.
+
+If the symbol `enforce-optional-keys' is present, nothing special
+happens at run-time. At compile-time, a warning is raised if a
+destructuring spec doesn't use all optional fields.
+
+If the symbol `disallow-unknown-methods' is present, Eglot warns
+on unknown notifications and errors on unknown requests.
+"))
+
+(defun eglot--plist-keys (plist)
+ (cl-loop for (k _v) on plist by #'cddr collect k))
+
+(cl-defun eglot--check-object (interface-name
+ object
+ &optional
+ (enforce-required t)
+ (disallow-non-standard t)
+ (check-types t))
+ "Check that OBJECT conforms to INTERFACE. Error otherwise."
+ (cl-destructuring-bind
+ (&key types required-keys optional-keys &allow-other-keys)
+ (eglot--interface interface-name)
+ (when-let ((missing (and enforce-required
+ (cl-set-difference required-keys
+ (eglot--plist-keys object)))))
+ (eglot--error "A `%s' must have %s" interface-name missing))
+ (when-let ((excess (and disallow-non-standard
+ (cl-set-difference
+ (eglot--plist-keys object)
+ (append required-keys optional-keys)))))
+ (eglot--error "A `%s' mustn't have %s" interface-name excess))
+ (when check-types
+ (cl-loop
+ for (k v) on object by #'cddr
+ for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type?
+ unless (cl-typep v type)
+ do (eglot--error "A `%s' must have a %s as %s, but has %s"
+ interface-name )))
+ t))
+
+(eval-and-compile
+ (defun eglot--keywordize-vars (vars)
+ (mapcar (lambda (var) (intern (format ":%s" var))) vars))
+
+ (defun eglot--ensure-type (k) (if (consp k) k (cons k t)))
+
+ (defun eglot--interface (interface-name)
+ (let* ((interface (assoc interface-name eglot--lsp-interface-alist))
+ (required (mapcar #'eglot--ensure-type (car (cdr interface))))
+ (optional (mapcar #'eglot--ensure-type (cadr (cdr interface)))))
+ (list :types (append required optional)
+ :required-keys (mapcar #'car required)
+ :optional-keys (mapcar #'car optional))))
+
+ (defun eglot--check-dspec (interface-name dspec)
+ "Check destructuring spec DSPEC against INTERFACE-NAME."
+ (cl-destructuring-bind (&key required-keys optional-keys &allow-other-keys)
+ (eglot--interface interface-name)
+ (cond ((or required-keys optional-keys)
+ (let ((too-many
+ (and
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-set-difference
+ (eglot--keywordize-vars dspec)
+ (append required-keys optional-keys))))
+ (ignored-required
+ (and
+ (memq 'enforce-required-keys eglot-strict-mode)
+ (cl-set-difference
+ required-keys (eglot--keywordize-vars dspec))))
+ (missing-out
+ (and
+ (memq 'enforce-optional-keys eglot-strict-mode)
+ (cl-set-difference
+ optional-keys (eglot--keywordize-vars dspec)))))
+ (when too-many (byte-compile-warn
+ "Destructuring for %s has extraneous %s"
+ interface-name too-many))
+ (when ignored-required (byte-compile-warn
+ "Destructuring for %s ignores required %s"
+ interface-name ignored-required))
+ (when missing-out (byte-compile-warn
+ "Destructuring for %s is missing out on %s"
+ interface-name missing-out))))
+ (t
+ (byte-compile-warn "Unknown LSP interface %s" interface-name))))))
+
+(cl-defmacro eglot--dbind (vars object &body body)
+ "Destructure OBJECT, binding VARS in BODY.
+VARS is ([(INTERFACE)] SYMS...)
+Honour `eglot-strict-mode'."
+ (declare (indent 2) (debug (sexp sexp &rest form)))
+ (let ((interface-name (if (consp (car vars))
+ (car (pop vars))))
+ (object-once (make-symbol "object-once"))
+ (fn-once (make-symbol "fn-once")))
+ (cond (interface-name
+ (eglot--check-dspec interface-name vars)
+ `(let ((,object-once ,object))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
+ (eglot--check-object ',interface-name ,object-once
+ (memq 'enforce-required-keys eglot-strict-mode)
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (memq 'check-types eglot-strict-mode))
+ ,@body)))
+ (t
+ `(let ((,object-once ,object)
+ (,fn-once (lambda (,@vars) ,@body)))
+ (if (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-destructuring-bind (&key ,@vars) ,object-once
+ (funcall ,fn-once ,@vars))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
+ (funcall ,fn-once ,@vars))))))))
+
+
+(cl-defmacro eglot--lambda (cl-lambda-list &body body)
+ "Function of args CL-LAMBDA-LIST for processing INTERFACE objects.
+Honour `eglot-strict-mode'."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((e (cl-gensym "jsonrpc-lambda-elem")))
+ `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
+
+(cl-defmacro eglot--dcase (obj &rest clauses)
+ "Like `pcase', but for the LSP object OBJ.
+CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is
+treated as in `eglot-dbind'."
+ (declare (indent 1) (debug (sexp &rest (sexp &rest form))))
+ (let ((obj-once (make-symbol "obj-once")))
+ `(let ((,obj-once ,obj))
+ (cond
+ ,@(cl-loop
+ for (vars . body) in clauses
+ for vars-as-keywords = (eglot--keywordize-vars vars)
+ for interface-name = (if (consp (car vars))
+ (car (pop vars)))
+ for condition =
+ (cond (interface-name
+ (eglot--check-dspec interface-name vars)
+ ;; In this mode, in runtime, we assume
+ ;; `eglot-strict-mode' is partially on, otherwise we
+ ;; can't disambiguate between certain types.
+ `(ignore-errors
+ (eglot--check-object
+ ',interface-name ,obj-once
+ t
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ t)))
+ (t
+ ;; In this interface-less mode we don't check
+ ;; `eglot-strict-mode' at all: just check that the object
+ ;; has all the keys the user wants to destructure.
+ `(null (cl-set-difference
+ ',vars-as-keywords
+ (eglot--plist-keys ,obj-once)))))
+ collect `(,condition
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
+ ,obj-once
+ ,@body)))
+ (t
+ (eglot--error "%S didn't match any of %S"
+ ,obj-once
+ ',(mapcar #'car clauses)))))))
+
+
+;;; API (WORK-IN-PROGRESS!)
+;;;
+(cl-defmacro eglot--when-live-buffer (buf &rest body)
+ "Check BUF live, then do BODY in it." (declare (indent 1) (debug t))
+ (let ((b (cl-gensym)))
+ `(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b ,@body)))))
+
+(cl-defmacro eglot--when-buffer-window (buf &body body)
+ "Check BUF showing somewhere, then do BODY in it." (declare (indent 1) (debug t))
+ (let ((b (cl-gensym)))
+ `(let ((,b ,buf))
+ ;;notice the exception when testing with `ert'
+ (when (or (get-buffer-window ,b) (ert-running-test))
+ (with-current-buffer ,b ,@body)))))
+
+(cl-defmacro eglot--widening (&rest body)
+ "Save excursion and restriction. Widen. Then run BODY." (declare (debug t))
+ `(save-excursion (save-restriction (widen) ,@body)))
+
+(cl-defgeneric eglot-handle-request (server method &rest params)
+ "Handle SERVER's METHOD request with PARAMS.")
+
+(cl-defgeneric eglot-handle-notification (server method &rest params)
+ "Handle SERVER's METHOD notification with PARAMS.")
+
+(cl-defgeneric eglot-execute-command (server command arguments)
+ "Ask SERVER to execute COMMAND with ARGUMENTS.")
+
+(cl-defgeneric eglot-initialization-options (server)
+ "JSON object to send under `initializationOptions'."
+ (:method (_s) eglot--{})) ; blank default
+
+(cl-defgeneric eglot-register-capability (server method id &rest params)
+ "Ask SERVER to register capability METHOD marked with ID."
+ (:method
+ (_s method _id &rest _params)
+ (eglot--warn "Server tried to register unsupported capability `%s'"
+ method)))
+
+(cl-defgeneric eglot-unregister-capability (server method id &rest params)
+ "Ask SERVER to register capability METHOD marked with ID."
+ (:method
+ (_s method _id &rest _params)
+ (eglot--warn "Server tried to unregister unsupported capability `%s'"
+ method)))
+
+(cl-defgeneric eglot-client-capabilities (server)
+ "What the EGLOT LSP client supports for SERVER."
+ (:method (_s)
+ (list
+ :workspace (list
+ :applyEdit t
+ :executeCommand `(:dynamicRegistration :json-false)
+ :workspaceEdit `(:documentChanges :json-false)
+ :didChangeWatchedFiles `(:dynamicRegistration t)
+ :symbol `(:dynamicRegistration :json-false)
+ :configuration t)
+ :textDocument
+ (list
+ :synchronization (list
+ :dynamicRegistration :json-false
+ :willSave t :willSaveWaitUntil t :didSave t)
+ :completion (list :dynamicRegistration :json-false
+ :completionItem
+ `(:snippetSupport
+ ,(if (eglot--snippet-expansion-fn)
+ t
+ :json-false))
+ :contextSupport t)
+ :hover (list :dynamicRegistration :json-false
+ :contentFormat
+ (if (fboundp 'gfm-view-mode)
+ ["markdown" "plaintext"]
+ ["plaintext"]))
+ :signatureHelp (list :dynamicRegistration :json-false
+ :signatureInformation
+ `(:parameterInformation
+ (:labelOffsetSupport t)
+ :activeParameterSupport t))
+ :references `(:dynamicRegistration :json-false)
+ :definition (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :declaration (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :implementation (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :typeDefinition (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :documentSymbol (list
+ :dynamicRegistration :json-false
+ :hierarchicalDocumentSymbolSupport t
+ :symbolKind `(:valueSet
+ [,@(mapcar
+ #'car eglot--symbol-kind-names)]))
+ :documentHighlight `(:dynamicRegistration :json-false)
+ :codeAction (list
+ :dynamicRegistration :json-false
+ :codeActionLiteralSupport
+ '(:codeActionKind
+ (:valueSet
+ ["quickfix"
+ "refactor" "refactor.extract"
+ "refactor.inline" "refactor.rewrite"
+ "source" "source.organizeImports"]))
+ :isPreferredSupport t)
+ :formatting `(:dynamicRegistration :json-false)
+ :rangeFormatting `(:dynamicRegistration :json-false)
+ :rename `(:dynamicRegistration :json-false)
+ :publishDiagnostics (list :relatedInformation :json-false
+ ;; TODO: We can support :codeDescription after
+ ;; adding an appropriate UI to
+ ;; Flymake.
+ :codeDescriptionSupport :json-false))
+ :experimental eglot--{})))
+
+(defclass eglot-lsp-server (jsonrpc-process-connection)
+ ((project-nickname
+ :documentation "Short nickname for the associated project."
+ :accessor eglot--project-nickname
+ :reader eglot-project-nickname)
+ (major-mode
+ :documentation "Major mode symbol."
+ :accessor eglot--major-mode)
+ (language-id
+ :documentation "Language ID string for the mode."
+ :accessor eglot--language-id)
+ (capabilities
+ :documentation "JSON object containing server capabilities."
+ :accessor eglot--capabilities)
+ (server-info
+ :documentation "JSON object containing server info."
+ :accessor eglot--server-info)
+ (shutdown-requested
+ :documentation "Flag set when server is shutting down."
+ :accessor eglot--shutdown-requested)
+ (project
+ :documentation "Project associated with server."
+ :accessor eglot--project)
+ (spinner
+ :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
+ :initform `(nil nil t) :accessor eglot--spinner)
+ (inhibit-autoreconnect
+ :initform t
+ :documentation "Generalized boolean inhibiting auto-reconnection if true."
+ :accessor eglot--inhibit-autoreconnect)
+ (file-watches
+ :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
+ :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
+ (managed-buffers
+ :documentation "List of buffers managed by server."
+ :accessor eglot--managed-buffers)
+ (saved-initargs
+ :documentation "Saved initargs for reconnection purposes."
+ :accessor eglot--saved-initargs)
+ (inferior-process
+ :documentation "Server subprocess started automatically."
+ :accessor eglot--inferior-process))
+ :documentation
+ "Represents a server. Wraps a process for LSP communication.")
+
+
+;;; Process management
+(defvar eglot--servers-by-project (make-hash-table :test #'equal)
+ "Keys are projects. Values are lists of processes.")
+
+(defun eglot-shutdown (server &optional _interactive timeout preserve-buffers)
+ "Politely ask SERVER to quit.
+Interactively, read SERVER from the minibuffer unless there is
+only one and it's managing the current buffer.
+
+Forcefully quit it if it doesn't respond within TIMEOUT seconds.
+TIMEOUT defaults to 1.5 seconds. Don't leave this function with
+the server still running.
+
+If PRESERVE-BUFFERS is non-nil (interactively, when called with a
+prefix argument), do not kill events and output buffers of
+SERVER."
+ (interactive (list (eglot--read-server "Shutdown which server"
+ (eglot-current-server))
+ t nil current-prefix-arg))
+ (eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
+ (unwind-protect
+ (progn
+ (setf (eglot--shutdown-requested server) t)
+ (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
+ (jsonrpc-notify server :exit nil))
+ ;; Now ask jsonrpc.el to shut down the server.
+ (jsonrpc-shutdown server (not preserve-buffers))
+ (unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server)))))
+
+(defun eglot-shutdown-all (&optional preserve-buffers)
+ "Politely ask all language servers to quit, in order.
+PRESERVE-BUFFERS as in `eglot-shutdown', which see."
+ (interactive (list current-prefix-arg))
+ (cl-loop for ss being the hash-values of eglot--servers-by-project
+ do (cl-loop for s in ss do (eglot-shutdown s nil preserve-buffers))))
+
+(defun eglot--on-shutdown (server)
+ "Called by jsonrpc.el when SERVER is already dead."
+ ;; Turn off `eglot--managed-mode' where appropriate.
+ (dolist (buffer (eglot--managed-buffers server))
+ (let (;; Avoid duplicate shutdowns (github#389)
+ (eglot-autoshutdown nil))
+ (eglot--when-live-buffer buffer (eglot--managed-mode-off))))
+ ;; Kill any expensive watches
+ (maphash (lambda (_id watches)
+ (mapcar #'file-notify-rm-watch watches))
+ (eglot--file-watches server))
+ ;; Kill any autostarted inferior processes
+ (when-let (proc (eglot--inferior-process server))
+ (delete-process proc))
+ ;; Sever the project/server relationship for `server'
+ (setf (gethash (eglot--project server) eglot--servers-by-project)
+ (delq server
+ (gethash (eglot--project server) eglot--servers-by-project)))
+ (cond ((eglot--shutdown-requested server)
+ t)
+ ((not (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Reconnecting after unexpected server exit.")
+ (eglot-reconnect server))
+ ((timerp (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
+
+(defun eglot--all-major-modes ()
+ "Return all known major modes."
+ (let ((retval))
+ (mapatoms (lambda (sym)
+ (when (plist-member (symbol-plist sym) 'derived-mode-parent)
+ (push sym retval))))
+ retval))
+
+(defvar eglot--command-history nil
+ "History of CONTACT arguments to `eglot'.")
+
+(defun eglot--lookup-mode (mode)
+ "Lookup `eglot-server-programs' for MODE.
+Return (LANGUAGE-ID . CONTACT-PROXY). If not specified,
+LANGUAGE-ID is determined from MODE."
+ (cl-loop
+ for (modes . contact) in eglot-server-programs
+ thereis (cl-some
+ (lambda (spec)
+ (cl-destructuring-bind (probe &key language-id &allow-other-keys)
+ (if (consp spec) spec (list spec))
+ (and (provided-mode-derived-p mode probe)
+ (cons
+ (or language-id
+ (or (get mode 'eglot-language-id)
+ (get spec 'eglot-language-id)
+ (string-remove-suffix "-mode" (symbol-name mode))))
+ contact))))
+ (if (or (symbolp modes) (keywordp (cadr modes)))
+ (list modes) modes))))
+
+(defun eglot--guess-contact (&optional interactive)
+ "Helper for `eglot'.
+Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID). If INTERACTIVE is
+non-nil, maybe prompt user, else error as soon as something can't
+be guessed."
+ (let* ((guessed-mode (if buffer-file-name major-mode))
+ (managed-mode
+ (cond
+ ((and interactive
+ (or (>= (prefix-numeric-value current-prefix-arg) 16)
+ (not guessed-mode)))
+ (intern
+ (completing-read
+ "[eglot] Start a server to manage buffers of what major mode? "
+ (mapcar #'symbol-name (eglot--all-major-modes)) nil t
+ (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
+ ((not guessed-mode)
+ (eglot--error "Can't guess mode to manage for `%s'" (current-buffer)))
+ (t guessed-mode)))
+ (lang-id-and-guess (eglot--lookup-mode guessed-mode))
+ (language-id (car lang-id-and-guess))
+ (guess (cdr lang-id-and-guess))
+ (guess (if (functionp guess)
+ (funcall guess interactive)
+ guess))
+ (class (or (and (consp guess) (symbolp (car guess))
+ (prog1 (unless current-prefix-arg (car guess))
+ (setq guess (cdr guess))))
+ 'eglot-lsp-server))
+ (program (and (listp guess)
+ (stringp (car guess))
+ ;; A second element might be the port of a (host, port)
+ ;; pair, but in that case it is not a string.
+ (or (null (cdr guess)) (stringp (cadr guess)))
+ (car guess)))
+ (base-prompt
+ (and interactive
+ "Enter program to execute (or <host>:<port>): "))
+ (program-guess
+ (and program
+ (combine-and-quote-strings (cl-subst ":autoport:"
+ :autoport guess))))
+ (prompt
+ (and base-prompt
+ (cond (current-prefix-arg base-prompt)
+ ((null guess)
+ (format "[eglot] Sorry, couldn't guess for `%s'!\n%s"
+ managed-mode base-prompt))
+ ((and program
+ (not (file-name-absolute-p program))
+ (not (eglot--executable-find program t)))
+ (concat (format "[eglot] I guess you want to run `%s'"
+ program-guess)
+ (format ", but I can't find `%s' in PATH!" program)
+ "\n" base-prompt)))))
+ (contact
+ (or (and prompt
+ (let ((s (read-shell-command
+ prompt
+ program-guess
+ 'eglot-command-history)))
+ (if (string-match "^\\([^\s\t]+\\):\\([[:digit:]]+\\)$"
+ (string-trim s))
+ (list (match-string 1 s)
+ (string-to-number (match-string 2 s)))
+ (cl-subst
+ :autoport ":autoport:" (split-string-and-unquote s)
+ :test #'equal))))
+ guess
+ (eglot--error "Couldn't guess for `%s'!" managed-mode))))
+ (list managed-mode (eglot--current-project) class contact language-id)))
+
+(defvar eglot-lsp-context)
+(put 'eglot-lsp-context 'variable-documentation
+ "Dynamically non-nil when searching for projects in LSP context.")
+
+(defvar eglot--servers-by-xrefed-file
+ (make-hash-table :test 'equal :weakness 'value))
+
+(defun eglot--current-project ()
+ "Return a project object for Eglot's LSP purposes.
+This relies on `project-current' and thus on
+`project-find-functions'. Functions in the latter
+variable (which see) can query the value `eglot-lsp-context' to
+decide whether a given directory is a project containing a
+suitable root directory for a given LSP server's purposes."
+ (let ((eglot-lsp-context t))
+ (or (project-current) `(transient . ,default-directory))))
+
+;;;###autoload
+(defun eglot (managed-major-mode project class contact language-id
+ &optional interactive)
+ "Manage a project with a Language Server Protocol (LSP) server.
+
+The LSP server of CLASS is started (or contacted) via CONTACT.
+If this operation is successful, current *and future* file
+buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\"
+by the LSP server, meaning information about their contents is
+exchanged periodically to provide enhanced code-analysis via
+`xref-find-definitions', `flymake-mode', `eldoc-mode',
+`completion-at-point', among others.
+
+Interactively, the command attempts to guess MANAGED-MAJOR-MODE
+from current buffer, CLASS and CONTACT from
+`eglot-server-programs' and PROJECT from
+`project-find-functions'. The search for active projects in this
+context binds `eglot-lsp-context' (which see).
+
+If it can't guess, the user is prompted. With a single
+\\[universal-argument] prefix arg, it always prompt for COMMAND.
+With two \\[universal-argument] prefix args, also prompts for
+MANAGED-MAJOR-MODE.
+
+PROJECT is a project object as returned by `project-current'.
+
+CLASS is a subclass of `eglot-lsp-server'.
+
+CONTACT specifies how to contact the server. It is a
+keyword-value plist used to initialize CLASS or a plain list as
+described in `eglot-server-programs', which see.
+
+LANGUAGE-ID is the language ID string to send to the server for
+MANAGED-MAJOR-MODE, which matters to a minority of servers.
+
+INTERACTIVE is t if called interactively."
+ (interactive (append (eglot--guess-contact t) '(t)))
+ (let* ((current-server (eglot-current-server))
+ (live-p (and current-server (jsonrpc-running-p current-server))))
+ (if (and live-p
+ interactive
+ (y-or-n-p "[eglot] Live process found, reconnect instead? "))
+ (eglot-reconnect current-server interactive)
+ (when live-p (ignore-errors (eglot-shutdown current-server)))
+ (eglot--connect managed-major-mode project class contact language-id))))
+
+(defun eglot-reconnect (server &optional interactive)
+ "Reconnect to SERVER.
+INTERACTIVE is t if called interactively."
+ (interactive (list (eglot--current-server-or-lose) t))
+ (when (jsonrpc-running-p server)
+ (ignore-errors (eglot-shutdown server interactive nil 'preserve-buffers)))
+ (eglot--connect (eglot--major-mode server)
+ (eglot--project server)
+ (eieio-object-class-name server)
+ (eglot--saved-initargs server)
+ (eglot--language-id server))
+ (eglot--message "Reconnected!"))
+
+(defvar eglot--managed-mode) ; forward decl
+
+;;;###autoload
+(defun eglot-ensure ()
+ "Start Eglot session for current buffer if there isn't one."
+ (let ((buffer (current-buffer)))
+ (cl-labels
+ ((maybe-connect
+ ()
+ (remove-hook 'post-command-hook #'maybe-connect nil)
+ (eglot--when-live-buffer buffer
+ (unless eglot--managed-mode
+ (apply #'eglot--connect (eglot--guess-contact))))))
+ (when buffer-file-name
+ (add-hook 'post-command-hook #'maybe-connect 'append nil)))))
+
+(defun eglot-events-buffer (server)
+ "Display events buffer for SERVER.
+Use current server's or first available Eglot events buffer."
+ (interactive (list (eglot-current-server)))
+ (let ((buffer (if server (jsonrpc-events-buffer server)
+ (cl-find "\\*EGLOT.*events\\*"
+ (buffer-list)
+ :key #'buffer-name :test #'string-match))))
+ (if buffer (display-buffer buffer)
+ (eglot--error "Can't find an Eglot events buffer!"))))
+
+(defun eglot-stderr-buffer (server)
+ "Display stderr buffer for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (display-buffer (jsonrpc-stderr-buffer server)))
+
+(defun eglot-forget-pending-continuations (server)
+ "Forget pending requests for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (jsonrpc-forget-pending-continuations server))
+
+(defvar eglot-connect-hook
+ '(eglot-signal-didChangeConfiguration)
+ "Hook run after connecting in `eglot--connect'.")
+
+(defvar eglot-server-initialized-hook
+ '()
+ "Hook run after a `eglot-lsp-server' instance is created.
+
+That is before a connection was established. Use
+`eglot-connect-hook' to hook into when a connection was
+successfully established and the server on the other side has
+received the initializing configuration.
+
+Each function is passed the server as an argument")
+
+(defun eglot--cmd (contact)
+ "Helper for `eglot--connect'."
+ (if (file-remote-p default-directory)
+ ;; TODO: this seems like a bug, although it’s everywhere. For
+ ;; some reason, for remote connections only, over a pipe, we
+ ;; need to turn off line buffering on the tty.
+ ;;
+ ;; Not only does this seem like there should be a better way,
+ ;; but it almost certainly doesn’t work on non-unix systems.
+ (list "sh" "-c"
+ (string-join (cons "stty raw > /dev/null;"
+ (mapcar #'shell-quote-argument contact))
+ " "))
+ contact))
+
+(defvar-local eglot--cached-server nil
+ "A cached reference to the current EGLOT server.")
+
+(defun eglot--connect (managed-major-mode project class contact language-id)
+ "Connect to MANAGED-MAJOR-MODE, LANGUAGE-ID, PROJECT, CLASS and CONTACT.
+This docstring appeases checkdoc, that's all."
+ (let* ((default-directory (project-root project))
+ (nickname (file-name-base (directory-file-name default-directory)))
+ (readable-name (format "EGLOT (%s/%s)" nickname managed-major-mode))
+ autostart-inferior-process
+ (contact (if (functionp contact) (funcall contact) contact))
+ (initargs
+ (cond ((keywordp (car contact)) contact)
+ ((integerp (cadr contact))
+ `(:process ,(lambda ()
+ (apply #'open-network-stream
+ readable-name nil
+ (car contact) (cadr contact)
+ (cddr contact)))))
+ ((and (stringp (car contact)) (memq :autoport contact))
+ `(:process ,(lambda ()
+ (pcase-let ((`(,connection . ,inferior)
+ (eglot--inferior-bootstrap
+ readable-name
+ contact)))
+ (setq autostart-inferior-process inferior)
+ connection))))
+ ((stringp (car contact))
+ `(:process
+ ,(lambda ()
+ (let ((default-directory default-directory))
+ (make-process
+ :name readable-name
+ :command (eglot--cmd contact)
+ :connection-type 'pipe
+ :coding 'utf-8-emacs-unix
+ :noquery t
+ :stderr (get-buffer-create
+ (format "*%s stderr*" readable-name))
+ :file-handler t)))))))
+ (spread (lambda (fn) (lambda (server method params)
+ (let ((eglot--cached-server server))
+ (apply fn server method (append params nil))))))
+ (server
+ (apply
+ #'make-instance class
+ :name readable-name
+ :events-buffer-scrollback-size eglot-events-buffer-size
+ :notification-dispatcher (funcall spread #'eglot-handle-notification)
+ :request-dispatcher (funcall spread #'eglot-handle-request)
+ :on-shutdown #'eglot--on-shutdown
+ initargs))
+ (cancelled nil)
+ (tag (make-symbol "connected-catch-tag")))
+ (setf (eglot--saved-initargs server) initargs)
+ (setf (eglot--project server) project)
+ (setf (eglot--project-nickname server) nickname)
+ (setf (eglot--major-mode server) managed-major-mode)
+ (setf (eglot--language-id server) language-id)
+ (setf (eglot--inferior-process server) autostart-inferior-process)
+ (run-hook-with-args 'eglot-server-initialized-hook server)
+ ;; Now start the handshake. To honour `eglot-sync-connect'
+ ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
+ ;; and mimic most of `jsonrpc-request'.
+ (unwind-protect
+ (condition-case _quit
+ (let ((retval
+ (catch tag
+ (jsonrpc-async-request
+ server
+ :initialize
+ (list :processId
+ (unless (or eglot-withhold-process-id
+ (file-remote-p default-directory)
+ (eq (jsonrpc-process-type server)
+ 'network))
+ (emacs-pid))
+ ;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py'
+ ;; into `/path/to/baz.py', so LSP groks it.
+ :rootPath (file-local-name
+ (expand-file-name default-directory))
+ :rootUri (eglot--path-to-uri default-directory)
+ :initializationOptions (eglot-initialization-options
+ server)
+ :capabilities (eglot-client-capabilities server))
+ :success-fn
+ (eglot--lambda ((InitializeResult) capabilities serverInfo)
+ (unless cancelled
+ (push server
+ (gethash project eglot--servers-by-project))
+ (setf (eglot--capabilities server) capabilities)
+ (setf (eglot--server-info server) serverInfo)
+ (jsonrpc-notify server :initialized eglot--{})
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ ;; No need to pass SERVER as an argument: it has
+ ;; been registered in `eglot--servers-by-project',
+ ;; so that it can be found (and cached) from
+ ;; `eglot--maybe-activate-editing-mode' in any
+ ;; managed buffer.
+ (eglot--maybe-activate-editing-mode)))
+ (setf (eglot--inhibit-autoreconnect server)
+ (cond
+ ((booleanp eglot-autoreconnect)
+ (not eglot-autoreconnect))
+ ((cl-plusp eglot-autoreconnect)
+ (run-with-timer
+ eglot-autoreconnect nil
+ (lambda ()
+ (setf (eglot--inhibit-autoreconnect server)
+ (null eglot-autoreconnect)))))))
+ (let ((default-directory (project-root project))
+ (major-mode managed-major-mode))
+ (hack-dir-local-variables-non-file-buffer)
+ (run-hook-with-args 'eglot-connect-hook server))
+ (eglot--message
+ "Connected! Server `%s' now managing `%s' buffers \
+in project `%s'."
+ (or (plist-get serverInfo :name)
+ (jsonrpc-name server))
+ managed-major-mode
+ (eglot-project-nickname server))
+ (when tag (throw tag t))))
+ :timeout eglot-connect-timeout
+ :error-fn (eglot--lambda ((ResponseError) code message)
+ (unless cancelled
+ (jsonrpc-shutdown server)
+ (let ((msg (format "%s: %s" code message)))
+ (if tag (throw tag `(error . ,msg))
+ (eglot--error msg)))))
+ :timeout-fn (lambda ()
+ (unless cancelled
+ (jsonrpc-shutdown server)
+ (let ((msg (format "Timed out")))
+ (if tag (throw tag `(error . ,msg))
+ (eglot--error msg))))))
+ (cond ((numberp eglot-sync-connect)
+ (accept-process-output nil eglot-sync-connect))
+ (eglot-sync-connect
+ (while t (accept-process-output nil 30)))))))
+ (pcase retval
+ (`(error . ,msg) (eglot--error msg))
+ (`nil (eglot--message "Waiting in background for server `%s'"
+ (jsonrpc-name server))
+ nil)
+ (_ server)))
+ (quit (jsonrpc-shutdown server) (setq cancelled 'quit)))
+ (setq tag nil))))
+
+(defun eglot--inferior-bootstrap (name contact &optional connect-args)
+ "Use CONTACT to start a server, then connect to it.
+Return a cons of two process objects (CONNECTION . INFERIOR).
+Name both based on NAME.
+CONNECT-ARGS are passed as additional arguments to
+`open-network-stream'."
+ (let* ((port-probe (make-network-process :name "eglot-port-probe-dummy"
+ :server t
+ :host "localhost"
+ :service 0))
+ (port-number (unwind-protect
+ (process-contact port-probe :service)
+ (delete-process port-probe)))
+ inferior connection)
+ (unwind-protect
+ (progn
+ (setq inferior
+ (make-process
+ :name (format "autostart-inferior-%s" name)
+ :stderr (format "*%s stderr*" name)
+ :noquery t
+ :command (cl-subst
+ (format "%s" port-number) :autoport contact)))
+ (setq connection
+ (cl-loop
+ repeat 10 for i from 1
+ do (accept-process-output nil 0.5)
+ while (process-live-p inferior)
+ do (eglot--message
+ "Trying to connect to localhost and port %s (attempt %s)"
+ port-number i)
+ thereis (ignore-errors
+ (apply #'open-network-stream
+ (format "autoconnect-%s" name)
+ nil
+ "localhost" port-number connect-args))))
+ (cons connection inferior))
+ (cond ((and (process-live-p connection)
+ (process-live-p inferior))
+ (eglot--message "Done, connected to %s!" port-number))
+ (t
+ (when inferior (delete-process inferior))
+ (when connection (delete-process connection))
+ (eglot--error "Could not start and connect to server%s"
+ (if inferior
+ (format " started with %s"
+ (process-command inferior))
+ "!")))))))
+
+
+;;; Helpers (move these to API?)
+;;;
+(defun eglot--error (format &rest args)
+ "Error out with FORMAT with ARGS."
+ (error "[eglot] %s" (apply #'format format args)))
+
+(defun eglot--message (format &rest args)
+ "Message out with FORMAT with ARGS."
+ (message "[eglot] %s" (apply #'format format args)))
+
+(defun eglot--warn (format &rest args)
+ "Warning message with FORMAT and ARGS."
+ (apply #'eglot--message (concat "(warning) " format) args)
+ (let ((warning-minimum-level :error))
+ (display-warning 'eglot (apply #'format format args) :warning)))
+
+(defun eglot-current-column () (- (point) (point-at-bol)))
+
+(defvar eglot-current-column-function #'eglot-lsp-abiding-column
+ "Function to calculate the current column.
+
+This is the inverse operation of
+`eglot-move-to-column-function' (which see). It is a function of
+no arguments returning a column number. For buffers managed by
+fully LSP-compliant servers, this should be set to
+`eglot-lsp-abiding-column' (the default), and
+`eglot-current-column' for all others.")
+
+(defun eglot-lsp-abiding-column (&optional lbp)
+ "Calculate current COLUMN as defined by the LSP spec.
+LBP defaults to `line-beginning-position'."
+ (/ (- (length (encode-coding-region (or lbp (line-beginning-position))
+ (point) 'utf-16 t))
+ 2)
+ 2))
+
+(defun eglot--pos-to-lsp-position (&optional pos)
+ "Convert point POS to LSP position."
+ (eglot--widening
+ (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE
+ :character (progn (when pos (goto-char pos))
+ (funcall eglot-current-column-function)))))
+
+(defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column
+ "Function to move to a column reported by the LSP server.
+
+According to the standard, LSP column/character offsets are based
+on a count of UTF-16 code units, not actual visual columns. So
+when LSP says position 3 of a line containing just \"aXbc\",
+where X is a multi-byte character, it actually means `b', not
+`c'. However, many servers don't follow the spec this closely.
+
+For buffers managed by fully LSP-compliant servers, this should
+be set to `eglot-move-to-lsp-abiding-column' (the default), and
+`eglot-move-to-column' for all others.")
+
+(defun eglot-move-to-column (column)
+ "Move to COLUMN without closely following the LSP spec."
+ ;; We cannot use `move-to-column' here, because it moves to *visual*
+ ;; columns, which can be different from LSP columns in case of
+ ;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296,
+ ;; github#297)
+ (goto-char (min (+ (line-beginning-position) column)
+ (line-end-position))))
+
+(defun eglot-move-to-lsp-abiding-column (column)
+ "Move to COLUMN abiding by the LSP spec."
+ (save-restriction
+ (cl-loop
+ with lbp = (line-beginning-position)
+ initially
+ (narrow-to-region lbp (line-end-position))
+ (move-to-column column)
+ for diff = (- column
+ (eglot-lsp-abiding-column lbp))
+ until (zerop diff)
+ do (condition-case eob-err
+ (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2))
+ (end-of-buffer (cl-return eob-err))))))
+
+(defun eglot--lsp-position-to-point (pos-plist &optional marker)
+ "Convert LSP position POS-PLIST to Emacs point.
+If optional MARKER, return a marker instead"
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (min most-positive-fixnum
+ (plist-get pos-plist :line)))
+ (unless (eobp) ;; if line was excessive leave point at eob
+ (let ((tab-width 1)
+ (col (plist-get pos-plist :character)))
+ (unless (wholenump col)
+ (eglot--warn
+ "Caution: LSP server sent invalid character position %s. Using 0 instead."
+ col)
+ (setq col 0))
+ (funcall eglot-move-to-column-function col)))
+ (if marker (copy-marker (point-marker)) (point)))))
+
+(defconst eglot--uri-path-allowed-chars
+ (let ((vec (copy-sequence url-path-allowed-chars)))
+ (aset vec ?: nil) ;; see github#639
+ vec)
+ "Like `url-path-allows-chars' but more restrictive.")
+
+(defun eglot--path-to-uri (path)
+ "URIfy PATH."
+ (let ((truepath (file-truename path)))
+ (concat "file://"
+ ;; Add a leading "/" for local MS Windows-style paths.
+ (if (and (eq system-type 'windows-nt)
+ (not (file-remote-p truepath)))
+ "/")
+ (url-hexify-string
+ ;; Again watch out for trampy paths.
+ (directory-file-name (file-local-name truepath))
+ eglot--uri-path-allowed-chars))))
+
+(defun eglot--uri-to-path (uri)
+ "Convert URI to file path, helped by `eglot--current-server'."
+ (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
+ (let* ((server (eglot-current-server))
+ (remote-prefix (and server
+ (file-remote-p
+ (project-root (eglot--project server)))))
+ (retval (url-filename (url-generic-parse-url (url-unhex-string uri))))
+ ;; Remove the leading "/" for local MS Windows-style paths.
+ (normalized (if (and (not remote-prefix)
+ (eq system-type 'windows-nt)
+ (cl-plusp (length retval)))
+ (substring retval 1)
+ retval)))
+ (concat remote-prefix normalized)))
+
+(defun eglot--snippet-expansion-fn ()
+ "Compute a function to expand snippets.
+Doubles as an indicator of snippet support."
+ (and (boundp 'yas-minor-mode)
+ (symbol-value 'yas-minor-mode)
+ 'yas-expand-snippet))
+
+(defun eglot--format-markup (markup)
+ "Format MARKUP according to LSP's spec."
+ (pcase-let ((`(,string ,mode)
+ (if (stringp markup) (list markup 'gfm-view-mode)
+ (list (plist-get markup :value)
+ (pcase (plist-get markup :kind)
+ ("markdown" 'gfm-view-mode)
+ ("plaintext" 'text-mode)
+ (_ major-mode))))))
+ (with-temp-buffer
+ (setq-local markdown-fontify-code-blocks-natively t)
+ (insert string)
+ (let ((inhibit-message t)
+ (message-log-max nil))
+ (ignore-errors (delay-mode-hooks (funcall mode))))
+ (font-lock-ensure)
+ (string-trim (filter-buffer-substring (point-min) (point-max))))))
+
+(define-obsolete-variable-alias 'eglot-ignored-server-capabilites
+ 'eglot-ignored-server-capabilities "1.8")
+
+(defcustom eglot-ignored-server-capabilities (list)
+ "LSP server capabilities that Eglot could use, but won't.
+You could add, for instance, the symbol
+`:documentHighlightProvider' to prevent automatic highlighting
+under cursor."
+ :type '(set
+ :tag "Tick the ones you're not interested in"
+ (const :tag "Documentation on hover" :hoverProvider)
+ (const :tag "Code completion" :completionProvider)
+ (const :tag "Function signature help" :signatureHelpProvider)
+ (const :tag "Go to definition" :definitionProvider)
+ (const :tag "Go to type definition" :typeDefinitionProvider)
+ (const :tag "Go to implementation" :implementationProvider)
+ (const :tag "Go to declaration" :implementationProvider)
+ (const :tag "Find references" :referencesProvider)
+ (const :tag "Highlight symbols automatically" :documentHighlightProvider)
+ (const :tag "List symbols in buffer" :documentSymbolProvider)
+ (const :tag "List symbols in workspace" :workspaceSymbolProvider)
+ (const :tag "Execute code actions" :codeActionProvider)
+ (const :tag "Code lens" :codeLensProvider)
+ (const :tag "Format buffer" :documentFormattingProvider)
+ (const :tag "Format portion of buffer" :documentRangeFormattingProvider)
+ (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
+ (const :tag "Rename symbol" :renameProvider)
+ (const :tag "Highlight links in document" :documentLinkProvider)
+ (const :tag "Decorate color references" :colorProvider)
+ (const :tag "Fold regions of buffer" :foldingRangeProvider)
+ (const :tag "Execute custom commands" :executeCommandProvider)))
+
+(defun eglot--server-capable (&rest feats)
+ "Determine if current server is capable of FEATS."
+ (unless (cl-some (lambda (feat)
+ (memq feat eglot-ignored-server-capabilites))
+ feats)
+ (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
+ then (cadr probe)
+ for (feat . more) on feats
+ for probe = (plist-member caps feat)
+ if (not probe) do (cl-return nil)
+ if (eq (cadr probe) :json-false) do (cl-return nil)
+ if (not (listp (cadr probe))) do (cl-return (if more nil (cadr probe)))
+ finally (cl-return (or (cadr probe) t)))))
+
+(defun eglot--range-region (range &optional markers)
+ "Return region (BEG . END) that represents LSP RANGE.
+If optional MARKERS, make markers."
+ (let* ((st (plist-get range :start))
+ (beg (eglot--lsp-position-to-point st markers))
+ (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
+ (cons beg end)))
+
+(defun eglot--read-server (prompt &optional dont-if-just-the-one)
+ "Read a running Eglot server from minibuffer using PROMPT.
+If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt
+and just return it. PROMPT shouldn't end with a question mark."
+ (let ((servers (cl-loop for servers
+ being hash-values of eglot--servers-by-project
+ append servers))
+ (name (lambda (srv)
+ (format "%s/%s" (eglot-project-nickname srv)
+ (eglot--major-mode srv)))))
+ (cond ((null servers)
+ (eglot--error "No servers!"))
+ ((or (cdr servers) (not dont-if-just-the-one))
+ (let* ((default (when-let ((current (eglot-current-server)))
+ (funcall name current)))
+ (read (completing-read
+ (if default
+ (format "%s (default %s)? " prompt default)
+ (concat prompt "? "))
+ (mapcar name servers)
+ nil t
+ nil nil
+ default)))
+ (cl-find read servers :key name :test #'equal)))
+ (t (car servers)))))
+
+
+;;; Minor modes
+;;;
+(defvar eglot-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap display-local-help] 'eldoc-doc-buffer)
+ map))
+
+(defvar-local eglot--current-flymake-report-fn nil
+ "Current flymake report function for this buffer.")
+
+(defvar-local eglot--saved-bindings nil
+ "Bindings saved by `eglot--setq-saving'.")
+
+(defvar eglot-stay-out-of '()
+ "List of Emacs things that Eglot should try to stay of.
+Each element is a string, a symbol, or a regexp which is matched
+against a variable's name. Examples include the string
+\"company\" or the symbol `xref'.
+
+Before Eglot starts \"managing\" a particular buffer, it
+opinionatedly sets some peripheral Emacs facilities, such as
+Flymake, Xref and Company. These overriding settings help ensure
+consistent Eglot behaviour and only stay in place until
+\"managing\" stops (usually via `eglot-shutdown'), whereupon the
+previous settings are restored.
+
+However, if you wish for Eglot to stay out of a particular Emacs
+facility that you'd like to keep control of add an element to
+this list and Eglot will refrain from setting it.
+
+For example, to keep your Company customization use
+
+(add-to-list 'eglot-stay-out-of 'company)")
+
+(defun eglot--stay-out-of-p (symbol)
+ "Tell if EGLOT should stay of of SYMBOL."
+ (cl-find (symbol-name symbol) eglot-stay-out-of
+ :test (lambda (s thing)
+ (let ((re (if (symbolp thing) (symbol-name thing) thing)))
+ (string-match re s)))))
+
+(defmacro eglot--setq-saving (symbol binding)
+ `(unless (or (not (boundp ',symbol)) (eglot--stay-out-of-p ',symbol))
+ (push (cons ',symbol (symbol-value ',symbol)) eglot--saved-bindings)
+ (setq-local ,symbol ,binding)))
+
+(defun eglot-managed-p ()
+ "Tell if current buffer is managed by EGLOT."
+ eglot--managed-mode)
+
+(make-obsolete-variable
+ 'eglot--managed-mode-hook 'eglot-managed-mode-hook "1.6")
+
+(defvar eglot-managed-mode-hook nil
+ "A hook run by EGLOT after it started/stopped managing a buffer.
+Use `eglot-managed-p' to determine if current buffer is managed.")
+
+(define-minor-mode eglot--managed-mode
+ "Mode for source buffers managed by some EGLOT project."
+ :init-value nil :lighter nil :keymap eglot-mode-map
+ (cond
+ (eglot--managed-mode
+ (add-hook 'after-change-functions 'eglot--after-change nil t)
+ (add-hook 'before-change-functions 'eglot--before-change nil t)
+ (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
+ ;; Prepend "didClose" to the hook after the "nonoff", so it will run first
+ (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t)
+ (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t)
+ (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t)
+ (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t)
+ (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t)
+ (unless (eglot--stay-out-of-p 'xref)
+ (add-hook 'xref-backend-functions 'eglot-xref-backend nil t))
+ (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t)
+ (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t)
+ (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t)
+ (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t)
+ (eglot--setq-saving eldoc-documentation-functions
+ '(eglot-signature-eldoc-function
+ eglot-hover-eldoc-function))
+ (eglot--setq-saving eldoc-documentation-strategy
+ #'eldoc-documentation-enthusiast)
+ (eglot--setq-saving xref-prompt-for-identifier nil)
+ (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend))
+ (eglot--setq-saving company-backends '(company-capf))
+ (eglot--setq-saving company-tooltip-align-annotations t)
+ (unless (eglot--stay-out-of-p 'imenu)
+ (add-function :before-until (local 'imenu-create-index-function)
+ #'eglot-imenu))
+ (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1))
+ (unless (eglot--stay-out-of-p 'eldoc) (eldoc-mode 1))
+ (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server))))
+ (t
+ (remove-hook 'after-change-functions 'eglot--after-change t)
+ (remove-hook 'before-change-functions 'eglot--before-change t)
+ (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
+ (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t)
+ (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t)
+ (remove-hook 'after-revert-hook 'eglot--after-revert-hook t)
+ (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t)
+ (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t)
+ (remove-hook 'xref-backend-functions 'eglot-xref-backend t)
+ (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t)
+ (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t)
+ (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t)
+ (remove-hook 'pre-command-hook 'eglot--pre-command-hook t)
+ (cl-loop for (var . saved-binding) in eglot--saved-bindings
+ do (set (make-local-variable var) saved-binding))
+ (remove-function (local 'imenu-create-index-function) #'eglot-imenu)
+ (when eglot--current-flymake-report-fn
+ (eglot--report-to-flymake nil)
+ (setq eglot--current-flymake-report-fn nil))
+ (let ((server eglot--cached-server))
+ (setq eglot--cached-server nil)
+ (when server
+ (setf (eglot--managed-buffers server)
+ (delq (current-buffer) (eglot--managed-buffers server)))
+ (when (and eglot-autoshutdown
+ (null (eglot--managed-buffers server)))
+ (eglot-shutdown server))))))
+ ;; Note: the public hook runs before the internal eglot--managed-mode-hook.
+ (run-hooks 'eglot-managed-mode-hook))
+
+(defun eglot--managed-mode-off ()
+ "Turn off `eglot--managed-mode' unconditionally."
+ (eglot--managed-mode -1))
+
+(defun eglot-current-server ()
+ "Return logical EGLOT server for current buffer, nil if none."
+ (setq eglot--cached-server
+ (or eglot--cached-server
+ (cl-find major-mode
+ (gethash (eglot--current-project) eglot--servers-by-project)
+ :key #'eglot--major-mode)
+ (and eglot-extend-to-xref
+ buffer-file-name
+ (gethash (expand-file-name buffer-file-name)
+ eglot--servers-by-xrefed-file)))))
+
+(defun eglot--current-server-or-lose ()
+ "Return current logical EGLOT server connection or error."
+ (or (eglot-current-server)
+ (jsonrpc-error "No current JSON-RPC connection")))
+
+(defvar-local eglot--unreported-diagnostics nil
+ "Unreported Flymake diagnostics for this buffer.")
+
+(defvar revert-buffer-preserve-modes)
+(defun eglot--after-revert-hook ()
+ "Eglot's `after-revert-hook'."
+ (when revert-buffer-preserve-modes (eglot--signal-textDocument/didOpen)))
+
+(defun eglot--maybe-activate-editing-mode ()
+ "Maybe activate `eglot--managed-mode'.
+
+If it is activated, also signal textDocument/didOpen."
+ (unless eglot--managed-mode
+ ;; Called when `revert-buffer-in-progress-p' is t but
+ ;; `revert-buffer-preserve-modes' is nil.
+ (when (and buffer-file-name (eglot-current-server))
+ (setq eglot--unreported-diagnostics `(:just-opened . nil))
+ (eglot--managed-mode)
+ (eglot--signal-textDocument/didOpen))))
+
+(add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode)
+(add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode)
+
+(defun eglot-clear-status (server)
+ "Clear the last JSONRPC error for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (setf (jsonrpc-last-error server) nil))
+
+
+;;; Mode-line, menu and other sugar
+;;;
+(defvar eglot--mode-line-format `(:eval (eglot--mode-line-format)))
+
+(put 'eglot--mode-line-format 'risky-local-variable t)
+
+(defun eglot--mouse-call (what)
+ "Make an interactive lambda for calling WHAT from mode-line."
+ (lambda (event)
+ (interactive "e")
+ (let ((start (event-start event))) (with-selected-window (posn-window start)
+ (save-excursion
+ (goto-char (or (posn-point start)
+ (point)))
+ (call-interactively what)
+ (force-mode-line-update t))))))
+
+(defun eglot--mode-line-props (thing face defs &optional prepend)
+ "Helper for function `eglot--mode-line-format'.
+Uses THING, FACE, DEFS and PREPEND."
+ (cl-loop with map = (make-sparse-keymap)
+ for (elem . rest) on defs
+ for (key def help) = elem
+ do (define-key map `[mode-line ,key] (eglot--mouse-call def))
+ concat (format "%s: %s" key help) into blurb
+ when rest concat "\n" into blurb
+ finally (return `(:propertize ,thing
+ face ,face
+ keymap ,map help-echo ,(concat prepend blurb)
+ mouse-face mode-line-highlight))))
+
+(defun eglot--mode-line-format ()
+ "Compose the EGLOT's mode-line."
+ (pcase-let* ((server (eglot-current-server))
+ (nick (and server (eglot-project-nickname server)))
+ (pending (and server (hash-table-count
+ (jsonrpc--request-continuations server))))
+ (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner server)))
+ (last-error (and server (jsonrpc-last-error server))))
+ (append
+ `(,(eglot--mode-line-props "eglot" 'eglot-mode-line nil))
+ (when nick
+ `(":" ,(eglot--mode-line-props
+ nick 'eglot-mode-line
+ '((C-mouse-1 eglot-stderr-buffer "go to stderr buffer")
+ (mouse-1 eglot-events-buffer "go to events buffer")
+ (mouse-2 eglot-shutdown "quit server")
+ (mouse-3 eglot-reconnect "reconnect to server")))
+ ,@(when last-error
+ `("/" ,(eglot--mode-line-props
+ "error" 'compilation-mode-line-fail
+ '((mouse-3 eglot-clear-status "clear this status"))
+ (format "An error occurred: %s\n" (plist-get last-error
+ :message)))))
+ ,@(when (and doing (not done-p))
+ `("/" ,(eglot--mode-line-props doing
+ 'compilation-mode-line-run '())))
+ ,@(when (cl-plusp pending)
+ `("/" ,(eglot--mode-line-props
+ (format "%d" pending) 'warning
+ '((mouse-3 eglot-forget-pending-continuations
+ "forget pending continuations"))
+ "Number of outgoing, \
+still unanswered LSP requests to the server"))))))))
+
+(add-to-list 'mode-line-misc-info
+ `(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
+
+(put 'eglot-note 'flymake-category 'flymake-note)
+(put 'eglot-warning 'flymake-category 'flymake-warning)
+(put 'eglot-error 'flymake-category 'flymake-error)
+
+(defalias 'eglot--make-diag 'flymake-make-diagnostic)
+(defalias 'eglot--diag-data 'flymake-diagnostic-data)
+
+(cl-loop for i from 1
+ for type in '(eglot-note eglot-warning eglot-error )
+ do (put type 'flymake-overlay-control
+ `((mouse-face . highlight)
+ (priority . ,(+ 50 i))
+ (keymap . ,(let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1]
+ (eglot--mouse-call 'eglot-code-actions))
+ map)))))
+
+
+;;; Protocol implementation (Requests, notifications, etc)
+;;;
+(cl-defmethod eglot-handle-notification
+ (_server method &key &allow-other-keys)
+ "Handle unknown notification."
+ (unless (or (string-prefix-p "$" (format "%s" method))
+ (not (memq 'disallow-unknown-methods eglot-strict-mode)))
+ (eglot--warn "Server sent unknown notification method `%s'" method)))
+
+(cl-defmethod eglot-handle-request
+ (_server method &key &allow-other-keys)
+ "Handle unknown request."
+ (when (memq 'disallow-unknown-methods eglot-strict-mode)
+ (jsonrpc-error "Unknown request method `%s'" method)))
+
+(cl-defmethod eglot-execute-command
+ (server command arguments)
+ "Execute COMMAND on SERVER with `:workspace/executeCommand'.
+COMMAND is a symbol naming the command."
+ (jsonrpc-request server :workspace/executeCommand
+ `(:command ,(format "%s" command) :arguments ,arguments)))
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql window/showMessage)) &key type message)
+ "Handle notification window/showMessage."
+ (eglot--message (propertize "Server reports (type=%s): %s"
+ 'face (if (<= type 1) 'error))
+ type message))
+
+(cl-defmethod eglot-handle-request
+ (_server (_method (eql window/showMessageRequest)) &key type message actions)
+ "Handle server request window/showMessageRequest."
+ (let* ((actions (append actions nil)) ;; gh#627
+ (label (completing-read
+ (concat
+ (format (propertize "[eglot] Server reports (type=%s): %s"
+ 'face (if (<= type 1) 'error))
+ type message)
+ "\nChoose an option: ")
+ (or (mapcar (lambda (obj) (plist-get obj :title)) actions)
+ '("OK"))
+ nil t (plist-get (elt actions 0) :title))))
+ (if label `(:title ,label) :null)))
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql window/logMessage)) &key _type _message)
+ "Handle notification window/logMessage.") ;; noop, use events buffer
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql telemetry/event)) &rest _any)
+ "Handle notification telemetry/event.") ;; noop, use events buffer
+
+(cl-defmethod eglot-handle-notification
+ (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
+ &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
+ "Handle notification publishDiagnostics."
+ (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri))))
+ (with-current-buffer buffer
+ (cl-loop
+ for diag-spec across diagnostics
+ collect (eglot--dbind ((Diagnostic) range message severity source)
+ diag-spec
+ (setq message (concat source ": " message))
+ (pcase-let
+ ((sev severity)
+ (`(,beg . ,end) (eglot--range-region range)))
+ ;; Fallback to `flymake-diag-region' if server
+ ;; botched the range
+ (when (= beg end)
+ (if-let* ((st (plist-get range :start))
+ (diag-region
+ (flymake-diag-region
+ (current-buffer) (1+ (plist-get st :line))
+ (plist-get st :character))))
+ (setq beg (car diag-region) end (cdr diag-region))
+ (eglot--widening
+ (goto-char (point-min))
+ (setq beg
+ (point-at-bol
+ (1+ (plist-get (plist-get range :start) :line))))
+ (setq end
+ (point-at-eol
+ (1+ (plist-get (plist-get range :end) :line)))))))
+ (eglot--make-diag (current-buffer) beg end
+ (cond ((null sev) 'eglot-error)
+ ((<= sev 1) 'eglot-error)
+ ((= sev 2) 'eglot-warning)
+ (t 'eglot-note))
+ message `((eglot-lsp-diag . ,diag-spec)))))
+ into diags
+ finally (cond (eglot--current-flymake-report-fn
+ (eglot--report-to-flymake diags))
+ (t
+ (setq eglot--unreported-diagnostics (cons t diags))))))
+ (jsonrpc--debug server "Diagnostics received for unvisited %s" uri)))
+
+(cl-defun eglot--register-unregister (server things how)
+ "Helper for `registerCapability'.
+THINGS are either registrations or unregisterations (sic)."
+ (cl-loop
+ for thing in (cl-coerce things 'list)
+ do (eglot--dbind ((Registration) id method registerOptions) thing
+ (apply (cl-ecase how
+ (register 'eglot-register-capability)
+ (unregister 'eglot-unregister-capability))
+ server (intern method) id registerOptions))))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql client/registerCapability)) &key registrations)
+ "Handle server request client/registerCapability."
+ (eglot--register-unregister server registrations 'register))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql client/unregisterCapability))
+ &key unregisterations) ;; XXX: "unregisterations" (sic)
+ "Handle server request client/unregisterCapability."
+ (eglot--register-unregister server unregisterations 'unregister))
+
+(cl-defmethod eglot-handle-request
+ (_server (_method (eql workspace/applyEdit)) &key _label edit)
+ "Handle server request workspace/applyEdit."
+ (eglot--apply-workspace-edit edit eglot-confirm-server-initiated-edits))
+
+(defun eglot--TextDocumentIdentifier ()
+ "Compute TextDocumentIdentifier object for current buffer."
+ `(:uri ,(eglot--path-to-uri (or buffer-file-name
+ (ignore-errors
+ (buffer-file-name
+ (buffer-base-buffer)))))))
+
+(defvar-local eglot--versioned-identifier 0)
+
+(defun eglot--VersionedTextDocumentIdentifier ()
+ "Compute VersionedTextDocumentIdentifier object for current buffer."
+ (append (eglot--TextDocumentIdentifier)
+ `(:version ,eglot--versioned-identifier)))
+
+(defun eglot--TextDocumentItem ()
+ "Compute TextDocumentItem object for current buffer."
+ (append
+ (eglot--VersionedTextDocumentIdentifier)
+ (list :languageId
+ (eglot--language-id (eglot--current-server-or-lose))
+ :text
+ (eglot--widening
+ (buffer-substring-no-properties (point-min) (point-max))))))
+
+(defun eglot--TextDocumentPositionParams ()
+ "Compute TextDocumentPositionParams."
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :position (eglot--pos-to-lsp-position)))
+
+(defvar-local eglot--last-inserted-char nil
+ "If non-nil, value of the last inserted character in buffer.")
+
+(defun eglot--post-self-insert-hook ()
+ "Set `eglot--last-inserted-char'."
+ (setq eglot--last-inserted-char last-input-event))
+
+(defun eglot--pre-command-hook ()
+ "Reset `eglot--last-inserted-char'."
+ (setq eglot--last-inserted-char nil))
+
+(defun eglot--CompletionParams ()
+ (append
+ (eglot--TextDocumentPositionParams)
+ `(:context
+ ,(if-let (trigger (and (characterp eglot--last-inserted-char)
+ (cl-find eglot--last-inserted-char
+ (eglot--server-capable :completionProvider
+ :triggerCharacters)
+ :key (lambda (str) (aref str 0))
+ :test #'char-equal)))
+ `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1)))))
+
+(defvar-local eglot--recent-changes nil
+ "Recent buffer changes as collected by `eglot--before-change'.")
+
+(cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what)
+ "Tell if SERVER is ready for WHAT in current buffer."
+ (and (cl-call-next-method) (not eglot--recent-changes)))
+
+(defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.")
+
+(defun eglot--before-change (beg end)
+ "Hook onto `before-change-functions' with BEG and END."
+ (when (listp eglot--recent-changes)
+ ;; Records BEG and END, crucially convert them into LSP
+ ;; (line/char) positions before that information is lost (because
+ ;; the after-change thingy doesn't know if newlines were
+ ;; deleted/added). Also record markers of BEG and END
+ ;; (github#259)
+ (push `(,(eglot--pos-to-lsp-position beg)
+ ,(eglot--pos-to-lsp-position end)
+ (,beg . ,(copy-marker beg nil))
+ (,end . ,(copy-marker end t)))
+ eglot--recent-changes)))
+
+(defun eglot--after-change (beg end pre-change-length)
+ "Hook onto `after-change-functions'.
+Records BEG, END and PRE-CHANGE-LENGTH locally."
+ (cl-incf eglot--versioned-identifier)
+ (pcase (and (listp eglot--recent-changes)
+ (car eglot--recent-changes))
+ (`(,lsp-beg ,lsp-end
+ (,b-beg . ,b-beg-marker)
+ (,b-end . ,b-end-marker))
+ ;; github#259 and github#367: With `capitalize-word' or somesuch,
+ ;; `before-change-functions' always records the whole word's
+ ;; `b-beg' and `b-end'. Similarly, when coalescing two lines
+ ;; into one, `fill-paragraph' they mark the end of the first line
+ ;; up to the end of the second line. In both situations, args
+ ;; received here contradict that information: `beg' and `end'
+ ;; will differ by 1 and will likely only encompass the letter
+ ;; that was capitalized or, in the sentence-joining situation,
+ ;; the replacement of the newline with a space. That's we keep
+ ;; markers _and_ positions so we're able to detect and correct
+ ;; this. We ignore `beg', `len' and `pre-change-len' and send
+ ;; "fuller" information about the region from the markers. I've
+ ;; also experimented with doing this unconditionally but it seems
+ ;; to break when newlines are added.
+ (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
+ (or (/= beg b-beg) (/= end b-end)))
+ (setcar eglot--recent-changes
+ `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
+ ,(buffer-substring-no-properties b-beg-marker
+ b-end-marker)))
+ (setcar eglot--recent-changes
+ `(,lsp-beg ,lsp-end ,pre-change-length
+ ,(buffer-substring-no-properties beg end)))))
+ (_ (setf eglot--recent-changes :emacs-messup)))
+ (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer))
+ (let ((buf (current-buffer)))
+ (setq eglot--change-idle-timer
+ (run-with-idle-timer
+ eglot-send-changes-idle-time
+ nil (lambda () (eglot--when-live-buffer buf
+ (when eglot--managed-mode
+ (eglot--signal-textDocument/didChange)
+ (setq eglot--change-idle-timer nil))))))))
+
+;; HACK! Launching a deferred sync request with outstanding changes is a
+;; bad idea, since that might lead to the request never having a
+;; chance to run, because `jsonrpc-connection-ready-p'.
+(advice-add #'jsonrpc-request :before
+ (cl-function (lambda (_proc _method _params &key
+ deferred &allow-other-keys)
+ (when (and eglot--managed-mode deferred)
+ (eglot--signal-textDocument/didChange))))
+ '((name . eglot--signal-textDocument/didChange)))
+
+(defvar-local eglot-workspace-configuration ()
+ "Alist of (SECTION . VALUE) entries configuring the LSP server.
+SECTION should be a keyword or a string, value can be anything
+that can be converted to JSON.")
+
+;;;###autoload
+(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
+
+(defun eglot-signal-didChangeConfiguration (server)
+ "Send a `:workspace/didChangeConfiguration' signal to SERVER.
+When called interactively, use the currently active server"
+ (interactive (list (eglot--current-server-or-lose)))
+ (jsonrpc-notify
+ server :workspace/didChangeConfiguration
+ (list
+ :settings
+ (cl-loop for (section . v) in eglot-workspace-configuration
+ collect (if (keywordp section)
+ section
+ (intern (format ":%s" section)))
+ collect v))))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql workspace/configuration)) &key items)
+ "Handle server request workspace/configuration."
+ (apply #'vector
+ (mapcar
+ (eglot--lambda ((ConfigurationItem) scopeUri section)
+ (with-temp-buffer
+ (let* ((uri-path (eglot--uri-to-path scopeUri))
+ (default-directory
+ (if (and (not (string-empty-p uri-path))
+ (file-directory-p uri-path))
+ (file-name-as-directory uri-path)
+ (project-root (eglot--project server)))))
+ (setq-local major-mode (eglot--major-mode server))
+ (hack-dir-local-variables-non-file-buffer)
+ (alist-get section eglot-workspace-configuration
+ nil nil
+ (lambda (wsection section)
+ (string=
+ (if (keywordp wsection)
+ (substring (symbol-name wsection) 1)
+ wsection)
+ section))))))
+ items)))
+
+(defun eglot--signal-textDocument/didChange ()
+ "Send textDocument/didChange to server."
+ (when eglot--recent-changes
+ (let* ((server (eglot--current-server-or-lose))
+ (sync-capability (eglot--server-capable :textDocumentSync))
+ (sync-kind (if (numberp sync-capability) sync-capability
+ (plist-get sync-capability :change)))
+ (full-sync-p (or (eq sync-kind 1)
+ (eq :emacs-messup eglot--recent-changes))))
+ (jsonrpc-notify
+ server :textDocument/didChange
+ (list
+ :textDocument (eglot--VersionedTextDocumentIdentifier)
+ :contentChanges
+ (if full-sync-p
+ (vector `(:text ,(eglot--widening
+ (buffer-substring-no-properties (point-min)
+ (point-max)))))
+ (cl-loop for (beg end len text) in (reverse eglot--recent-changes)
+ ;; github#259: `capitalize-word' and commands based
+ ;; on `casify_region' will cause multiple duplicate
+ ;; empty entries in `eglot--before-change' calls
+ ;; without an `eglot--after-change' reciprocal.
+ ;; Weed them out here.
+ when (numberp len)
+ vconcat `[,(list :range `(:start ,beg :end ,end)
+ :rangeLength len :text text)]))))
+ (setq eglot--recent-changes nil)
+ (setf (eglot--spinner server) (list nil :textDocument/didChange t))
+ (jsonrpc--call-deferred server))))
+
+(defun eglot--signal-textDocument/didOpen ()
+ "Send textDocument/didOpen to server."
+ (setq eglot--recent-changes nil eglot--versioned-identifier 0)
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
+
+(defun eglot--signal-textDocument/didClose ()
+ "Send textDocument/didClose to server."
+ (with-demoted-errors
+ "[eglot] error sending textDocument/didClose: %s"
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier)))))
+
+(defun eglot--signal-textDocument/willSave ()
+ "Send textDocument/willSave to server."
+ (let ((server (eglot--current-server-or-lose))
+ (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
+ (jsonrpc-notify server :textDocument/willSave params)
+ (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
+ (ignore-errors
+ (eglot--apply-text-edits
+ (jsonrpc-request server :textDocument/willSaveWaitUntil params
+ :timeout 0.5))))))
+
+(defun eglot--signal-textDocument/didSave ()
+ "Send textDocument/didSave to server."
+ (eglot--signal-textDocument/didChange)
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didSave
+ (list
+ ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
+ :text (buffer-substring-no-properties (point-min) (point-max))
+ :textDocument (eglot--TextDocumentIdentifier))))
+
+(defun eglot-flymake-backend (report-fn &rest _more)
+ "A Flymake backend for Eglot.
+Calls REPORT-FN (or arranges for it to be called) when the server
+publishes diagnostics. Between calls to this function, REPORT-FN
+may be called multiple times (respecting the protocol of
+`flymake-backend-functions')."
+ (cond (eglot--managed-mode
+ (setq eglot--current-flymake-report-fn report-fn)
+ ;; Report anything unreported
+ (when eglot--unreported-diagnostics
+ (eglot--report-to-flymake (cdr eglot--unreported-diagnostics))))
+ (t
+ (funcall report-fn nil))))
+
+(defun eglot--report-to-flymake (diags)
+ "Internal helper for `eglot-flymake-backend'."
+ (save-restriction
+ (widen)
+ (funcall eglot--current-flymake-report-fn diags
+ ;; If the buffer hasn't changed since last
+ ;; call to the report function, flymake won't
+ ;; delete old diagnostics. Using :region
+ ;; keyword forces flymake to delete
+ ;; them (github#159).
+ :region (cons (point-min) (point-max))))
+ (setq eglot--unreported-diagnostics nil))
+
+(defun eglot-xref-backend () "EGLOT xref backend." 'eglot)
+
+(defvar eglot--temp-location-buffers (make-hash-table :test #'equal)
+ "Helper variable for `eglot--handling-xrefs'.")
+
+(defvar eglot-xref-lessp-function #'ignore
+ "Compare two `xref-item' objects for sorting.")
+
+(cl-defmacro eglot--collecting-xrefs ((collector) &rest body)
+ "Sort and handle xrefs collected with COLLECTOR in BODY."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((collected (cl-gensym "collected")))
+ `(unwind-protect
+ (let (,collected)
+ (cl-flet ((,collector (xref) (push xref ,collected)))
+ ,@body)
+ (setq ,collected (nreverse ,collected))
+ (sort ,collected eglot-xref-lessp-function))
+ (maphash (lambda (_uri buf) (kill-buffer buf)) eglot--temp-location-buffers)
+ (clrhash eglot--temp-location-buffers))))
+
+(defun eglot--xref-make-match (name uri range)
+ "Like `xref-make-match' but with LSP's NAME, URI and RANGE.
+Try to visit the target file for a richer summary line."
+ (pcase-let*
+ ((file (eglot--uri-to-path uri))
+ (visiting (or (find-buffer-visiting file)
+ (gethash uri eglot--temp-location-buffers)))
+ (collect (lambda ()
+ (eglot--widening
+ (pcase-let* ((`(,beg . ,end) (eglot--range-region range))
+ (bol (progn (goto-char beg) (point-at-bol)))
+ (substring (buffer-substring bol (point-at-eol)))
+ (hi-beg (- beg bol))
+ (hi-end (- (min (point-at-eol) end) bol)))
+ (add-face-text-property hi-beg hi-end 'xref-match
+ t substring)
+ (list substring (1+ (current-line)) (eglot-current-column)
+ (- end beg))))))
+ (`(,summary ,line ,column ,length)
+ (cond
+ (visiting (with-current-buffer visiting (funcall collect)))
+ ((file-readable-p file) (with-current-buffer
+ (puthash uri (generate-new-buffer " *temp*")
+ eglot--temp-location-buffers)
+ (insert-file-contents file)
+ (funcall collect)))
+ (t ;; fall back to the "dumb strategy"
+ (let* ((start (cl-getf range :start))
+ (line (1+ (cl-getf start :line)))
+ (start-pos (cl-getf start :character))
+ (end-pos (cl-getf (cl-getf range :end) :character)))
+ (list name line start-pos (- end-pos start-pos)))))))
+ (setf (gethash (expand-file-name file) eglot--servers-by-xrefed-file)
+ (eglot--current-server-or-lose))
+ (xref-make-match summary (xref-make-file-location file line column) length)))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
+ (eglot--error "Cannot (yet) provide reliable completion table for LSP symbols"))
+
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
+ ;; JT@19/10/09: This is a totally dummy identifier that isn't even
+ ;; passed to LSP. The reason for this particular wording is to
+ ;; construct a readable message "No references for LSP identifier at
+ ;; point.". See https://github.com/joaotavora/eglot/issues/314
+ "LSP identifier at point.")
+
+(defvar eglot--lsp-xref-refs nil
+ "`xref' objects for overriding `xref-backend-references''s.")
+
+(cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability)
+ "Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY."
+ (unless (eglot--server-capable
+ (or capability
+ (intern
+ (format ":%sProvider"
+ (cadr (split-string (symbol-name method)
+ "/"))))))
+ (eglot--error "Sorry, this server doesn't do %s" method))
+ (let ((response
+ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ method (append (eglot--TextDocumentPositionParams) extra-params))))
+ (eglot--collecting-xrefs (collect)
+ (mapc
+ (lambda (loc-or-loc-link)
+ (let ((sym-name (symbol-name (symbol-at-point))))
+ (eglot--dcase loc-or-loc-link
+ (((LocationLink) targetUri targetSelectionRange)
+ (collect (eglot--xref-make-match sym-name
+ targetUri targetSelectionRange)))
+ (((Location) uri range)
+ (collect (eglot--xref-make-match sym-name
+ uri range))))))
+ (if (vectorp response) response (and response (list response)))))))
+
+(cl-defun eglot--lsp-xref-helper (method &key extra-params capability )
+ "Helper for `eglot-find-declaration' & friends."
+ (let ((eglot--lsp-xref-refs (eglot--lsp-xrefs-for-method
+ method
+ :extra-params extra-params
+ :capability capability)))
+ (if eglot--lsp-xref-refs
+ (xref-find-references "LSP identifier at point.")
+ (eglot--message "%s returned no references" method))))
+
+(defun eglot-find-declaration ()
+ "Find declaration for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/declaration))
+
+(defun eglot-find-implementation ()
+ "Find implementation for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/implementation))
+
+(defun eglot-find-typeDefinition ()
+ "Find type definition for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/typeDefinition))
+
+(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) _identifier)
+ (eglot--lsp-xrefs-for-method :textDocument/definition))
+
+(cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier)
+ (or
+ eglot--lsp-xref-refs
+ (eglot--lsp-xrefs-for-method
+ :textDocument/references :extra-params `(:context (:includeDeclaration t)))))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
+ (when (eglot--server-capable :workspaceSymbolProvider)
+ (eglot--collecting-xrefs (collect)
+ (mapc
+ (eglot--lambda ((SymbolInformation) name location)
+ (eglot--dbind ((Location) uri range) location
+ (collect (eglot--xref-make-match name uri range))))
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :workspace/symbol
+ `(:query ,pattern))))))
+
+(defun eglot-format-buffer ()
+ "Format contents of current buffer."
+ (interactive)
+ (eglot-format nil nil))
+
+(defun eglot-format (&optional beg end)
+ "Format region BEG END.
+If either BEG or END is nil, format entire buffer.
+Interactively, format active region, or entire buffer if region
+is not active."
+ (interactive (and (region-active-p) (list (region-beginning) (region-end))))
+ (pcase-let ((`(,method ,cap ,args)
+ (cond
+ ((and beg end)
+ `(:textDocument/rangeFormatting
+ :documentRangeFormattingProvider
+ (:range ,(list :start (eglot--pos-to-lsp-position beg)
+ :end (eglot--pos-to-lsp-position end)))))
+ (t
+ '(:textDocument/formatting :documentFormattingProvider nil)))))
+ (unless (eglot--server-capable cap)
+ (eglot--error "Server can't format!"))
+ (eglot--apply-text-edits
+ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ method
+ (cl-list*
+ :textDocument (eglot--TextDocumentIdentifier)
+ :options (list :tabSize tab-width
+ :insertSpaces (if indent-tabs-mode :json-false t))
+ args)
+ :deferred method))))
+
+(defun eglot-completion-at-point ()
+ "EGLOT's `completion-at-point' function."
+ ;; Commit logs for this function help understand what's going on.
+ (when-let (completion-capability (eglot--server-capable :completionProvider))
+ (let* ((server (eglot--current-server-or-lose))
+ (sort-completions
+ (lambda (completions)
+ (cl-sort completions
+ #'string-lessp
+ :key (lambda (c)
+ (or (plist-get
+ (get-text-property 0 'eglot--lsp-item c)
+ :sortText)
+ "")))))
+ (metadata `(metadata (category . eglot)
+ (display-sort-function . ,sort-completions)))
+ resp items (cached-proxies :none)
+ (proxies
+ (lambda ()
+ (if (listp cached-proxies) cached-proxies
+ (setq resp
+ (jsonrpc-request server
+ :textDocument/completion
+ (eglot--CompletionParams)
+ :deferred :textDocument/completion
+ :cancel-on-input t))
+ (setq items (append
+ (if (vectorp resp) resp (plist-get resp :items))
+ nil))
+ (setq cached-proxies
+ (mapcar
+ (jsonrpc-lambda
+ (&rest item &key label insertText insertTextFormat
+ &allow-other-keys)
+ (let ((proxy
+ (cond ((and (eql insertTextFormat 2)
+ (eglot--snippet-expansion-fn))
+ (string-trim-left label))
+ ((and insertText
+ (not (string-empty-p insertText)))
+ insertText)
+ (t
+ (string-trim-left label)))))
+ (unless (zerop (length proxy))
+ (put-text-property 0 1 'eglot--lsp-item item proxy))
+ proxy))
+ items)))))
+ (resolved (make-hash-table))
+ (resolve-maybe
+ ;; Maybe completion/resolve JSON object `lsp-comp' into
+ ;; another JSON object, if at all possible. Otherwise,
+ ;; just return lsp-comp.
+ (lambda (lsp-comp)
+ (or (gethash lsp-comp resolved)
+ (setf (gethash lsp-comp resolved)
+ (if (and (eglot--server-capable :completionProvider
+ :resolveProvider)
+ (plist-get lsp-comp :data))
+ (jsonrpc-request server :completionItem/resolve
+ lsp-comp :cancel-on-input t)
+ lsp-comp)))))
+ (bounds (bounds-of-thing-at-point 'symbol)))
+ (list
+ (or (car bounds) (point))
+ (or (cdr bounds) (point))
+ (lambda (probe pred action)
+ (cond
+ ((eq action 'metadata) metadata) ; metadata
+ ((eq action 'lambda) ; test-completion
+ (test-completion probe (funcall proxies)))
+ ((eq (car-safe action) 'boundaries) nil) ; boundaries
+ ((null action) ; try-completion
+ (try-completion probe (funcall proxies)))
+ ((eq action t) ; all-completions
+ (all-completions
+ ""
+ (funcall proxies)
+ (lambda (proxy)
+ (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
+ (filterText (plist-get item :filterText)))
+ (and (or (null pred) (funcall pred proxy))
+ (string-prefix-p
+ probe (or filterText proxy) completion-ignore-case))))))))
+ :annotation-function
+ (lambda (proxy)
+ (eglot--dbind ((CompletionItem) detail kind)
+ (get-text-property 0 'eglot--lsp-item proxy)
+ (let* ((detail (and (stringp detail)
+ (not (string= detail ""))
+ detail))
+ (annotation
+ (or detail
+ (cdr (assoc kind eglot--kind-names)))))
+ (when annotation
+ (concat " "
+ (propertize annotation
+ 'face 'font-lock-function-name-face))))))
+ :company-kind
+ ;; Associate each lsp-item with a lsp-kind symbol.
+ (lambda (proxy)
+ (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))
+ (kind (alist-get (plist-get lsp-item :kind)
+ eglot--kind-names)))
+ (intern (downcase kind))))
+ :company-docsig
+ ;; FIXME: autoImportText is specific to the pyright language server
+ (lambda (proxy)
+ (when-let* ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy))
+ (data (plist-get (funcall resolve-maybe lsp-comp) :data))
+ (import-text (plist-get data :autoImportText)))
+ import-text))
+ :company-doc-buffer
+ (lambda (proxy)
+ (let* ((documentation
+ (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)))
+ (plist-get (funcall resolve-maybe lsp-comp) :documentation)))
+ (formatted (and documentation
+ (eglot--format-markup documentation))))
+ (when formatted
+ (with-current-buffer (get-buffer-create " *eglot doc*")
+ (erase-buffer)
+ (insert formatted)
+ (current-buffer)))))
+ :company-require-match 'never
+ :company-prefix-length
+ (save-excursion
+ (when (car bounds) (goto-char (car bounds)))
+ (when (listp completion-capability)
+ (looking-back
+ (regexp-opt
+ (cl-coerce (cl-getf completion-capability :triggerCharacters) 'list))
+ (line-beginning-position))))
+ :exclusive 'no
+ :exit-function
+ (lambda (proxy status)
+ (when (eq status 'finished)
+ ;; To assist in using this whole `completion-at-point'
+ ;; function inside `completion-in-region', ensure the exit
+ ;; function runs in the buffer where the completion was
+ ;; triggered from. This should probably be in Emacs itself.
+ ;; (github#505)
+ (with-current-buffer (if (minibufferp)
+ (window-buffer (minibuffer-selected-window))
+ (current-buffer))
+ (eglot--dbind ((CompletionItem) insertTextFormat
+ insertText textEdit additionalTextEdits label)
+ (funcall
+ resolve-maybe
+ (or (get-text-property 0 'eglot--lsp-item proxy)
+ ;; When selecting from the *Completions*
+ ;; buffer, `proxy' won't have any properties.
+ ;; A lookup should fix that (github#148)
+ (get-text-property
+ 0 'eglot--lsp-item
+ (cl-find proxy (funcall proxies) :test #'string=))))
+ (let ((snippet-fn (and (eql insertTextFormat 2)
+ (eglot--snippet-expansion-fn))))
+ (cond (textEdit
+ ;; Undo (yes, undo) the newly inserted completion.
+ ;; If before completion the buffer was "foo.b" and
+ ;; now is "foo.bar", `proxy' will be "bar". We
+ ;; want to delete only "ar" (`proxy' minus the
+ ;; symbol whose bounds we've calculated before)
+ ;; (github#160).
+ (delete-region (+ (- (point) (length proxy))
+ (if bounds
+ (- (cdr bounds) (car bounds))
+ 0))
+ (point))
+ (eglot--dbind ((TextEdit) range newText) textEdit
+ (pcase-let ((`(,beg . ,end)
+ (eglot--range-region range)))
+ (delete-region beg end)
+ (goto-char beg)
+ (funcall (or snippet-fn #'insert) newText)))
+ (when (cl-plusp (length additionalTextEdits))
+ (eglot--apply-text-edits additionalTextEdits)))
+ (snippet-fn
+ ;; A snippet should be inserted, but using plain
+ ;; `insertText'. This requires us to delete the
+ ;; whole completion, since `insertText' is the full
+ ;; completion's text.
+ (delete-region (- (point) (length proxy)) (point))
+ (funcall snippet-fn (or insertText label)))))
+ (eglot--signal-textDocument/didChange)
+ (eldoc)))))))))
+
+(defun eglot--hover-info (contents &optional range)
+ (let ((heading (and range (pcase-let ((`(,beg . ,end) (eglot--range-region range)))
+ (concat (buffer-substring beg end) ": "))))
+ (body (mapconcat #'eglot--format-markup
+ (if (vectorp contents) contents (list contents)) "\n")))
+ (when (or heading (cl-plusp (length body))) (concat heading body))))
+
+(defun eglot--sig-info (sigs active-sig sig-help-active-param)
+ (cl-loop
+ for (sig . moresigs) on (append sigs nil) for i from 0
+ concat
+ (eglot--dbind ((SignatureInformation) label documentation parameters activeParameter) sig
+ (with-temp-buffer
+ (save-excursion (insert label))
+ (let ((active-param (or activeParameter sig-help-active-param))
+ params-start params-end)
+ ;; Ad-hoc attempt to parse label as <name>(<params>)
+ (when (looking-at "\\([^(]+\\)(\\([^)]+\\))")
+ (setq params-start (match-beginning 2) params-end (match-end 2))
+ (add-face-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-function-name-face))
+ (when (eql i active-sig)
+ ;; Decide whether to add one-line-summary to signature line
+ (when (and (stringp documentation)
+ (string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)"
+ documentation))
+ (setq documentation (match-string 1 documentation))
+ (unless (string-prefix-p (string-trim documentation) label)
+ (goto-char (point-max))
+ (insert ": " (eglot--format-markup documentation))))
+ ;; Decide what to do with the active parameter...
+ (when (and (eql i active-sig) active-param
+ (< -1 active-param (length parameters)))
+ (eglot--dbind ((ParameterInformation) label documentation)
+ (aref parameters active-param)
+ ;; ...perhaps highlight it in the formals list
+ (when params-start
+ (goto-char params-start)
+ (pcase-let
+ ((`(,beg ,end)
+ (if (stringp label)
+ (let ((case-fold-search nil))
+ (and (re-search-forward
+ (concat "\\<" (regexp-quote label) "\\>")
+ params-end t)
+ (list (match-beginning 0) (match-end 0))))
+ (mapcar #'1+ (append label nil)))))
+ (if (and beg end)
+ (add-face-text-property
+ beg end
+ 'eldoc-highlight-function-argument))))
+ ;; ...and/or maybe add its doc on a line by its own.
+ (when documentation
+ (goto-char (point-max))
+ (insert "\n"
+ (propertize
+ (if (stringp label)
+ label
+ (apply #'buffer-substring (mapcar #'1+ label)))
+ 'face 'eldoc-highlight-function-argument)
+ ": " (eglot--format-markup documentation))))))
+ (buffer-string))))
+ when moresigs concat "\n"))
+
+(defun eglot-signature-eldoc-function (cb)
+ "A member of `eldoc-documentation-functions', for signatures."
+ (when (eglot--server-capable :signatureHelpProvider)
+ (let ((buf (current-buffer)))
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/signatureHelp (eglot--TextDocumentPositionParams)
+ :success-fn
+ (eglot--lambda ((SignatureHelp)
+ signatures activeSignature activeParameter)
+ (eglot--when-buffer-window buf
+ (funcall cb
+ (unless (seq-empty-p signatures)
+ (eglot--sig-info signatures
+ activeSignature
+ activeParameter)))))
+ :deferred :textDocument/signatureHelp))
+ t))
+
+(defun eglot-hover-eldoc-function (cb)
+ "A member of `eldoc-documentation-functions', for hover."
+ (when (eglot--server-capable :hoverProvider)
+ (let ((buf (current-buffer)))
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/hover (eglot--TextDocumentPositionParams)
+ :success-fn (eglot--lambda ((Hover) contents range)
+ (eglot--when-buffer-window buf
+ (let ((info (unless (seq-empty-p contents)
+ (eglot--hover-info contents range))))
+ (funcall cb info :buffer t))))
+ :deferred :textDocument/hover))
+ (eglot--highlight-piggyback cb)
+ t))
+
+(defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.")
+
+(defun eglot--highlight-piggyback (_cb)
+ "Request and handle `:textDocument/documentHighlight'."
+ ;; FIXME: Obviously, this is just piggy backing on eldoc's calls for
+ ;; convenience, as shown by the fact that we just ignore cb.
+ (let ((buf (current-buffer)))
+ (when (eglot--server-capable :documentHighlightProvider)
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/documentHighlight (eglot--TextDocumentPositionParams)
+ :success-fn
+ (lambda (highlights)
+ (mapc #'delete-overlay eglot--highlights)
+ (setq eglot--highlights
+ (eglot--when-buffer-window buf
+ (mapcar
+ (eglot--lambda ((DocumentHighlight) range)
+ (pcase-let ((`(,beg . ,end)
+ (eglot--range-region range)))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'eglot-highlight-symbol-face)
+ (overlay-put ov 'modification-hooks
+ `(,(lambda (o &rest _) (delete-overlay o))))
+ ov)))
+ highlights))))
+ :deferred :textDocument/documentHighlight)
+ nil)))
+
+(defun eglot-imenu ()
+ "EGLOT's `imenu-create-index-function'."
+ (cl-labels
+ ((visit (_name one-obj-array)
+ (imenu-default-goto-function
+ nil (car (eglot--range-region
+ (eglot--dcase (aref one-obj-array 0)
+ (((SymbolInformation) location)
+ (plist-get location :range))
+ (((DocumentSymbol) selectionRange)
+ selectionRange))))))
+ (unfurl (obj)
+ (eglot--dcase obj
+ (((SymbolInformation)) (list obj))
+ (((DocumentSymbol) name children)
+ (cons obj
+ (mapcar
+ (lambda (c)
+ (plist-put
+ c :containerName
+ (let ((existing (plist-get c :containerName)))
+ (if existing (format "%s::%s" name existing)
+ name))))
+ (mapcan #'unfurl children)))))))
+ (mapcar
+ (pcase-lambda (`(,kind . ,objs))
+ (cons
+ (alist-get kind eglot--symbol-kind-names "Unknown")
+ (mapcan (pcase-lambda (`(,container . ,objs))
+ (let ((elems (mapcar (lambda (obj)
+ (list (plist-get obj :name)
+ `[,obj] ;; trick
+ #'visit))
+ objs)))
+ (if container (list (cons container elems)) elems)))
+ (seq-group-by
+ (lambda (e) (plist-get e :containerName)) objs))))
+ (seq-group-by
+ (lambda (obj) (plist-get obj :kind))
+ (mapcan #'unfurl
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :textDocument/documentSymbol
+ `(:textDocument
+ ,(eglot--TextDocumentIdentifier))
+ :cancel-on-input non-essential))))))
+
+(defun eglot--apply-text-edits (edits &optional version)
+ "Apply EDITS for current buffer if at VERSION, or if it's nil."
+ (unless (or (not version) (equal version eglot--versioned-identifier))
+ (jsonrpc-error "Edits on `%s' require version %d, you have %d"
+ (current-buffer) version eglot--versioned-identifier))
+ (atomic-change-group
+ (let* ((change-group (prepare-change-group))
+ (howmany (length edits))
+ (reporter (make-progress-reporter
+ (format "[eglot] applying %s edits to `%s'..."
+ howmany (current-buffer))
+ 0 howmany))
+ (done 0))
+ (mapc (pcase-lambda (`(,newText ,beg . ,end))
+ (let ((source (current-buffer)))
+ (with-temp-buffer
+ (insert newText)
+ (let ((temp (current-buffer)))
+ (with-current-buffer source
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+
+ ;; On emacs versions < 26.2,
+ ;; `replace-buffer-contents' is buggy - it calls
+ ;; change functions with invalid arguments - so we
+ ;; manually call the change functions here.
+ ;;
+ ;; See emacs bugs #32237, #32278:
+ ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237
+ ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278
+ (let ((inhibit-modification-hooks t)
+ (length (- end beg))
+ (beg (marker-position beg))
+ (end (marker-position end)))
+ (run-hook-with-args 'before-change-functions
+ beg end)
+ (replace-buffer-contents temp)
+ (run-hook-with-args 'after-change-functions
+ beg (+ beg (length newText))
+ length))))
+ (progress-reporter-update reporter (cl-incf done)))))))
+ (mapcar (eglot--lambda ((TextEdit) range newText)
+ (cons newText (eglot--range-region range 'markers)))
+ (reverse edits)))
+ (undo-amalgamate-change-group change-group)
+ (progress-reporter-done reporter))))
+
+(defun eglot--apply-workspace-edit (wedit &optional confirm)
+ "Apply the workspace edit WEDIT. If CONFIRM, ask user first."
+ (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit
+ (let ((prepared
+ (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits)
+ (eglot--dbind ((VersionedTextDocumentIdentifier) uri version)
+ textDocument
+ (list (eglot--uri-to-path uri) edits version)))
+ documentChanges)))
+ (cl-loop for (uri edits) on changes by #'cddr
+ do (push (list (eglot--uri-to-path uri) edits) prepared))
+ (if (or confirm
+ (cl-notevery #'find-buffer-visiting
+ (mapcar #'car prepared)))
+ (unless (y-or-n-p
+ (format "[eglot] Server wants to edit:\n %s\n Proceed? "
+ (mapconcat #'identity (mapcar #'car prepared) "\n ")))
+ (eglot--error "User cancelled server edit")))
+ (cl-loop for edit in prepared
+ for (path edits version) = edit
+ do (with-current-buffer (find-file-noselect path)
+ (eglot--apply-text-edits edits version))
+ finally (eldoc) (eglot--message "Edit successful!")))))
+
+(defun eglot-rename (newname)
+ "Rename the current symbol to NEWNAME."
+ (interactive
+ (list (read-from-minibuffer (format "Rename `%s' to: " (symbol-at-point))
+ nil nil nil nil
+ (symbol-name (symbol-at-point)))))
+ (unless (eglot--server-capable :renameProvider)
+ (eglot--error "Server can't rename!"))
+ (eglot--apply-workspace-edit
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
+ :newName ,newname))
+ current-prefix-arg))
+
+(defun eglot--region-bounds () "Region bounds if active, else point and nil."
+ (if (use-region-p) `(,(region-beginning) ,(region-end)) `(,(point) nil)))
+
+(defun eglot-code-actions (beg &optional end action-kind)
+ "Offer to execute actions of ACTION-KIND between BEG and END.
+If ACTION-KIND is nil, consider all kinds of actions.
+Interactively, default BEG and END to region's bounds else BEG is
+point and END is nil, which results in a request for code actions
+at point. With prefix argument, prompt for ACTION-KIND."
+ (interactive
+ `(,@(eglot--region-bounds)
+ ,(and current-prefix-arg
+ (completing-read "[eglot] Action kind: "
+ '("quickfix" "refactor.extract" "refactor.inline"
+ "refactor.rewrite" "source.organizeImports")))))
+ (unless (eglot--server-capable :codeActionProvider)
+ (eglot--error "Server can't execute code actions!"))
+ (let* ((server (eglot--current-server-or-lose))
+ (actions
+ (jsonrpc-request
+ server
+ :textDocument/codeAction
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :range (list :start (eglot--pos-to-lsp-position beg)
+ :end (eglot--pos-to-lsp-position end))
+ :context
+ `(:diagnostics
+ [,@(cl-loop for diag in (flymake-diagnostics beg end)
+ when (cdr (assoc 'eglot-lsp-diag
+ (eglot--diag-data diag)))
+ collect it)]
+ ,@(when action-kind `(:only [,action-kind]))))
+ :deferred t))
+ (menu-items
+ (or (cl-loop for action across actions
+ ;; Do filtering ourselves, in case the `:only'
+ ;; didn't go through.
+ when (or (not action-kind)
+ (equal action-kind (plist-get action :kind)))
+ collect (cons (plist-get action :title) action))
+ (apply #'eglot--error
+ (if action-kind `("No \"%s\" code actions here" ,action-kind)
+ `("No code actions here")))))
+ (preferred-action (cl-find-if
+ (lambda (menu-item)
+ (plist-get (cdr menu-item) :isPreferred))
+ menu-items))
+ (default-action (car (or preferred-action (car menu-items))))
+ (action (if (and action-kind (null (cadr menu-items)))
+ (cdr (car menu-items))
+ (if (listp last-nonmenu-event)
+ (x-popup-menu last-nonmenu-event `("Eglot code actions:"
+ ("dummy" ,@menu-items)))
+ (cdr (assoc (completing-read
+ (format "[eglot] Pick an action (default %s): "
+ default-action)
+ menu-items nil t nil nil default-action)
+ menu-items))))))
+ (eglot--dcase action
+ (((Command) command arguments)
+ (eglot-execute-command server (intern command) arguments))
+ (((CodeAction) edit command)
+ (when edit (eglot--apply-workspace-edit edit))
+ (when command
+ (eglot--dbind ((Command) command arguments) command
+ (eglot-execute-command server (intern command) arguments)))))))
+
+(defmacro eglot--code-action (name kind)
+ "Define NAME to execute KIND code action."
+ `(defun ,name (beg &optional end)
+ ,(format "Execute '%s' code actions between BEG and END." kind)
+ (interactive (eglot--region-bounds))
+ (eglot-code-actions beg end ,kind)))
+
+(eglot--code-action eglot-code-action-organize-imports "source.organizeImports")
+(eglot--code-action eglot-code-action-extract "refactor.extract")
+(eglot--code-action eglot-code-action-inline "refactor.inline")
+(eglot--code-action eglot-code-action-rewrite "refactor.rewrite")
+(eglot--code-action eglot-code-action-quickfix "quickfix")
+
+
+;;; Dynamic registration
+;;;
+(cl-defmethod eglot-register-capability
+ (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers)
+ "Handle dynamic registration of workspace/didChangeWatchedFiles."
+ (eglot-unregister-capability server method id)
+ (let* (success
+ (globs (mapcar
+ (eglot--lambda ((FileSystemWatcher) globPattern)
+ (eglot--glob-compile globPattern t t))
+ watchers))
+ (dirs-to-watch
+ (delete-dups (mapcar #'file-name-directory
+ (project-files
+ (eglot--project server))))))
+ (cl-labels
+ ((handle-event
+ (event)
+ (pcase-let ((`(,desc ,action ,file ,file1) event))
+ (cond
+ ((and (memq action '(created changed deleted))
+ (cl-find file globs :test (lambda (f g) (funcall g f))))
+ (jsonrpc-notify
+ server :workspace/didChangeWatchedFiles
+ `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
+ :type ,(cl-case action
+ (created 1)
+ (changed 2)
+ (deleted 3)))))))
+ ((eq action 'renamed)
+ (handle-event `(,desc 'deleted ,file))
+ (handle-event `(,desc 'created ,file1)))))))
+ (unwind-protect
+ (progn
+ (dolist (dir dirs-to-watch)
+ (push (file-notify-add-watch dir '(change) #'handle-event)
+ (gethash id (eglot--file-watches server))))
+ (setq
+ success
+ `(:message ,(format "OK, watching %s directories in %s watchers"
+ (length dirs-to-watch) (length watchers)))))
+ (unless success
+ (eglot-unregister-capability server method id))))))
+
+(cl-defmethod eglot-unregister-capability
+ (server (_method (eql workspace/didChangeWatchedFiles)) id)
+ "Handle dynamic unregistration of workspace/didChangeWatchedFiles."
+ (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches server)))
+ (remhash id (eglot--file-watches server))
+ (list t "OK"))
+
+
+;;; Glob heroics
+;;;
+(defun eglot--glob-parse (glob)
+ "Compute list of (STATE-SYM EMITTER-FN PATTERN)."
+ (with-temp-buffer
+ (save-excursion (insert glob))
+ (cl-loop
+ with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**)
+ (:* "\\*" eglot--glob-emit-*)
+ (:? "\\?" eglot--glob-emit-?)
+ (:{} "{[^][*{}]+}" eglot--glob-emit-{})
+ (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range)
+ (:literal "[^][,*?{}]+" eglot--glob-emit-self))
+ until (eobp)
+ collect (cl-loop
+ for (_token regexp emitter) in grammar
+ thereis (and (re-search-forward (concat "\\=" regexp) nil t)
+ (list (cl-gensym "state-") emitter (match-string 0)))
+ finally (error "Glob '%s' invalid at %s" (buffer-string) (point))))))
+
+(defun eglot--glob-compile (glob &optional byte-compile noerror)
+ "Convert GLOB into Elisp function. Maybe BYTE-COMPILE it.
+If NOERROR, return predicate, else erroring function."
+ (let* ((states (eglot--glob-parse glob))
+ (body `(with-current-buffer (get-buffer-create " *eglot-glob-matcher*")
+ (erase-buffer)
+ (save-excursion (insert string))
+ (cl-labels ,(cl-loop for (this that) on states
+ for (self emit text) = this
+ for next = (or (car that) 'eobp)
+ collect (funcall emit text self next))
+ (or (,(caar states))
+ (error "Glob done but more unmatched text: '%s'"
+ (buffer-substring (point) (point-max)))))))
+ (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body))))
+ (if byte-compile (byte-compile form) form)))
+
+(defun eglot--glob-emit-self (text self next)
+ `(,self () (re-search-forward ,(concat "\\=" (regexp-quote text))) (,next)))
+
+(defun eglot--glob-emit-** (_ self next)
+ `(,self () (or (ignore-errors (save-excursion (,next)))
+ (and (re-search-forward "\\=/?[^/]+/?") (,self)))))
+
+(defun eglot--glob-emit-* (_ self next)
+ `(,self () (re-search-forward "\\=[^/]")
+ (or (ignore-errors (save-excursion (,next))) (,self))))
+
+(defun eglot--glob-emit-? (_ self next)
+ `(,self () (re-search-forward "\\=[^/]") (,next)))
+
+(defun eglot--glob-emit-{} (arg self next)
+ (let ((alternatives (split-string (substring arg 1 (1- (length arg))) ",")))
+ `(,self ()
+ (or ,@(cl-loop for alt in alternatives
+ collect `(re-search-forward ,(concat "\\=" alt) nil t))
+ (error "Failed matching any of %s" ',alternatives))
+ (,next))))
+
+(defun eglot--glob-emit-range (arg self next)
+ (when (eq ?! (aref arg 1)) (aset arg 1 ?^))
+ `(,self () (re-search-forward ,(concat "\\=" arg)) (,next)))
+
+
+;;; Rust-specific
+;;;
+(defclass eglot-rls (eglot-lsp-server) () :documentation "Rustlang's RLS.")
+
+(cl-defmethod jsonrpc-connection-ready-p ((server eglot-rls) what)
+ "Except for :completion, RLS isn't ready until Indexing done."
+ (and (cl-call-next-method)
+ (or ;; RLS normally ready for this, even if building.
+ (eq :textDocument/completion what)
+ (pcase-let ((`(,_id ,what ,done ,_detail) (eglot--spinner server)))
+ (and (equal "Indexing" what) done)))))
+
+(cl-defmethod eglot-handle-notification
+ ((server eglot-rls) (_method (eql window/progress))
+ &key id done title message &allow-other-keys)
+ "Handle notification window/progress."
+ (setf (eglot--spinner server) (list id title done message)))
+
+
+;;; eclipse-jdt-specific
+;;;
+(defclass eglot-eclipse-jdt (eglot-lsp-server) ()
+ :documentation "Eclipse's Java Development Tools Language Server.")
+
+(cl-defmethod eglot-initialization-options ((server eglot-eclipse-jdt))
+ "Passes through required jdt initialization options."
+ `(:workspaceFolders
+ [,@(cl-delete-duplicates
+ (mapcar #'eglot--path-to-uri
+ (let* ((root (project-root (eglot--project server))))
+ (cons root
+ (mapcar
+ #'file-name-directory
+ (append
+ (file-expand-wildcards (concat root "*/pom.xml"))
+ (file-expand-wildcards (concat root "*/build.gradle"))
+ (file-expand-wildcards (concat root "*/.project")))))))
+ :test #'string=)]
+ ,@(if-let ((home (or (getenv "JAVA_HOME")
+ (ignore-errors
+ (expand-file-name
+ ".."
+ (file-name-directory
+ (file-chase-links (executable-find "javac"))))))))
+ `(:settings (:java (:home ,home)))
+ (ignore (eglot--warn "JAVA_HOME env var not set")))))
+
+(defun eglot--eclipse-jdt-contact (interactive)
+ "Return a contact for connecting to eclipse.jdt.ls server, as a cons cell.
+If INTERACTIVE, prompt user for details."
+ (cl-labels
+ ((is-the-jar
+ (path)
+ (and (string-match-p
+ "org\\.eclipse\\.equinox\\.launcher_.*\\.jar$"
+ (file-name-nondirectory path))
+ (file-exists-p path))))
+ (let* ((classpath (or (getenv "CLASSPATH") path-separator))
+ (cp-jar (cl-find-if #'is-the-jar (split-string classpath path-separator)))
+ (jar cp-jar)
+ (dir
+ (cond
+ (jar (file-name-as-directory
+ (expand-file-name ".." (file-name-directory jar))))
+ (interactive
+ (expand-file-name
+ (read-directory-name
+ (concat "Path to eclipse.jdt.ls directory (could not"
+ " find it in CLASSPATH): ")
+ nil nil t)))
+ (t (error "Could not find eclipse.jdt.ls jar in CLASSPATH"))))
+ (repodir
+ (concat dir
+ "org.eclipse.jdt.ls.product/target/repository/"))
+ (repodir (if (file-directory-p repodir) repodir dir))
+ (config
+ (concat
+ repodir
+ (cond
+ ((string= system-type "darwin") "config_mac")
+ ((string= system-type "windows-nt") "config_win")
+ (t "config_linux"))))
+ (workspace
+ (expand-file-name (md5 (project-root (eglot--current-project)))
+ (locate-user-emacs-file
+ "eglot-eclipse-jdt-cache"))))
+ (unless jar
+ (setq jar
+ (cl-find-if #'is-the-jar
+ (directory-files (concat repodir "plugins") t))))
+ (unless (and jar (file-exists-p jar) (file-directory-p config))
+ (error "Could not find required eclipse.jdt.ls files (build required?)"))
+ (when (and interactive (not cp-jar)
+ (y-or-n-p (concat "Add path to the server program "
+ "to CLASSPATH environment variable?")))
+ (setenv "CLASSPATH" (concat (getenv "CLASSPATH") path-separator jar)))
+ (unless (file-directory-p workspace)
+ (make-directory workspace t))
+ (cons 'eglot-eclipse-jdt
+ (list (executable-find "java")
+ "-Declipse.application=org.eclipse.jdt.ls.core.id1"
+ "-Dosgi.bundles.defaultStartLevel=4"
+ "-Declipse.product=org.eclipse.jdt.ls.core.product"
+ "-jar" jar
+ "-configuration" config
+ "-data" workspace)))))
+
+(cl-defmethod eglot-execute-command
+ ((_server eglot-eclipse-jdt) (_cmd (eql java.apply.workspaceEdit)) arguments)
+ "Eclipse JDT breaks spec and replies with edits as arguments."
+ (mapc #'eglot--apply-workspace-edit arguments))
+
+(provide 'eglot)
+;;; eglot.el ends here
+
+;; Local Variables:
+;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"
+;; bug-reference-url-format: "https://github.com/joaotavora/eglot/issues/%s"
+;; checkdoc-force-docstrings-flag: nil
+;; End:
diff --git a/elpa/eglot-1.8/eglot.elc b/elpa/eglot-1.8/eglot.elc
Binary files differ.
diff --git a/elpa/eglot-20211116.823/eglot-autoloads.el b/elpa/eglot-20211116.823/eglot-autoloads.el
@@ -1,64 +0,0 @@
-;;; eglot-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-
-;;;### (autoloads nil "eglot" "eglot.el" (0 0 0 0))
-;;; Generated autoloads from eglot.el
-
-(autoload 'eglot "eglot" "\
-Manage a project with a Language Server Protocol (LSP) server.
-
-The LSP server of CLASS is started (or contacted) via CONTACT.
-If this operation is successful, current *and future* file
-buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\"
-by the LSP server, meaning information about their contents is
-exchanged periodically to provide enhanced code-analysis via
-`xref-find-definitions', `flymake-mode', `eldoc-mode',
-`completion-at-point', among others.
-
-Interactively, the command attempts to guess MANAGED-MAJOR-MODE
-from current buffer, CLASS and CONTACT from
-`eglot-server-programs' and PROJECT from
-`project-find-functions'. The search for active projects in this
-context binds `eglot-lsp-context' (which see).
-
-If it can't guess, the user is prompted. With a single
-\\[universal-argument] prefix arg, it always prompt for COMMAND.
-With two \\[universal-argument] prefix args, also prompts for
-MANAGED-MAJOR-MODE.
-
-PROJECT is a project object as returned by `project-current'.
-
-CLASS is a subclass of `eglot-lsp-server'.
-
-CONTACT specifies how to contact the server. It is a
-keyword-value plist used to initialize CLASS or a plain list as
-described in `eglot-server-programs', which see.
-
-LANGUAGE-ID is the language ID string to send to the server for
-MANAGED-MAJOR-MODE, which matters to a minority of servers.
-
-INTERACTIVE is t if called interactively.
-
-\(fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT LANGUAGE-ID &optional INTERACTIVE)" t nil)
-
-(autoload 'eglot-ensure "eglot" "\
-Start Eglot session for current buffer if there isn't one." nil nil)
-
-(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eglot" '("eglot-")))
-
-;;;***
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; eglot-autoloads.el ends here
diff --git a/elpa/eglot-20211116.823/eglot-pkg.el b/elpa/eglot-20211116.823/eglot-pkg.el
@@ -1,2 +0,0 @@
-;;; Generated package description from eglot.el -*- no-byte-compile: t -*-
-(define-package "eglot" "20211116.823" "Client for Language Server Protocol (LSP) servers" '((emacs "26.1") (jsonrpc "1.0.14") (flymake "1.0.9") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0")) :commit "55c13a91378cdd7822c99bbbf340ea76b1f0bf38" :authors '(("João Távora" . "joaotavora@gmail.com")) :maintainer '("João Távora" . "joaotavora@gmail.com") :keywords '("convenience" "languages") :url "https://github.com/joaotavora/eglot")
diff --git a/elpa/eglot-20211116.823/eglot.el b/elpa/eglot-20211116.823/eglot.el
@@ -1,3050 +0,0 @@
-;;; eglot.el --- Client for Language Server Protocol (LSP) servers -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
-
-;; Version: 1.7
-;; Package-Version: 20211116.823
-;; Package-Commit: 55c13a91378cdd7822c99bbbf340ea76b1f0bf38
-;; Author: João Távora <joaotavora@gmail.com>
-;; Maintainer: João Távora <joaotavora@gmail.com>
-;; URL: https://github.com/joaotavora/eglot
-;; Keywords: convenience, languages
-;; Package-Requires: ((emacs "26.1") (jsonrpc "1.0.14") (flymake "1.0.9") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0"))
-
-;; 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:
-
-;; Simply M-x eglot should be enough to get you started, but here's a
- ;; little info (see the accompanying README.md or the URL for more).
-;;
-;; M-x eglot starts a server via a shell-command guessed from
-;; `eglot-server-programs', using the current major-mode (for whatever
-;; language you're programming in) as a hint. If it can't guess, it
-;; prompts you in the mini-buffer for these things. Actually, the
-;; server needen't be locally started: you can connect to a running
-;; server via TCP by entering a <host:port> syntax.
-;;
-;; Anyway, if the connection is successful, you should see an `eglot'
-;; indicator pop up in your mode-line. More importantly, this means
-;; current *and future* file buffers of that major mode *inside your
-;; current project* automatically become \"managed\" by the LSP
-;; server, i.e. information about their contents is exchanged
-;; periodically to provide enhanced code analysis via
-;; `xref-find-definitions', `flymake-mode', `eldoc-mode',
-;; `completion-at-point', among others.
-;;
-;; To "unmanage" these buffers, shutdown the server with M-x
-;; eglot-shutdown.
-;;
-;; You can also do:
-;;
-;; (add-hook 'foo-mode-hook 'eglot-ensure)
-;;
-;; To attempt to start an eglot session automatically everytime a
-;; foo-mode buffer is visited.
-;;
-;;; Code:
-
-(require 'json)
-(require 'imenu)
-(require 'cl-lib)
-(require 'project)
-(require 'seq)
-(require 'url-parse)
-(require 'url-util)
-(require 'pcase)
-(require 'compile) ; for some faces
-(require 'warnings)
-(require 'flymake)
-(require 'xref)
-(eval-when-compile
- (require 'subr-x))
-(require 'jsonrpc)
-(require 'filenotify)
-(require 'ert)
-(require 'array)
-
-;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are
-;; using the latest version from GNU Elpa when we load eglot.el. Use an
-;; heuristic to see if we need to `load' it in Emacs < 28.
-(if (and (< emacs-major-version 28)
- (not (boundp 'eldoc-documentation-strategy)))
- (load "eldoc")
- (require 'eldoc))
-
-;; forward-declare, but don't require (Emacs 28 doesn't seem to care)
-(defvar markdown-fontify-code-blocks-natively)
-(defvar company-backends)
-(defvar company-tooltip-align-annotations)
-
-
-
-;;; User tweakable stuff
-(defgroup eglot nil
- "Interaction with Language Server Protocol servers"
- :prefix "eglot-"
- :group 'applications)
-
-(defun eglot-alternatives (alternatives)
- "Compute server-choosing function for `eglot-server-programs'.
-Each element of ALTERNATIVES is a string PROGRAM or a list of
-strings (PROGRAM ARGS...) where program names an LSP server
-program to start with ARGS. Returns a function of one argument.
-When invoked, that function will return a list (ABSPATH ARGS),
-where ABSPATH is the absolute path of the PROGRAM that was
-chosen (interactively or automatically)."
- (lambda (&optional interactive)
- ;; JT@2021-06-13: This function is way more complicated than it
- ;; could be because it accounts for the fact that
- ;; `eglot--executable-find' may take much longer to execute on
- ;; remote files.
- (let* ((listified (cl-loop for a in alternatives
- collect (if (listp a) a (list a))))
- (err (lambda ()
- (error "None of '%s' are valid executables"
- (mapconcat #'identity alternatives ", ")))))
- (cond (interactive
- (let* ((augmented (mapcar (lambda (a)
- (let ((found (eglot--executable-find
- (car a) t)))
- (and found
- (cons (car a) (cons found (cdr a))))))
- listified))
- (available (remove nil augmented)))
- (cond ((cdr available)
- (cdr (assoc
- (completing-read
- "[eglot] More than one server executable available:"
- (mapcar #'car available)
- nil t nil nil (car (car available)))
- available #'equal)))
- ((cdr (car available)))
- (t
- ;; Don't error when used interactively, let the
- ;; Eglot prompt the user for alternative (github#719)
- nil))))
- (t
- (cl-loop for (p . args) in listified
- for probe = (eglot--executable-find p t)
- when probe return (cons probe args)
- finally (funcall err)))))))
-
-(defvar eglot-server-programs `((rust-mode . (eglot-rls "rls"))
- (python-mode
- . ,(eglot-alternatives '("pylsp" "pyls")))
- ((js-mode typescript-mode)
- . ("typescript-language-server" "--stdio"))
- (sh-mode . ("bash-language-server" "start"))
- ((php-mode phps-mode)
- . ("php" "vendor/felixfbecker/\
-language-server/bin/php-language-server.php"))
- ((c++-mode c-mode) . ,(eglot-alternatives
- '("clangd" "ccls")))
- (((caml-mode :language-id "ocaml")
- (tuareg-mode :language-id "ocaml") reason-mode)
- . ("ocamllsp"))
- (ruby-mode
- . ("solargraph" "socket" "--port" :autoport))
- (haskell-mode
- . ("haskell-language-server-wrapper" "--lsp"))
- (elm-mode . ("elm-language-server"))
- (kotlin-mode . ("kotlin-language-server"))
- (go-mode . ("gopls"))
- ((R-mode ess-r-mode) . ("R" "--slave" "-e"
- "languageserver::run()"))
- (java-mode . eglot--eclipse-jdt-contact)
- (dart-mode . ("dart_language_server"))
- (elixir-mode . ("language_server.sh"))
- (ada-mode . ("ada_language_server"))
- (scala-mode . ("metals-emacs"))
- ((tex-mode context-mode texinfo-mode bibtex-mode)
- . ("digestif"))
- (erlang-mode . ("erlang_ls" "--transport" "stdio"))
- (nix-mode . ("rnix-lsp"))
- (gdscript-mode . ("localhost" 6008))
- (f90-mode . ("fortls"))
- (zig-mode . ("zls")))
- "How the command `eglot' guesses the server to start.
-An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
-identifies the buffers that are to be managed by a specific
-language server. The associated CONTACT specifies how to connect
-to a server for those buffers.
-
-MAJOR-MODE can be:
-
-* In the most common case, a symbol such as `c-mode';
-
-* A list (MAJOR-MODE-SYMBOL :LANGUAGE-ID ID) where
- MAJOR-MODE-SYMBOL is the aforementioned symbol and ID is a
- string identifying the language to the server;
-
-* A list combining the previous two alternatives, meaning
- multiple major modes will be associated with a single server
- program.
-
-CONTACT can be:
-
-* In the most common case, a list of strings (PROGRAM [ARGS...]).
- PROGRAM is called with ARGS and is expected to serve LSP requests
- over the standard input/output channels.
-
-* A list (HOST PORT [TCP-ARGS...]) where HOST is a string and
- PORT is a positive integer for connecting to a server via TCP.
- Remaining ARGS are passed to `open-network-stream' for
- upgrading the connection with encryption or other capabilities.
-
-* A list (PROGRAM [ARGS...] :autoport [MOREARGS...]), whereupon a
- combination of the two previous options is used. First, an
- attempt is made to find an available server port, then PROGRAM
- is launched with ARGS; the `:autoport' keyword substituted for
- that number; and MOREARGS. Eglot then attempts to establish a
- TCP connection to that port number on the localhost.
-
-* A cons (CLASS-NAME . INITARGS) where CLASS-NAME is a symbol
- designating a subclass of `eglot-lsp-server', for representing
- experimental LSP servers. INITARGS is a keyword-value plist
- used to initialize the object of CLASS-NAME, or a plain list
- interpreted as the previous descriptions of CONTACT. In the
- latter case that plain list is used to produce a plist with a
- suitable :PROCESS initarg to CLASS-NAME. The class
- `eglot-lsp-server' descends from `jsonrpc-process-connection',
- which you should see for the semantics of the mandatory
- :PROCESS argument.
-
-* A function of a single argument producing any of the above
- values for CONTACT. The argument's value is non-nil if the
- connection was requested interactively (e.g. from the `eglot'
- command), and nil if it wasn't (e.g. from `eglot-ensure'). If
- the call is interactive, the function can ask the user for
- hints on finding the required programs, etc. Otherwise, it
- should not ask the user for any input, and return nil or signal
- an error if it can't produce a valid CONTACT.")
-
-(defface eglot-highlight-symbol-face
- '((t (:inherit bold)))
- "Face used to highlight the symbol at point.")
-
-(defface eglot-mode-line
- '((t (:inherit font-lock-constant-face :weight bold)))
- "Face for package-name in EGLOT's mode line.")
-
-(defcustom eglot-autoreconnect 3
- "Control ability to reconnect automatically to the LSP server.
-If t, always reconnect automatically (not recommended). If nil,
-never reconnect automatically after unexpected server shutdowns,
-crashes or network failures. A positive integer number says to
-only autoreconnect if the previous successful connection attempt
-lasted more than that many seconds."
- :type '(choice (boolean :tag "Whether to inhibit autoreconnection")
- (integer :tag "Number of seconds")))
-
-(defcustom eglot-connect-timeout 30
- "Number of seconds before timing out LSP connection attempts.
-If nil, never time out."
- :type 'number)
-
-(defcustom eglot-sync-connect 3
- "Control blocking of LSP connection attempts.
-If t, block for `eglot-connect-timeout' seconds. A positive
-integer number means block for that many seconds, and then wait
-for the connection in the background. nil has the same meaning
-as 0, i.e. don't block at all."
- :type '(choice (boolean :tag "Whether to inhibit autoreconnection")
- (integer :tag "Number of seconds")))
-
-(defcustom eglot-autoshutdown nil
- "If non-nil, shut down server after killing last managed buffer."
- :type 'boolean)
-
-(defcustom eglot-send-changes-idle-time 0.5
- "Don't tell server of changes before Emacs's been idle for this many seconds."
- :type 'number)
-
-(defcustom eglot-events-buffer-size 2000000
- "Control the size of the Eglot events buffer.
-If a number, don't let the buffer grow larger than that many
-characters. If 0, don't use an event's buffer at all. If nil,
-let the buffer grow forever."
- :type '(choice (const :tag "No limit" nil)
- (integer :tag "Number of characters")))
-
-(defcustom eglot-confirm-server-initiated-edits 'confirm
- "Non-nil if server-initiated edits should be confirmed with user."
- :type '(choice (const :tag "Don't show confirmation prompt" nil)
- (symbol :tag "Show confirmation prompt" 'confirm)))
-
-(defcustom eglot-extend-to-xref nil
- "If non-nil, activate Eglot in cross-referenced non-project files."
- :type 'boolean)
-
-;; Customizable via `completion-category-overrides'.
-(when (assoc 'flex completion-styles-alist)
- (add-to-list 'completion-category-defaults '(eglot (styles flex basic))))
-
-
-;;; Constants
-;;;
-(defconst eglot--symbol-kind-names
- `((1 . "File") (2 . "Module")
- (3 . "Namespace") (4 . "Package") (5 . "Class")
- (6 . "Method") (7 . "Property") (8 . "Field")
- (9 . "Constructor") (10 . "Enum") (11 . "Interface")
- (12 . "Function") (13 . "Variable") (14 . "Constant")
- (15 . "String") (16 . "Number") (17 . "Boolean")
- (18 . "Array") (19 . "Object") (20 . "Key")
- (21 . "Null") (22 . "EnumMember") (23 . "Struct")
- (24 . "Event") (25 . "Operator") (26 . "TypeParameter")))
-
-(defconst eglot--kind-names
- `((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor")
- (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface")
- (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value")
- (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color")
- (17 . "File") (18 . "Reference")))
-
-(defconst eglot--{} (make-hash-table) "The empty JSON object.")
-
-(defun eglot--executable-find (command &optional remote)
- "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26."
- (if (>= emacs-major-version 27) (executable-find command remote)
- (executable-find command)))
-
-
-;;; Message verification helpers
-;;;
-(eval-and-compile
- (defvar eglot--lsp-interface-alist
- `(
- (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred))
- (ConfigurationItem () (:scopeUri :section))
- (Command ((:title . string) (:command . string)) (:arguments))
- (CompletionItem (:label)
- (:kind :detail :documentation :deprecated :preselect
- :sortText :filterText :insertText :insertTextFormat
- :textEdit :additionalTextEdits :commitCharacters
- :command :data))
- (Diagnostic (:range :message) (:severity :code :source :relatedInformation))
- (DocumentHighlight (:range) (:kind))
- (FileSystemWatcher (:globPattern) (:kind))
- (Hover (:contents) (:range))
- (InitializeResult (:capabilities) (:serverInfo))
- (Location (:uri :range))
- (LocationLink (:targetUri :targetRange :targetSelectionRange) (:originSelectionRange))
- (LogMessageParams (:type :message))
- (MarkupContent (:kind :value))
- (ParameterInformation (:label) (:documentation))
- (Position (:line :character))
- (Range (:start :end))
- (Registration (:id :method) (:registerOptions))
- (ResponseError (:code :message) (:data))
- (ShowMessageParams (:type :message))
- (ShowMessageRequestParams (:type :message) (:actions))
- (SignatureHelp (:signatures) (:activeSignature :activeParameter))
- (SignatureInformation (:label) (:documentation :parameters :activeParameter))
- (SymbolInformation (:name :kind :location)
- (:deprecated :containerName))
- (DocumentSymbol (:name :range :selectionRange :kind)
- ;; `:containerName' isn't really allowed , but
- ;; it simplifies the impl of `eglot-imenu'.
- (:detail :deprecated :children :containerName))
- (TextDocumentEdit (:textDocument :edits) ())
- (TextEdit (:range :newText))
- (VersionedTextDocumentIdentifier (:uri :version) ())
- (WorkspaceEdit () (:changes :documentChanges))
- )
- "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
-
-INTERFACE-NAME is a symbol designated by the spec as
-\"interface\". INTERFACE is a list (REQUIRED OPTIONAL) where
-REQUIRED and OPTIONAL are lists of KEYWORD designating field
-names that must be, or may be, respectively, present in a message
-adhering to that interface. KEY can be a keyword or a cons (SYM
-TYPE), where type is used by `cl-typep' to check types at
-runtime.
-
-Here's what an element of this alist might look like:
-
- (Command ((:title . string) (:command . string)) (:arguments))"))
-
-(eval-and-compile
- (defvar eglot-strict-mode (if load-file-name '()
- '(disallow-non-standard-keys
- ;; Uncomment these two for fun at
- ;; compile-time or with flymake-mode.
- ;;
- ;; enforce-required-keys
- ;; enforce-optional-keys
- ))
- "How strictly to check LSP interfaces at compile- and run-time.
-
-Value is a list of symbols (if the list is empty, no checks are
-performed).
-
-If the symbol `disallow-non-standard-keys' is present, an error
-is raised if any extraneous fields are sent by the server. At
-compile-time, a warning is raised if a destructuring spec
-includes such a field.
-
-If the symbol `enforce-required-keys' is present, an error is
-raised if any required fields are missing from the message sent
-from the server. At compile-time, a warning is raised if a
-destructuring spec doesn't use such a field.
-
-If the symbol `enforce-optional-keys' is present, nothing special
-happens at run-time. At compile-time, a warning is raised if a
-destructuring spec doesn't use all optional fields.
-
-If the symbol `disallow-unknown-methods' is present, Eglot warns
-on unknown notifications and errors on unknown requests.
-"))
-
-(defun eglot--plist-keys (plist)
- (cl-loop for (k _v) on plist by #'cddr collect k))
-
-(cl-defun eglot--check-object (interface-name
- object
- &optional
- (enforce-required t)
- (disallow-non-standard t)
- (check-types t))
- "Check that OBJECT conforms to INTERFACE. Error otherwise."
- (cl-destructuring-bind
- (&key types required-keys optional-keys &allow-other-keys)
- (eglot--interface interface-name)
- (when-let ((missing (and enforce-required
- (cl-set-difference required-keys
- (eglot--plist-keys object)))))
- (eglot--error "A `%s' must have %s" interface-name missing))
- (when-let ((excess (and disallow-non-standard
- (cl-set-difference
- (eglot--plist-keys object)
- (append required-keys optional-keys)))))
- (eglot--error "A `%s' mustn't have %s" interface-name excess))
- (when check-types
- (cl-loop
- for (k v) on object by #'cddr
- for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type?
- unless (cl-typep v type)
- do (eglot--error "A `%s' must have a %s as %s, but has %s"
- interface-name )))
- t))
-
-(eval-and-compile
- (defun eglot--keywordize-vars (vars)
- (mapcar (lambda (var) (intern (format ":%s" var))) vars))
-
- (defun eglot--ensure-type (k) (if (consp k) k (cons k t)))
-
- (defun eglot--interface (interface-name)
- (let* ((interface (assoc interface-name eglot--lsp-interface-alist))
- (required (mapcar #'eglot--ensure-type (car (cdr interface))))
- (optional (mapcar #'eglot--ensure-type (cadr (cdr interface)))))
- (list :types (append required optional)
- :required-keys (mapcar #'car required)
- :optional-keys (mapcar #'car optional))))
-
- (defun eglot--check-dspec (interface-name dspec)
- "Check destructuring spec DSPEC against INTERFACE-NAME."
- (cl-destructuring-bind (&key required-keys optional-keys &allow-other-keys)
- (eglot--interface interface-name)
- (cond ((or required-keys optional-keys)
- (let ((too-many
- (and
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- (cl-set-difference
- (eglot--keywordize-vars dspec)
- (append required-keys optional-keys))))
- (ignored-required
- (and
- (memq 'enforce-required-keys eglot-strict-mode)
- (cl-set-difference
- required-keys (eglot--keywordize-vars dspec))))
- (missing-out
- (and
- (memq 'enforce-optional-keys eglot-strict-mode)
- (cl-set-difference
- optional-keys (eglot--keywordize-vars dspec)))))
- (when too-many (byte-compile-warn
- "Destructuring for %s has extraneous %s"
- interface-name too-many))
- (when ignored-required (byte-compile-warn
- "Destructuring for %s ignores required %s"
- interface-name ignored-required))
- (when missing-out (byte-compile-warn
- "Destructuring for %s is missing out on %s"
- interface-name missing-out))))
- (t
- (byte-compile-warn "Unknown LSP interface %s" interface-name))))))
-
-(cl-defmacro eglot--dbind (vars object &body body)
- "Destructure OBJECT, binding VARS in BODY.
-VARS is ([(INTERFACE)] SYMS...)
-Honour `eglot-strict-mode'."
- (declare (indent 2) (debug (sexp sexp &rest form)))
- (let ((interface-name (if (consp (car vars))
- (car (pop vars))))
- (object-once (make-symbol "object-once"))
- (fn-once (make-symbol "fn-once")))
- (cond (interface-name
- (eglot--check-dspec interface-name vars)
- `(let ((,object-once ,object))
- (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
- (eglot--check-object ',interface-name ,object-once
- (memq 'enforce-required-keys eglot-strict-mode)
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- (memq 'check-types eglot-strict-mode))
- ,@body)))
- (t
- `(let ((,object-once ,object)
- (,fn-once (lambda (,@vars) ,@body)))
- (if (memq 'disallow-non-standard-keys eglot-strict-mode)
- (cl-destructuring-bind (&key ,@vars) ,object-once
- (funcall ,fn-once ,@vars))
- (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
- (funcall ,fn-once ,@vars))))))))
-
-
-(cl-defmacro eglot--lambda (cl-lambda-list &body body)
- "Function of args CL-LAMBDA-LIST for processing INTERFACE objects.
-Honour `eglot-strict-mode'."
- (declare (indent 1) (debug (sexp &rest form)))
- (let ((e (cl-gensym "jsonrpc-lambda-elem")))
- `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
-
-(cl-defmacro eglot--dcase (obj &rest clauses)
- "Like `pcase', but for the LSP object OBJ.
-CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is
-treated as in `eglot-dbind'."
- (declare (indent 1) (debug (sexp &rest (sexp &rest form))))
- (let ((obj-once (make-symbol "obj-once")))
- `(let ((,obj-once ,obj))
- (cond
- ,@(cl-loop
- for (vars . body) in clauses
- for vars-as-keywords = (eglot--keywordize-vars vars)
- for interface-name = (if (consp (car vars))
- (car (pop vars)))
- for condition =
- (cond (interface-name
- (eglot--check-dspec interface-name vars)
- ;; In this mode, in runtime, we assume
- ;; `eglot-strict-mode' is partially on, otherwise we
- ;; can't disambiguate between certain types.
- `(ignore-errors
- (eglot--check-object
- ',interface-name ,obj-once
- t
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- t)))
- (t
- ;; In this interface-less mode we don't check
- ;; `eglot-strict-mode' at all: just check that the object
- ;; has all the keys the user wants to destructure.
- `(null (cl-set-difference
- ',vars-as-keywords
- (eglot--plist-keys ,obj-once)))))
- collect `(,condition
- (cl-destructuring-bind (&key ,@vars &allow-other-keys)
- ,obj-once
- ,@body)))
- (t
- (eglot--error "%S didn't match any of %S"
- ,obj-once
- ',(mapcar #'car clauses)))))))
-
-
-;;; API (WORK-IN-PROGRESS!)
-;;;
-(cl-defmacro eglot--when-live-buffer (buf &rest body)
- "Check BUF live, then do BODY in it." (declare (indent 1) (debug t))
- (let ((b (cl-gensym)))
- `(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b ,@body)))))
-
-(cl-defmacro eglot--when-buffer-window (buf &body body)
- "Check BUF showing somewhere, then do BODY in it" (declare (indent 1) (debug t))
- (let ((b (cl-gensym)))
- `(let ((,b ,buf))
- ;;notice the exception when testing with `ert'
- (when (or (get-buffer-window ,b) (ert-running-test))
- (with-current-buffer ,b ,@body)))))
-
-(cl-defmacro eglot--widening (&rest body)
- "Save excursion and restriction. Widen. Then run BODY." (declare (debug t))
- `(save-excursion (save-restriction (widen) ,@body)))
-
-(cl-defgeneric eglot-handle-request (server method &rest params)
- "Handle SERVER's METHOD request with PARAMS.")
-
-(cl-defgeneric eglot-handle-notification (server method &rest params)
- "Handle SERVER's METHOD notification with PARAMS.")
-
-(cl-defgeneric eglot-execute-command (server command arguments)
- "Ask SERVER to execute COMMAND with ARGUMENTS.")
-
-(cl-defgeneric eglot-initialization-options (server)
- "JSON object to send under `initializationOptions'"
- (:method (_s) eglot--{})) ; blank default
-
-(cl-defgeneric eglot-register-capability (server method id &rest params)
- "Ask SERVER to register capability METHOD marked with ID."
- (:method
- (_s method _id &rest _params)
- (eglot--warn "Server tried to register unsupported capability `%s'"
- method)))
-
-(cl-defgeneric eglot-unregister-capability (server method id &rest params)
- "Ask SERVER to register capability METHOD marked with ID."
- (:method
- (_s method _id &rest _params)
- (eglot--warn "Server tried to unregister unsupported capability `%s'"
- method)))
-
-(cl-defgeneric eglot-client-capabilities (server)
- "What the EGLOT LSP client supports for SERVER."
- (:method (_s)
- (list
- :workspace (list
- :applyEdit t
- :executeCommand `(:dynamicRegistration :json-false)
- :workspaceEdit `(:documentChanges :json-false)
- :didChangeWatchedFiles `(:dynamicRegistration t)
- :symbol `(:dynamicRegistration :json-false)
- :configuration t)
- :textDocument
- (list
- :synchronization (list
- :dynamicRegistration :json-false
- :willSave t :willSaveWaitUntil t :didSave t)
- :completion (list :dynamicRegistration :json-false
- :completionItem
- `(:snippetSupport
- ,(if (eglot--snippet-expansion-fn)
- t
- :json-false))
- :contextSupport t)
- :hover (list :dynamicRegistration :json-false
- :contentFormat
- (if (fboundp 'gfm-view-mode)
- ["markdown" "plaintext"]
- ["plaintext"]))
- :signatureHelp (list :dynamicRegistration :json-false
- :signatureInformation
- `(:parameterInformation
- (:labelOffsetSupport t)
- :activeParameterSupport t))
- :references `(:dynamicRegistration :json-false)
- :definition (list :dynamicRegistration :json-false
- :linkSupport t)
- :declaration (list :dynamicRegistration :json-false
- :linkSupport t)
- :implementation (list :dynamicRegistration :json-false
- :linkSupport t)
- :typeDefinition (list :dynamicRegistration :json-false
- :linkSupport t)
- :documentSymbol (list
- :dynamicRegistration :json-false
- :hierarchicalDocumentSymbolSupport t
- :symbolKind `(:valueSet
- [,@(mapcar
- #'car eglot--symbol-kind-names)]))
- :documentHighlight `(:dynamicRegistration :json-false)
- :codeAction (list
- :dynamicRegistration :json-false
- :codeActionLiteralSupport
- '(:codeActionKind
- (:valueSet
- ["quickfix"
- "refactor" "refactor.extract"
- "refactor.inline" "refactor.rewrite"
- "source" "source.organizeImports"]))
- :isPreferredSupport t)
- :formatting `(:dynamicRegistration :json-false)
- :rangeFormatting `(:dynamicRegistration :json-false)
- :rename `(:dynamicRegistration :json-false)
- :publishDiagnostics `(:relatedInformation :json-false))
- :experimental eglot--{})))
-
-(defclass eglot-lsp-server (jsonrpc-process-connection)
- ((project-nickname
- :documentation "Short nickname for the associated project."
- :accessor eglot--project-nickname
- :reader eglot-project-nickname)
- (major-mode
- :documentation "Major mode symbol."
- :accessor eglot--major-mode)
- (language-id
- :documentation "Language ID string for the mode."
- :accessor eglot--language-id)
- (capabilities
- :documentation "JSON object containing server capabilities."
- :accessor eglot--capabilities)
- (server-info
- :documentation "JSON object containing server info."
- :accessor eglot--server-info)
- (shutdown-requested
- :documentation "Flag set when server is shutting down."
- :accessor eglot--shutdown-requested)
- (project
- :documentation "Project associated with server."
- :accessor eglot--project)
- (spinner
- :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
- :initform `(nil nil t) :accessor eglot--spinner)
- (inhibit-autoreconnect
- :initform t
- :documentation "Generalized boolean inhibiting auto-reconnection if true."
- :accessor eglot--inhibit-autoreconnect)
- (file-watches
- :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
- :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
- (managed-buffers
- :documentation "List of buffers managed by server."
- :accessor eglot--managed-buffers)
- (saved-initargs
- :documentation "Saved initargs for reconnection purposes."
- :accessor eglot--saved-initargs)
- (inferior-process
- :documentation "Server subprocess started automatically."
- :accessor eglot--inferior-process))
- :documentation
- "Represents a server. Wraps a process for LSP communication.")
-
-
-;;; Process management
-(defvar eglot--servers-by-project (make-hash-table :test #'equal)
- "Keys are projects. Values are lists of processes.")
-
-(defun eglot-shutdown (server &optional _interactive timeout preserve-buffers)
- "Politely ask SERVER to quit.
-Interactively, read SERVER from the minibuffer unless there is
-only one and it's managing the current buffer.
-
-Forcefully quit it if it doesn't respond within TIMEOUT seconds.
-TIMEOUT defaults to 1.5 seconds. Don't leave this function with
-the server still running.
-
-If PRESERVE-BUFFERS is non-nil (interactively, when called with a
-prefix argument), do not kill events and output buffers of
-SERVER."
- (interactive (list (eglot--read-server "Shutdown which server"
- (eglot-current-server))
- t nil current-prefix-arg))
- (eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
- (unwind-protect
- (progn
- (setf (eglot--shutdown-requested server) t)
- (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
- (jsonrpc-notify server :exit nil))
- ;; Now ask jsonrpc.el to shut down the server.
- (jsonrpc-shutdown server (not preserve-buffers))
- (unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server)))))
-
-(defun eglot-shutdown-all (&optional preserve-buffers)
- "Politely ask all language servers to quit, in order.
-PRESERVE-BUFFERS as in `eglot-shutdown', which see."
- (interactive (list current-prefix-arg))
- (cl-loop for ss being the hash-values of eglot--servers-by-project
- do (cl-loop for s in ss do (eglot-shutdown s nil preserve-buffers))))
-
-(defun eglot--on-shutdown (server)
- "Called by jsonrpc.el when SERVER is already dead."
- ;; Turn off `eglot--managed-mode' where appropriate.
- (dolist (buffer (eglot--managed-buffers server))
- (let (;; Avoid duplicate shutdowns (github#389)
- (eglot-autoshutdown nil))
- (eglot--when-live-buffer buffer (eglot--managed-mode-off))))
- ;; Kill any expensive watches
- (maphash (lambda (_id watches)
- (mapcar #'file-notify-rm-watch watches))
- (eglot--file-watches server))
- ;; Kill any autostarted inferior processes
- (when-let (proc (eglot--inferior-process server))
- (delete-process proc))
- ;; Sever the project/server relationship for `server'
- (setf (gethash (eglot--project server) eglot--servers-by-project)
- (delq server
- (gethash (eglot--project server) eglot--servers-by-project)))
- (cond ((eglot--shutdown-requested server)
- t)
- ((not (eglot--inhibit-autoreconnect server))
- (eglot--warn "Reconnecting after unexpected server exit.")
- (eglot-reconnect server))
- ((timerp (eglot--inhibit-autoreconnect server))
- (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
-
-(defun eglot--all-major-modes ()
- "Return all known major modes."
- (let ((retval))
- (mapatoms (lambda (sym)
- (when (plist-member (symbol-plist sym) 'derived-mode-parent)
- (push sym retval))))
- retval))
-
-(defvar eglot--command-history nil
- "History of CONTACT arguments to `eglot'.")
-
-(defun eglot--lookup-mode (mode)
- "Lookup `eglot-server-programs' for MODE.
-Return (LANGUAGE-ID . CONTACT-PROXY). If not specified,
-LANGUAGE-ID is determined from MODE."
- (cl-loop
- for (modes . contact) in eglot-server-programs
- thereis (cl-some
- (lambda (spec)
- (cl-destructuring-bind (probe &key language-id &allow-other-keys)
- (if (consp spec) spec (list spec))
- (and (provided-mode-derived-p mode probe)
- (cons
- (or language-id
- (or (get mode 'eglot-language-id)
- (get spec 'eglot-language-id)
- (string-remove-suffix "-mode" (symbol-name mode))))
- contact))))
- (if (or (symbolp modes) (keywordp (cadr modes)))
- (list modes) modes))))
-
-(defun eglot--guess-contact (&optional interactive)
- "Helper for `eglot'.
-Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID). If INTERACTIVE is
-non-nil, maybe prompt user, else error as soon as something can't
-be guessed."
- (let* ((guessed-mode (if buffer-file-name major-mode))
- (managed-mode
- (cond
- ((and interactive
- (or (>= (prefix-numeric-value current-prefix-arg) 16)
- (not guessed-mode)))
- (intern
- (completing-read
- "[eglot] Start a server to manage buffers of what major mode? "
- (mapcar #'symbol-name (eglot--all-major-modes)) nil t
- (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
- ((not guessed-mode)
- (eglot--error "Can't guess mode to manage for `%s'" (current-buffer)))
- (t guessed-mode)))
- (lang-id-and-guess (eglot--lookup-mode guessed-mode))
- (language-id (car lang-id-and-guess))
- (guess (cdr lang-id-and-guess))
- (guess (if (functionp guess)
- (funcall guess interactive)
- guess))
- (class (or (and (consp guess) (symbolp (car guess))
- (prog1 (unless current-prefix-arg (car guess))
- (setq guess (cdr guess))))
- 'eglot-lsp-server))
- (program (and (listp guess)
- (stringp (car guess))
- ;; A second element might be the port of a (host, port)
- ;; pair, but in that case it is not a string.
- (or (null (cdr guess)) (stringp (cadr guess)))
- (car guess)))
- (base-prompt
- (and interactive
- "Enter program to execute (or <host>:<port>): "))
- (program-guess
- (and program
- (combine-and-quote-strings (cl-subst ":autoport:"
- :autoport guess))))
- (prompt
- (and base-prompt
- (cond (current-prefix-arg base-prompt)
- ((null guess)
- (format "[eglot] Sorry, couldn't guess for `%s'!\n%s"
- managed-mode base-prompt))
- ((and program
- (not (file-name-absolute-p program))
- (not (eglot--executable-find program t)))
- (concat (format "[eglot] I guess you want to run `%s'"
- program-guess)
- (format ", but I can't find `%s' in PATH!" program)
- "\n" base-prompt)))))
- (contact
- (or (and prompt
- (let ((s (read-shell-command
- prompt
- program-guess
- 'eglot-command-history)))
- (if (string-match "^\\([^\s\t]+\\):\\([[:digit:]]+\\)$"
- (string-trim s))
- (list (match-string 1 s)
- (string-to-number (match-string 2 s)))
- (cl-subst
- :autoport ":autoport:" (split-string-and-unquote s)
- :test #'equal))))
- guess
- (eglot--error "Couldn't guess for `%s'!" managed-mode))))
- (list managed-mode (eglot--current-project) class contact language-id)))
-
-(defvar eglot-lsp-context)
-(put 'eglot-lsp-context 'variable-documentation
- "Dynamically non-nil when searching for projects in LSP context.")
-
-(defvar eglot--servers-by-xrefed-file
- (make-hash-table :test 'equal :weakness 'value))
-
-(defun eglot--current-project ()
- "Return a project object for Eglot's LSP purposes.
-This relies on `project-current' and thus on
-`project-find-functions'. Functions in the latter
-variable (which see) can query the value `eglot-lsp-context' to
-decide whether a given directory is a project containing a
-suitable root directory for a given LSP server's purposes."
- (let ((eglot-lsp-context t))
- (or (project-current) `(transient . ,default-directory))))
-
-;;;###autoload
-(defun eglot (managed-major-mode project class contact language-id
- &optional interactive)
- "Manage a project with a Language Server Protocol (LSP) server.
-
-The LSP server of CLASS is started (or contacted) via CONTACT.
-If this operation is successful, current *and future* file
-buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\"
-by the LSP server, meaning information about their contents is
-exchanged periodically to provide enhanced code-analysis via
-`xref-find-definitions', `flymake-mode', `eldoc-mode',
-`completion-at-point', among others.
-
-Interactively, the command attempts to guess MANAGED-MAJOR-MODE
-from current buffer, CLASS and CONTACT from
-`eglot-server-programs' and PROJECT from
-`project-find-functions'. The search for active projects in this
-context binds `eglot-lsp-context' (which see).
-
-If it can't guess, the user is prompted. With a single
-\\[universal-argument] prefix arg, it always prompt for COMMAND.
-With two \\[universal-argument] prefix args, also prompts for
-MANAGED-MAJOR-MODE.
-
-PROJECT is a project object as returned by `project-current'.
-
-CLASS is a subclass of `eglot-lsp-server'.
-
-CONTACT specifies how to contact the server. It is a
-keyword-value plist used to initialize CLASS or a plain list as
-described in `eglot-server-programs', which see.
-
-LANGUAGE-ID is the language ID string to send to the server for
-MANAGED-MAJOR-MODE, which matters to a minority of servers.
-
-INTERACTIVE is t if called interactively."
- (interactive (append (eglot--guess-contact t) '(t)))
- (let* ((current-server (eglot-current-server))
- (live-p (and current-server (jsonrpc-running-p current-server))))
- (if (and live-p
- interactive
- (y-or-n-p "[eglot] Live process found, reconnect instead? "))
- (eglot-reconnect current-server interactive)
- (when live-p (ignore-errors (eglot-shutdown current-server)))
- (eglot--connect managed-major-mode project class contact language-id))))
-
-(defun eglot-reconnect (server &optional interactive)
- "Reconnect to SERVER.
-INTERACTIVE is t if called interactively."
- (interactive (list (eglot--current-server-or-lose) t))
- (when (jsonrpc-running-p server)
- (ignore-errors (eglot-shutdown server interactive nil 'preserve-buffers)))
- (eglot--connect (eglot--major-mode server)
- (eglot--project server)
- (eieio-object-class-name server)
- (eglot--saved-initargs server)
- (eglot--language-id server))
- (eglot--message "Reconnected!"))
-
-(defvar eglot--managed-mode) ; forward decl
-
-;;;###autoload
-(defun eglot-ensure ()
- "Start Eglot session for current buffer if there isn't one."
- (let ((buffer (current-buffer)))
- (cl-labels
- ((maybe-connect
- ()
- (remove-hook 'post-command-hook #'maybe-connect nil)
- (eglot--when-live-buffer buffer
- (unless eglot--managed-mode
- (apply #'eglot--connect (eglot--guess-contact))))))
- (when buffer-file-name
- (add-hook 'post-command-hook #'maybe-connect 'append nil)))))
-
-(defun eglot-events-buffer (server)
- "Display events buffer for SERVER.
-Use current server's or first available Eglot events buffer."
- (interactive (list (eglot-current-server)))
- (let ((buffer (if server (jsonrpc-events-buffer server)
- (cl-find "\\*EGLOT.*events\\*"
- (buffer-list)
- :key #'buffer-name :test #'string-match))))
- (if buffer (display-buffer buffer)
- (eglot--error "Can't find an Eglot events buffer!"))))
-
-(defun eglot-stderr-buffer (server)
- "Display stderr buffer for SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (display-buffer (jsonrpc-stderr-buffer server)))
-
-(defun eglot-forget-pending-continuations (server)
- "Forget pending requests for SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (jsonrpc-forget-pending-continuations server))
-
-(defvar eglot-connect-hook
- '(eglot-signal-didChangeConfiguration)
- "Hook run after connecting in `eglot--connect'.")
-
-(defvar eglot-server-initialized-hook
- '()
- "Hook run after a `eglot-lsp-server' instance is created.
-
-That is before a connection was established. Use
-`eglot-connect-hook' to hook into when a connection was
-successfully established and the server on the other side has
-received the initializing configuration.
-
-Each function is passed the server as an argument")
-
-(defun eglot--cmd (contact)
- "Helper for `eglot--connect'."
- (if (file-remote-p default-directory)
- ;; TODO: this seems like a bug, although it’s everywhere. For
- ;; some reason, for remote connections only, over a pipe, we
- ;; need to turn off line buffering on the tty.
- ;;
- ;; Not only does this seem like there should be a better way,
- ;; but it almost certainly doesn’t work on non-unix systems.
- (list "sh" "-c"
- (string-join (cons "stty raw > /dev/null;"
- (mapcar #'shell-quote-argument contact))
- " "))
- contact))
-
-(defvar-local eglot--cached-server nil
- "A cached reference to the current EGLOT server.")
-
-(defun eglot--connect (managed-major-mode project class contact language-id)
- "Connect to MANAGED-MAJOR-MODE, LANGUAGE-ID, PROJECT, CLASS and CONTACT.
-This docstring appeases checkdoc, that's all."
- (let* ((default-directory (project-root project))
- (nickname (file-name-base (directory-file-name default-directory)))
- (readable-name (format "EGLOT (%s/%s)" nickname managed-major-mode))
- autostart-inferior-process
- (contact (if (functionp contact) (funcall contact) contact))
- (initargs
- (cond ((keywordp (car contact)) contact)
- ((integerp (cadr contact))
- `(:process ,(lambda ()
- (apply #'open-network-stream
- readable-name nil
- (car contact) (cadr contact)
- (cddr contact)))))
- ((and (stringp (car contact)) (memq :autoport contact))
- `(:process ,(lambda ()
- (pcase-let ((`(,connection . ,inferior)
- (eglot--inferior-bootstrap
- readable-name
- contact)))
- (setq autostart-inferior-process inferior)
- connection))))
- ((stringp (car contact))
- `(:process
- ,(lambda ()
- (let ((default-directory default-directory))
- (make-process
- :name readable-name
- :command (eglot--cmd contact)
- :connection-type 'pipe
- :coding 'utf-8-emacs-unix
- :noquery t
- :stderr (get-buffer-create
- (format "*%s stderr*" readable-name))
- :file-handler t)))))))
- (spread (lambda (fn) (lambda (server method params)
- (let ((eglot--cached-server server))
- (apply fn server method (append params nil))))))
- (server
- (apply
- #'make-instance class
- :name readable-name
- :events-buffer-scrollback-size eglot-events-buffer-size
- :notification-dispatcher (funcall spread #'eglot-handle-notification)
- :request-dispatcher (funcall spread #'eglot-handle-request)
- :on-shutdown #'eglot--on-shutdown
- initargs))
- (cancelled nil)
- (tag (make-symbol "connected-catch-tag")))
- (setf (eglot--saved-initargs server) initargs)
- (setf (eglot--project server) project)
- (setf (eglot--project-nickname server) nickname)
- (setf (eglot--major-mode server) managed-major-mode)
- (setf (eglot--language-id server) language-id)
- (setf (eglot--inferior-process server) autostart-inferior-process)
- (run-hook-with-args 'eglot-server-initialized-hook server)
- ;; Now start the handshake. To honour `eglot-sync-connect'
- ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
- ;; and mimic most of `jsonrpc-request'.
- (unwind-protect
- (condition-case _quit
- (let ((retval
- (catch tag
- (jsonrpc-async-request
- server
- :initialize
- (list :processId
- (unless (or (file-remote-p default-directory)
- (eq (jsonrpc-process-type server)
- 'network))
- (emacs-pid))
- ;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py'
- ;; into `/path/to/baz.py', so LSP groks it.
- :rootPath (file-local-name
- (expand-file-name default-directory))
- :rootUri (eglot--path-to-uri default-directory)
- :initializationOptions (eglot-initialization-options
- server)
- :capabilities (eglot-client-capabilities server))
- :success-fn
- (eglot--lambda ((InitializeResult) capabilities serverInfo)
- (unless cancelled
- (push server
- (gethash project eglot--servers-by-project))
- (setf (eglot--capabilities server) capabilities)
- (setf (eglot--server-info server) serverInfo)
- (jsonrpc-notify server :initialized eglot--{})
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- ;; No need to pass SERVER as an argument: it has
- ;; been registered in `eglot--servers-by-project',
- ;; so that it can be found (and cached) from
- ;; `eglot--maybe-activate-editing-mode' in any
- ;; managed buffer.
- (eglot--maybe-activate-editing-mode)))
- (setf (eglot--inhibit-autoreconnect server)
- (cond
- ((booleanp eglot-autoreconnect)
- (not eglot-autoreconnect))
- ((cl-plusp eglot-autoreconnect)
- (run-with-timer
- eglot-autoreconnect nil
- (lambda ()
- (setf (eglot--inhibit-autoreconnect server)
- (null eglot-autoreconnect)))))))
- (let ((default-directory (project-root project))
- (major-mode managed-major-mode))
- (hack-dir-local-variables-non-file-buffer)
- (run-hook-with-args 'eglot-connect-hook server))
- (eglot--message
- "Connected! Server `%s' now managing `%s' buffers \
-in project `%s'."
- (or (plist-get serverInfo :name)
- (jsonrpc-name server))
- managed-major-mode
- (eglot-project-nickname server))
- (when tag (throw tag t))))
- :timeout eglot-connect-timeout
- :error-fn (eglot--lambda ((ResponseError) code message)
- (unless cancelled
- (jsonrpc-shutdown server)
- (let ((msg (format "%s: %s" code message)))
- (if tag (throw tag `(error . ,msg))
- (eglot--error msg)))))
- :timeout-fn (lambda ()
- (unless cancelled
- (jsonrpc-shutdown server)
- (let ((msg (format "Timed out")))
- (if tag (throw tag `(error . ,msg))
- (eglot--error msg))))))
- (cond ((numberp eglot-sync-connect)
- (accept-process-output nil eglot-sync-connect))
- (eglot-sync-connect
- (while t (accept-process-output nil 30)))))))
- (pcase retval
- (`(error . ,msg) (eglot--error msg))
- (`nil (eglot--message "Waiting in background for server `%s'"
- (jsonrpc-name server))
- nil)
- (_ server)))
- (quit (jsonrpc-shutdown server) (setq cancelled 'quit)))
- (setq tag nil))))
-
-(defun eglot--inferior-bootstrap (name contact &optional connect-args)
- "Use CONTACT to start a server, then connect to it.
-Return a cons of two process objects (CONNECTION . INFERIOR).
-Name both based on NAME.
-CONNECT-ARGS are passed as additional arguments to
-`open-network-stream'."
- (let* ((port-probe (make-network-process :name "eglot-port-probe-dummy"
- :server t
- :host "localhost"
- :service 0))
- (port-number (unwind-protect
- (process-contact port-probe :service)
- (delete-process port-probe)))
- inferior connection)
- (unwind-protect
- (progn
- (setq inferior
- (make-process
- :name (format "autostart-inferior-%s" name)
- :stderr (format "*%s stderr*" name)
- :noquery t
- :command (cl-subst
- (format "%s" port-number) :autoport contact)))
- (setq connection
- (cl-loop
- repeat 10 for i from 1
- do (accept-process-output nil 0.5)
- while (process-live-p inferior)
- do (eglot--message
- "Trying to connect to localhost and port %s (attempt %s)"
- port-number i)
- thereis (ignore-errors
- (apply #'open-network-stream
- (format "autoconnect-%s" name)
- nil
- "localhost" port-number connect-args))))
- (cons connection inferior))
- (cond ((and (process-live-p connection)
- (process-live-p inferior))
- (eglot--message "Done, connected to %s!" port-number))
- (t
- (when inferior (delete-process inferior))
- (when connection (delete-process connection))
- (eglot--error "Could not start and connect to server%s"
- (if inferior
- (format " started with %s"
- (process-command inferior))
- "!")))))))
-
-
-;;; Helpers (move these to API?)
-;;;
-(defun eglot--error (format &rest args)
- "Error out with FORMAT with ARGS."
- (error "[eglot] %s" (apply #'format format args)))
-
-(defun eglot--message (format &rest args)
- "Message out with FORMAT with ARGS."
- (message "[eglot] %s" (apply #'format format args)))
-
-(defun eglot--warn (format &rest args)
- "Warning message with FORMAT and ARGS."
- (apply #'eglot--message (concat "(warning) " format) args)
- (let ((warning-minimum-level :error))
- (display-warning 'eglot (apply #'format format args) :warning)))
-
-(defun eglot-current-column () (- (point) (point-at-bol)))
-
-(defvar eglot-current-column-function #'eglot-lsp-abiding-column
- "Function to calculate the current column.
-
-This is the inverse operation of
-`eglot-move-to-column-function' (which see). It is a function of
-no arguments returning a column number. For buffers managed by
-fully LSP-compliant servers, this should be set to
-`eglot-lsp-abiding-column' (the default), and
-`eglot-current-column' for all others.")
-
-(defun eglot-lsp-abiding-column (&optional lbp)
- "Calculate current COLUMN as defined by the LSP spec.
-LBP defaults to `line-beginning-position'."
- (/ (- (length (encode-coding-region (or lbp (line-beginning-position))
- (point) 'utf-16 t))
- 2)
- 2))
-
-(defun eglot--pos-to-lsp-position (&optional pos)
- "Convert point POS to LSP position."
- (eglot--widening
- (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE
- :character (progn (when pos (goto-char pos))
- (funcall eglot-current-column-function)))))
-
-(defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column
- "Function to move to a column reported by the LSP server.
-
-According to the standard, LSP column/character offsets are based
-on a count of UTF-16 code units, not actual visual columns. So
-when LSP says position 3 of a line containing just \"aXbc\",
-where X is a multi-byte character, it actually means `b', not
-`c'. However, many servers don't follow the spec this closely.
-
-For buffers managed by fully LSP-compliant servers, this should
-be set to `eglot-move-to-lsp-abiding-column' (the default), and
-`eglot-move-to-column' for all others.")
-
-(defun eglot-move-to-column (column)
- "Move to COLUMN without closely following the LSP spec."
- ;; We cannot use `move-to-column' here, because it moves to *visual*
- ;; columns, which can be different from LSP columns in case of
- ;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296,
- ;; github#297)
- (goto-char (min (+ (line-beginning-position) column)
- (line-end-position))))
-
-(defun eglot-move-to-lsp-abiding-column (column)
- "Move to COLUMN abiding by the LSP spec."
- (save-restriction
- (cl-loop
- with lbp = (line-beginning-position)
- initially
- (narrow-to-region lbp (line-end-position))
- (move-to-column column)
- for diff = (- column
- (eglot-lsp-abiding-column lbp))
- until (zerop diff)
- do (condition-case eob-err
- (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2))
- (end-of-buffer (cl-return eob-err))))))
-
-(defun eglot--lsp-position-to-point (pos-plist &optional marker)
- "Convert LSP position POS-PLIST to Emacs point.
-If optional MARKER, return a marker instead"
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (forward-line (min most-positive-fixnum
- (plist-get pos-plist :line)))
- (unless (eobp) ;; if line was excessive leave point at eob
- (let ((tab-width 1)
- (col (plist-get pos-plist :character)))
- (unless (wholenump col)
- (eglot--warn
- "Caution: LSP server sent invalid character position %s. Using 0 instead."
- col)
- (setq col 0))
- (funcall eglot-move-to-column-function col)))
- (if marker (copy-marker (point-marker)) (point)))))
-
-(defconst eglot--uri-path-allowed-chars
- (let ((vec (copy-sequence url-path-allowed-chars)))
- (aset vec ?: nil) ;; see github#639
- vec)
- "Like `url-path-allows-chars' but more restrictive.")
-
-(defun eglot--path-to-uri (path)
- "URIfy PATH."
- (let ((truepath (file-truename path)))
- (concat "file://"
- ;; Add a leading "/" for local MS Windows-style paths.
- (if (and (eq system-type 'windows-nt)
- (not (file-remote-p truepath)))
- "/")
- (url-hexify-string
- ;; Again watch out for trampy paths.
- (directory-file-name (file-local-name truepath))
- eglot--uri-path-allowed-chars))))
-
-(defun eglot--uri-to-path (uri)
- "Convert URI to file path, helped by `eglot--current-server'."
- (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
- (let* ((server (eglot-current-server))
- (remote-prefix (and server
- (file-remote-p
- (project-root (eglot--project server)))))
- (retval (url-filename (url-generic-parse-url (url-unhex-string uri))))
- ;; Remove the leading "/" for local MS Windows-style paths.
- (normalized (if (and (not remote-prefix)
- (eq system-type 'windows-nt)
- (cl-plusp (length retval)))
- (substring retval 1)
- retval)))
- (concat remote-prefix normalized)))
-
-(defun eglot--snippet-expansion-fn ()
- "Compute a function to expand snippets.
-Doubles as an indicator of snippet support."
- (and (boundp 'yas-minor-mode)
- (symbol-value 'yas-minor-mode)
- 'yas-expand-snippet))
-
-(defun eglot--format-markup (markup)
- "Format MARKUP according to LSP's spec."
- (pcase-let ((`(,string ,mode)
- (if (stringp markup) (list markup 'gfm-view-mode)
- (list (plist-get markup :value)
- (pcase (plist-get markup :kind)
- ("markdown" 'gfm-view-mode)
- ("plaintext" 'text-mode)
- (_ major-mode))))))
- (with-temp-buffer
- (setq-local markdown-fontify-code-blocks-natively t)
- (insert string)
- (let ((inhibit-message t)
- (message-log-max nil))
- (ignore-errors (delay-mode-hooks (funcall mode))))
- (font-lock-ensure)
- (string-trim (filter-buffer-substring (point-min) (point-max))))))
-
-(define-obsolete-variable-alias 'eglot-ignored-server-capabilites
- 'eglot-ignored-server-capabilities "1.8")
-
-(defcustom eglot-ignored-server-capabilities (list)
- "LSP server capabilities that Eglot could use, but won't.
-You could add, for instance, the symbol
-`:documentHighlightProvider' to prevent automatic highlighting
-under cursor."
- :type '(set
- :tag "Tick the ones you're not interested in"
- (const :tag "Documentation on hover" :hoverProvider)
- (const :tag "Code completion" :completionProvider)
- (const :tag "Function signature help" :signatureHelpProvider)
- (const :tag "Go to definition" :definitionProvider)
- (const :tag "Go to type definition" :typeDefinitionProvider)
- (const :tag "Go to implementation" :implementationProvider)
- (const :tag "Go to declaration" :implementationProvider)
- (const :tag "Find references" :referencesProvider)
- (const :tag "Highlight symbols automatically" :documentHighlightProvider)
- (const :tag "List symbols in buffer" :documentSymbolProvider)
- (const :tag "List symbols in workspace" :workspaceSymbolProvider)
- (const :tag "Execute code actions" :codeActionProvider)
- (const :tag "Code lens" :codeLensProvider)
- (const :tag "Format buffer" :documentFormattingProvider)
- (const :tag "Format portion of buffer" :documentRangeFormattingProvider)
- (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
- (const :tag "Rename symbol" :renameProvider)
- (const :tag "Highlight links in document" :documentLinkProvider)
- (const :tag "Decorate color references" :colorProvider)
- (const :tag "Fold regions of buffer" :foldingRangeProvider)
- (const :tag "Execute custom commands" :executeCommandProvider)))
-
-(defun eglot--server-capable (&rest feats)
- "Determine if current server is capable of FEATS."
- (unless (cl-some (lambda (feat)
- (memq feat eglot-ignored-server-capabilites))
- feats)
- (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
- then (cadr probe)
- for (feat . more) on feats
- for probe = (plist-member caps feat)
- if (not probe) do (cl-return nil)
- if (eq (cadr probe) :json-false) do (cl-return nil)
- if (not (listp (cadr probe))) do (cl-return (if more nil (cadr probe)))
- finally (cl-return (or (cadr probe) t)))))
-
-(defun eglot--range-region (range &optional markers)
- "Return region (BEG . END) that represents LSP RANGE.
-If optional MARKERS, make markers."
- (let* ((st (plist-get range :start))
- (beg (eglot--lsp-position-to-point st markers))
- (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
- (cons beg end)))
-
-(defun eglot--read-server (prompt &optional dont-if-just-the-one)
- "Read a running Eglot server from minibuffer using PROMPT.
-If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt
-and just return it. PROMPT shouldn't end with a question mark."
- (let ((servers (cl-loop for servers
- being hash-values of eglot--servers-by-project
- append servers))
- (name (lambda (srv)
- (format "%s/%s" (eglot-project-nickname srv)
- (eglot--major-mode srv)))))
- (cond ((null servers)
- (eglot--error "No servers!"))
- ((or (cdr servers) (not dont-if-just-the-one))
- (let* ((default (when-let ((current (eglot-current-server)))
- (funcall name current)))
- (read (completing-read
- (if default
- (format "%s (default %s)? " prompt default)
- (concat prompt "? "))
- (mapcar name servers)
- nil t
- nil nil
- default)))
- (cl-find read servers :key name :test #'equal)))
- (t (car servers)))))
-
-
-;;; Minor modes
-;;;
-(defvar eglot-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap display-local-help] 'eldoc-doc-buffer)
- map))
-
-(defvar-local eglot--current-flymake-report-fn nil
- "Current flymake report function for this buffer")
-
-(defvar-local eglot--saved-bindings nil
- "Bindings saved by `eglot--setq-saving'.")
-
-(defvar eglot-stay-out-of '()
- "List of Emacs things that Eglot should try to stay of.
-Each element is a string, a symbol, or a regexp which is matched
-against a variable's name. Examples include the string
-\"company\" or the symbol `xref'.
-
-Before Eglot starts \"managing\" a particular buffer, it
-opinionatedly sets some peripheral Emacs facilites, such as
-Flymake, Xref and Company. These overriding settings help ensure
-consistent Eglot behaviour and only stay in place until
-\"managing\" stops (usually via `eglot-shutdown'), whereupon the
-previous settings are restored.
-
-However, if you wish for Eglot to stay out of a particular Emacs
-facility that you'd like to keep control of add an element to
-this list and Eglot will refrain from setting it.
-
-For example, to keep your Company customization use
-
-(add-to-list 'eglot-stay-out-of 'company)")
-
-(defun eglot--stay-out-of-p (symbol)
- "Tell if EGLOT should stay of of SYMBOL."
- (cl-find (symbol-name symbol) eglot-stay-out-of
- :test (lambda (s thing)
- (let ((re (if (symbolp thing) (symbol-name thing) thing)))
- (string-match re s)))))
-
-(defmacro eglot--setq-saving (symbol binding)
- `(unless (or (not (boundp ',symbol)) (eglot--stay-out-of-p ',symbol))
- (push (cons ',symbol (symbol-value ',symbol)) eglot--saved-bindings)
- (setq-local ,symbol ,binding)))
-
-(defun eglot-managed-p ()
- "Tell if current buffer is managed by EGLOT."
- eglot--managed-mode)
-
-(make-obsolete-variable
- 'eglot--managed-mode-hook 'eglot-managed-mode-hook "1.6")
-
-(defvar eglot-managed-mode-hook nil
- "A hook run by EGLOT after it started/stopped managing a buffer.
-Use `eglot-managed-p' to determine if current buffer is managed.")
-
-(define-minor-mode eglot--managed-mode
- "Mode for source buffers managed by some EGLOT project."
- :init-value nil :lighter nil :keymap eglot-mode-map
- (cond
- (eglot--managed-mode
- (add-hook 'after-change-functions 'eglot--after-change nil t)
- (add-hook 'before-change-functions 'eglot--before-change nil t)
- (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
- ;; Prepend "didClose" to the hook after the "nonoff", so it will run first
- (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t)
- (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t)
- (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t)
- (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t)
- (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t)
- (unless (eglot--stay-out-of-p 'xref)
- (add-hook 'xref-backend-functions 'eglot-xref-backend nil t))
- (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t)
- (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t)
- (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t)
- (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t)
- (eglot--setq-saving eldoc-documentation-functions
- '(eglot-signature-eldoc-function
- eglot-hover-eldoc-function))
- (eglot--setq-saving eldoc-documentation-strategy
- #'eldoc-documentation-enthusiast)
- (eglot--setq-saving xref-prompt-for-identifier nil)
- (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend))
- (eglot--setq-saving company-backends '(company-capf))
- (eglot--setq-saving company-tooltip-align-annotations t)
- (unless (eglot--stay-out-of-p 'imenu)
- (add-function :before-until (local 'imenu-create-index-function)
- #'eglot-imenu))
- (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1))
- (unless (eglot--stay-out-of-p 'eldoc) (eldoc-mode 1))
- (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server))))
- (t
- (remove-hook 'after-change-functions 'eglot--after-change t)
- (remove-hook 'before-change-functions 'eglot--before-change t)
- (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
- (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t)
- (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t)
- (remove-hook 'after-revert-hook 'eglot--after-revert-hook t)
- (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t)
- (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t)
- (remove-hook 'xref-backend-functions 'eglot-xref-backend t)
- (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t)
- (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t)
- (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t)
- (remove-hook 'pre-command-hook 'eglot--pre-command-hook t)
- (cl-loop for (var . saved-binding) in eglot--saved-bindings
- do (set (make-local-variable var) saved-binding))
- (remove-function (local 'imenu-create-index-function) #'eglot-imenu)
- (when eglot--current-flymake-report-fn
- (eglot--report-to-flymake nil)
- (setq eglot--current-flymake-report-fn nil))
- (let ((server eglot--cached-server))
- (setq eglot--cached-server nil)
- (when server
- (setf (eglot--managed-buffers server)
- (delq (current-buffer) (eglot--managed-buffers server)))
- (when (and eglot-autoshutdown
- (null (eglot--managed-buffers server)))
- (eglot-shutdown server))))))
- ;; Note: the public hook runs before the internal eglot--managed-mode-hook.
- (run-hooks 'eglot-managed-mode-hook))
-
-(defun eglot--managed-mode-off ()
- "Turn off `eglot--managed-mode' unconditionally."
- (eglot--managed-mode -1))
-
-(defun eglot-current-server ()
- "Return logical EGLOT server for current buffer, nil if none."
- (setq eglot--cached-server
- (or eglot--cached-server
- (cl-find major-mode
- (gethash (eglot--current-project) eglot--servers-by-project)
- :key #'eglot--major-mode)
- (and eglot-extend-to-xref
- buffer-file-name
- (gethash (expand-file-name buffer-file-name)
- eglot--servers-by-xrefed-file)))))
-
-(defun eglot--current-server-or-lose ()
- "Return current logical EGLOT server connection or error."
- (or (eglot-current-server)
- (jsonrpc-error "No current JSON-RPC connection")))
-
-(defvar-local eglot--unreported-diagnostics nil
- "Unreported Flymake diagnostics for this buffer.")
-
-(defvar revert-buffer-preserve-modes)
-(defun eglot--after-revert-hook ()
- "Eglot's `after-revert-hook'."
- (when revert-buffer-preserve-modes (eglot--signal-textDocument/didOpen)))
-
-(defun eglot--maybe-activate-editing-mode ()
- "Maybe activate `eglot--managed-mode'.
-
-If it is activated, also signal textDocument/didOpen."
- (unless eglot--managed-mode
- ;; Called when `revert-buffer-in-progress-p' is t but
- ;; `revert-buffer-preserve-modes' is nil.
- (when (and buffer-file-name (eglot-current-server))
- (setq eglot--unreported-diagnostics `(:just-opened . nil))
- (eglot--managed-mode)
- (eglot--signal-textDocument/didOpen))))
-
-(add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode)
-(add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode)
-
-(defun eglot-clear-status (server)
- "Clear the last JSONRPC error for SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (setf (jsonrpc-last-error server) nil))
-
-
-;;; Mode-line, menu and other sugar
-;;;
-(defvar eglot--mode-line-format `(:eval (eglot--mode-line-format)))
-
-(put 'eglot--mode-line-format 'risky-local-variable t)
-
-(defun eglot--mouse-call (what)
- "Make an interactive lambda for calling WHAT from mode-line."
- (lambda (event)
- (interactive "e")
- (let ((start (event-start event))) (with-selected-window (posn-window start)
- (save-excursion
- (goto-char (or (posn-point start)
- (point)))
- (call-interactively what)
- (force-mode-line-update t))))))
-
-(defun eglot--mode-line-props (thing face defs &optional prepend)
- "Helper for function `eglot--mode-line-format'.
-Uses THING, FACE, DEFS and PREPEND."
- (cl-loop with map = (make-sparse-keymap)
- for (elem . rest) on defs
- for (key def help) = elem
- do (define-key map `[mode-line ,key] (eglot--mouse-call def))
- concat (format "%s: %s" key help) into blurb
- when rest concat "\n" into blurb
- finally (return `(:propertize ,thing
- face ,face
- keymap ,map help-echo ,(concat prepend blurb)
- mouse-face mode-line-highlight))))
-
-(defun eglot--mode-line-format ()
- "Compose the EGLOT's mode-line."
- (pcase-let* ((server (eglot-current-server))
- (nick (and server (eglot-project-nickname server)))
- (pending (and server (hash-table-count
- (jsonrpc--request-continuations server))))
- (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner server)))
- (last-error (and server (jsonrpc-last-error server))))
- (append
- `(,(eglot--mode-line-props "eglot" 'eglot-mode-line nil))
- (when nick
- `(":" ,(eglot--mode-line-props
- nick 'eglot-mode-line
- '((C-mouse-1 eglot-stderr-buffer "go to stderr buffer")
- (mouse-1 eglot-events-buffer "go to events buffer")
- (mouse-2 eglot-shutdown "quit server")
- (mouse-3 eglot-reconnect "reconnect to server")))
- ,@(when last-error
- `("/" ,(eglot--mode-line-props
- "error" 'compilation-mode-line-fail
- '((mouse-3 eglot-clear-status "clear this status"))
- (format "An error occured: %s\n" (plist-get last-error
- :message)))))
- ,@(when (and doing (not done-p))
- `("/" ,(eglot--mode-line-props doing
- 'compilation-mode-line-run '())))
- ,@(when (cl-plusp pending)
- `("/" ,(eglot--mode-line-props
- (format "%d" pending) 'warning
- '((mouse-3 eglot-forget-pending-continuations
- "forget pending continuations"))))))))))
-
-(add-to-list 'mode-line-misc-info
- `(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
-
-(put 'eglot-note 'flymake-category 'flymake-note)
-(put 'eglot-warning 'flymake-category 'flymake-warning)
-(put 'eglot-error 'flymake-category 'flymake-error)
-
-(defalias 'eglot--make-diag 'flymake-make-diagnostic)
-(defalias 'eglot--diag-data 'flymake-diagnostic-data)
-
-(cl-loop for i from 1
- for type in '(eglot-note eglot-warning eglot-error )
- do (put type 'flymake-overlay-control
- `((mouse-face . highlight)
- (priority . ,(+ 50 i))
- (keymap . ,(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1]
- (eglot--mouse-call 'eglot-code-actions))
- map)))))
-
-
-;;; Protocol implementation (Requests, notifications, etc)
-;;;
-(cl-defmethod eglot-handle-notification
- (_server method &key &allow-other-keys)
- "Handle unknown notification"
- (unless (or (string-prefix-p "$" (format "%s" method))
- (not (memq 'disallow-unknown-methods eglot-strict-mode)))
- (eglot--warn "Server sent unknown notification method `%s'" method)))
-
-(cl-defmethod eglot-handle-request
- (_server method &key &allow-other-keys)
- "Handle unknown request"
- (when (memq 'disallow-unknown-methods eglot-strict-mode)
- (jsonrpc-error "Unknown request method `%s'" method)))
-
-(cl-defmethod eglot-execute-command
- (server command arguments)
- "Execute COMMAND on SERVER with `:workspace/executeCommand'.
-COMMAND is a symbol naming the command."
- (jsonrpc-request server :workspace/executeCommand
- `(:command ,(format "%s" command) :arguments ,arguments)))
-
-(cl-defmethod eglot-handle-notification
- (_server (_method (eql window/showMessage)) &key type message)
- "Handle notification window/showMessage"
- (eglot--message (propertize "Server reports (type=%s): %s"
- 'face (if (<= type 1) 'error))
- type message))
-
-(cl-defmethod eglot-handle-request
- (_server (_method (eql window/showMessageRequest)) &key type message actions)
- "Handle server request window/showMessageRequest"
- (let* ((actions (append actions nil)) ;; gh#627
- (label (completing-read
- (concat
- (format (propertize "[eglot] Server reports (type=%s): %s"
- 'face (if (<= type 1) 'error))
- type message)
- "\nChoose an option: ")
- (or (mapcar (lambda (obj) (plist-get obj :title)) actions)
- '("OK"))
- nil t (plist-get (elt actions 0) :title))))
- (if label `(:title ,label) :null)))
-
-(cl-defmethod eglot-handle-notification
- (_server (_method (eql window/logMessage)) &key _type _message)
- "Handle notification window/logMessage") ;; noop, use events buffer
-
-(cl-defmethod eglot-handle-notification
- (_server (_method (eql telemetry/event)) &rest _any)
- "Handle notification telemetry/event") ;; noop, use events buffer
-
-(cl-defmethod eglot-handle-notification
- (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
- &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
- "Handle notification publishDiagnostics"
- (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri))))
- (with-current-buffer buffer
- (cl-loop
- for diag-spec across diagnostics
- collect (eglot--dbind ((Diagnostic) range message severity source)
- diag-spec
- (setq message (concat source ": " message))
- (pcase-let
- ((sev severity)
- (`(,beg . ,end) (eglot--range-region range)))
- ;; Fallback to `flymake-diag-region' if server
- ;; botched the range
- (when (= beg end)
- (if-let* ((st (plist-get range :start))
- (diag-region
- (flymake-diag-region
- (current-buffer) (1+ (plist-get st :line))
- (plist-get st :character))))
- (setq beg (car diag-region) end (cdr diag-region))
- (eglot--widening
- (goto-char (point-min))
- (setq beg
- (point-at-bol
- (1+ (plist-get (plist-get range :start) :line))))
- (setq end
- (point-at-eol
- (1+ (plist-get (plist-get range :end) :line)))))))
- (eglot--make-diag (current-buffer) beg end
- (cond ((null sev) 'eglot-error)
- ((<= sev 1) 'eglot-error)
- ((= sev 2) 'eglot-warning)
- (t 'eglot-note))
- message `((eglot-lsp-diag . ,diag-spec)))))
- into diags
- finally (cond (eglot--current-flymake-report-fn
- (eglot--report-to-flymake diags))
- (t
- (setq eglot--unreported-diagnostics (cons t diags))))))
- (jsonrpc--debug server "Diagnostics received for unvisited %s" uri)))
-
-(cl-defun eglot--register-unregister (server things how)
- "Helper for `registerCapability'.
-THINGS are either registrations or unregisterations (sic)."
- (cl-loop
- for thing in (cl-coerce things 'list)
- do (eglot--dbind ((Registration) id method registerOptions) thing
- (apply (cl-ecase how
- (register 'eglot-register-capability)
- (unregister 'eglot-unregister-capability))
- server (intern method) id registerOptions))))
-
-(cl-defmethod eglot-handle-request
- (server (_method (eql client/registerCapability)) &key registrations)
- "Handle server request client/registerCapability"
- (eglot--register-unregister server registrations 'register))
-
-(cl-defmethod eglot-handle-request
- (server (_method (eql client/unregisterCapability))
- &key unregisterations) ;; XXX: "unregisterations" (sic)
- "Handle server request client/unregisterCapability"
- (eglot--register-unregister server unregisterations 'unregister))
-
-(cl-defmethod eglot-handle-request
- (_server (_method (eql workspace/applyEdit)) &key _label edit)
- "Handle server request workspace/applyEdit"
- (eglot--apply-workspace-edit edit eglot-confirm-server-initiated-edits))
-
-(defun eglot--TextDocumentIdentifier ()
- "Compute TextDocumentIdentifier object for current buffer."
- `(:uri ,(eglot--path-to-uri (or buffer-file-name
- (ignore-errors
- (buffer-file-name
- (buffer-base-buffer)))))))
-
-(defvar-local eglot--versioned-identifier 0)
-
-(defun eglot--VersionedTextDocumentIdentifier ()
- "Compute VersionedTextDocumentIdentifier object for current buffer."
- (append (eglot--TextDocumentIdentifier)
- `(:version ,eglot--versioned-identifier)))
-
-(defun eglot--TextDocumentItem ()
- "Compute TextDocumentItem object for current buffer."
- (append
- (eglot--VersionedTextDocumentIdentifier)
- (list :languageId
- (eglot--language-id (eglot--current-server-or-lose))
- :text
- (eglot--widening
- (buffer-substring-no-properties (point-min) (point-max))))))
-
-(defun eglot--TextDocumentPositionParams ()
- "Compute TextDocumentPositionParams."
- (list :textDocument (eglot--TextDocumentIdentifier)
- :position (eglot--pos-to-lsp-position)))
-
-(defvar-local eglot--last-inserted-char nil
- "If non-nil, value of the last inserted character in buffer.")
-
-(defun eglot--post-self-insert-hook ()
- "Set `eglot--last-inserted-char'."
- (setq eglot--last-inserted-char last-input-event))
-
-(defun eglot--pre-command-hook ()
- "Reset `eglot--last-inserted-char'."
- (setq eglot--last-inserted-char nil))
-
-(defun eglot--CompletionParams ()
- (append
- (eglot--TextDocumentPositionParams)
- `(:context
- ,(if-let (trigger (and (characterp eglot--last-inserted-char)
- (cl-find eglot--last-inserted-char
- (eglot--server-capable :completionProvider
- :triggerCharacters)
- :key (lambda (str) (aref str 0))
- :test #'char-equal)))
- `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1)))))
-
-(defvar-local eglot--recent-changes nil
- "Recent buffer changes as collected by `eglot--before-change'.")
-
-(cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what)
- "Tell if SERVER is ready for WHAT in current buffer."
- (and (cl-call-next-method) (not eglot--recent-changes)))
-
-(defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.")
-
-(defun eglot--before-change (beg end)
- "Hook onto `before-change-functions' with BEG and END."
- (when (listp eglot--recent-changes)
- ;; Records BEG and END, crucially convert them into LSP
- ;; (line/char) positions before that information is lost (because
- ;; the after-change thingy doesn't know if newlines were
- ;; deleted/added). Also record markers of BEG and END
- ;; (github#259)
- (push `(,(eglot--pos-to-lsp-position beg)
- ,(eglot--pos-to-lsp-position end)
- (,beg . ,(copy-marker beg nil))
- (,end . ,(copy-marker end t)))
- eglot--recent-changes)))
-
-(defun eglot--after-change (beg end pre-change-length)
- "Hook onto `after-change-functions'.
-Records BEG, END and PRE-CHANGE-LENGTH locally."
- (cl-incf eglot--versioned-identifier)
- (pcase (and (listp eglot--recent-changes)
- (car eglot--recent-changes))
- (`(,lsp-beg ,lsp-end
- (,b-beg . ,b-beg-marker)
- (,b-end . ,b-end-marker))
- ;; github#259 and github#367: With `capitalize-word' or somesuch,
- ;; `before-change-functions' always records the whole word's
- ;; `b-beg' and `b-end'. Similarly, when coalescing two lines
- ;; into one, `fill-paragraph' they mark the end of the first line
- ;; up to the end of the second line. In both situations, args
- ;; received here contradict that information: `beg' and `end'
- ;; will differ by 1 and will likely only encompass the letter
- ;; that was capitalized or, in the sentence-joining situation,
- ;; the replacement of the newline with a space. That's we keep
- ;; markers _and_ positions so we're able to detect and correct
- ;; this. We ignore `beg', `len' and `pre-change-len' and send
- ;; "fuller" information about the region from the markers. I've
- ;; also experimented with doing this unconditionally but it seems
- ;; to break when newlines are added.
- (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
- (or (/= beg b-beg) (/= end b-end)))
- (setcar eglot--recent-changes
- `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
- ,(buffer-substring-no-properties b-beg-marker
- b-end-marker)))
- (setcar eglot--recent-changes
- `(,lsp-beg ,lsp-end ,pre-change-length
- ,(buffer-substring-no-properties beg end)))))
- (_ (setf eglot--recent-changes :emacs-messup)))
- (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer))
- (let ((buf (current-buffer)))
- (setq eglot--change-idle-timer
- (run-with-idle-timer
- eglot-send-changes-idle-time
- nil (lambda () (eglot--when-live-buffer buf
- (when eglot--managed-mode
- (eglot--signal-textDocument/didChange)
- (setq eglot--change-idle-timer nil))))))))
-
-;; HACK! Launching a deferred sync request with outstanding changes is a
-;; bad idea, since that might lead to the request never having a
-;; chance to run, because `jsonrpc-connection-ready-p'.
-(advice-add #'jsonrpc-request :before
- (cl-function (lambda (_proc _method _params &key
- deferred &allow-other-keys)
- (when (and eglot--managed-mode deferred)
- (eglot--signal-textDocument/didChange))))
- '((name . eglot--signal-textDocument/didChange)))
-
-(defvar-local eglot-workspace-configuration ()
- "Alist of (SECTION . VALUE) entries configuring the LSP server.
-SECTION should be a keyword or a string, value can be anything
-that can be converted to JSON.")
-
-;;;###autoload
-(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
-
-(defun eglot-signal-didChangeConfiguration (server)
- "Send a `:workspace/didChangeConfiguration' signal to SERVER.
-When called interactively, use the currently active server"
- (interactive (list (eglot--current-server-or-lose)))
- (jsonrpc-notify
- server :workspace/didChangeConfiguration
- (list
- :settings
- (cl-loop for (section . v) in eglot-workspace-configuration
- collect (if (keywordp section)
- section
- (intern (format ":%s" section)))
- collect v))))
-
-(cl-defmethod eglot-handle-request
- (server (_method (eql workspace/configuration)) &key items)
- "Handle server request workspace/configuration."
- (apply #'vector
- (mapcar
- (eglot--lambda ((ConfigurationItem) scopeUri section)
- (with-temp-buffer
- (let* ((uri-path (eglot--uri-to-path scopeUri))
- (default-directory
- (if (and (not (string-empty-p uri-path))
- (file-directory-p uri-path))
- (file-name-as-directory uri-path)
- (project-root (eglot--project server)))))
- (setq-local major-mode (eglot--major-mode server))
- (hack-dir-local-variables-non-file-buffer)
- (alist-get section eglot-workspace-configuration
- nil nil
- (lambda (wsection section)
- (string=
- (if (keywordp wsection)
- (substring (symbol-name wsection) 1)
- wsection)
- section))))))
- items)))
-
-(defun eglot--signal-textDocument/didChange ()
- "Send textDocument/didChange to server."
- (when eglot--recent-changes
- (let* ((server (eglot--current-server-or-lose))
- (sync-capability (eglot--server-capable :textDocumentSync))
- (sync-kind (if (numberp sync-capability) sync-capability
- (plist-get sync-capability :change)))
- (full-sync-p (or (eq sync-kind 1)
- (eq :emacs-messup eglot--recent-changes))))
- (jsonrpc-notify
- server :textDocument/didChange
- (list
- :textDocument (eglot--VersionedTextDocumentIdentifier)
- :contentChanges
- (if full-sync-p
- (vector `(:text ,(eglot--widening
- (buffer-substring-no-properties (point-min)
- (point-max)))))
- (cl-loop for (beg end len text) in (reverse eglot--recent-changes)
- ;; github#259: `capitalize-word' and commands based
- ;; on `casify_region' will cause multiple duplicate
- ;; empty entries in `eglot--before-change' calls
- ;; without an `eglot--after-change' reciprocal.
- ;; Weed them out here.
- when (numberp len)
- vconcat `[,(list :range `(:start ,beg :end ,end)
- :rangeLength len :text text)]))))
- (setq eglot--recent-changes nil)
- (setf (eglot--spinner server) (list nil :textDocument/didChange t))
- (jsonrpc--call-deferred server))))
-
-(defun eglot--signal-textDocument/didOpen ()
- "Send textDocument/didOpen to server."
- (setq eglot--recent-changes nil eglot--versioned-identifier 0)
- (jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
-
-(defun eglot--signal-textDocument/didClose ()
- "Send textDocument/didClose to server."
- (with-demoted-errors
- "[eglot] error sending textDocument/didClose: %s"
- (jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier)))))
-
-(defun eglot--signal-textDocument/willSave ()
- "Send textDocument/willSave to server."
- (let ((server (eglot--current-server-or-lose))
- (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
- (jsonrpc-notify server :textDocument/willSave params)
- (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
- (ignore-errors
- (eglot--apply-text-edits
- (jsonrpc-request server :textDocument/willSaveWaitUntil params
- :timeout 0.5))))))
-
-(defun eglot--signal-textDocument/didSave ()
- "Send textDocument/didSave to server."
- (eglot--signal-textDocument/didChange)
- (jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didSave
- (list
- ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
- :text (buffer-substring-no-properties (point-min) (point-max))
- :textDocument (eglot--TextDocumentIdentifier))))
-
-(defun eglot-flymake-backend (report-fn &rest _more)
- "A Flymake backend for Eglot.
-Calls REPORT-FN (or arranges for it to be called) when the server
-publishes diagnostics. Between calls to this function, REPORT-FN
-may be called multiple times (respecting the protocol of
-`flymake-backend-functions')."
- (cond (eglot--managed-mode
- (setq eglot--current-flymake-report-fn report-fn)
- ;; Report anything unreported
- (when eglot--unreported-diagnostics
- (eglot--report-to-flymake (cdr eglot--unreported-diagnostics))))
- (t
- (funcall report-fn nil))))
-
-(defun eglot--report-to-flymake (diags)
- "Internal helper for `eglot-flymake-backend'."
- (save-restriction
- (widen)
- (funcall eglot--current-flymake-report-fn diags
- ;; If the buffer hasn't changed since last
- ;; call to the report function, flymake won't
- ;; delete old diagnostics. Using :region
- ;; keyword forces flymake to delete
- ;; them (github#159).
- :region (cons (point-min) (point-max))))
- (setq eglot--unreported-diagnostics nil))
-
-(defun eglot-xref-backend () "EGLOT xref backend." 'eglot)
-
-(defvar eglot--temp-location-buffers (make-hash-table :test #'equal)
- "Helper variable for `eglot--handling-xrefs'.")
-
-(defvar eglot-xref-lessp-function #'ignore
- "Compare two `xref-item' objects for sorting.")
-
-(cl-defmacro eglot--collecting-xrefs ((collector) &rest body)
- "Sort and handle xrefs collected with COLLECTOR in BODY."
- (declare (indent 1) (debug (sexp &rest form)))
- (let ((collected (cl-gensym "collected")))
- `(unwind-protect
- (let (,collected)
- (cl-flet ((,collector (xref) (push xref ,collected)))
- ,@body)
- (sort ,collected eglot-xref-lessp-function))
- (maphash (lambda (_uri buf) (kill-buffer buf)) eglot--temp-location-buffers)
- (clrhash eglot--temp-location-buffers))))
-
-(defun eglot--xref-make-match (name uri range)
- "Like `xref-make-match' but with LSP's NAME, URI and RANGE.
-Try to visit the target file for a richer summary line."
- (pcase-let*
- ((file (eglot--uri-to-path uri))
- (visiting (or (find-buffer-visiting file)
- (gethash uri eglot--temp-location-buffers)))
- (collect (lambda ()
- (eglot--widening
- (pcase-let* ((`(,beg . ,end) (eglot--range-region range))
- (bol (progn (goto-char beg) (point-at-bol)))
- (substring (buffer-substring bol (point-at-eol)))
- (hi-beg (- beg bol))
- (hi-end (- (min (point-at-eol) end) bol)))
- (add-face-text-property hi-beg hi-end 'xref-match
- t substring)
- (list substring (1+ (current-line)) (eglot-current-column)
- (- end beg))))))
- (`(,summary ,line ,column ,length)
- (cond
- (visiting (with-current-buffer visiting (funcall collect)))
- ((file-readable-p file) (with-current-buffer
- (puthash uri (generate-new-buffer " *temp*")
- eglot--temp-location-buffers)
- (insert-file-contents file)
- (funcall collect)))
- (t ;; fall back to the "dumb strategy"
- (let* ((start (cl-getf range :start))
- (line (1+ (cl-getf start :line)))
- (start-pos (cl-getf start :character))
- (end-pos (cl-getf (cl-getf range :end) :character)))
- (list name line start-pos (- end-pos start-pos)))))))
- (setf (gethash (expand-file-name file) eglot--servers-by-xrefed-file)
- (eglot--current-server-or-lose))
- (xref-make-match summary (xref-make-file-location file line column) length)))
-
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
- (eglot--error "cannot (yet) provide reliable completion table for LSP symbols"))
-
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
- ;; JT@19/10/09: This is a totally dummy identifier that isn't even
- ;; passed to LSP. The reason for this particular wording is to
- ;; construct a readable message "No references for LSP identifier at
- ;; point.". See http://github.com/joaotavora/eglot/issues/314
- "LSP identifier at point.")
-
-(defvar eglot--lsp-xref-refs nil
- "`xref' objects for overriding `xref-backend-references''s.")
-
-(cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability)
- "Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY."
- (unless (eglot--server-capable
- (or capability
- (intern
- (format ":%sProvider"
- (cadr (split-string (symbol-name method)
- "/"))))))
- (eglot--error "Sorry, this server doesn't do %s" method))
- (let ((response
- (jsonrpc-request
- (eglot--current-server-or-lose)
- method (append (eglot--TextDocumentPositionParams) extra-params))))
- (eglot--collecting-xrefs (collect)
- (mapc
- (lambda (loc-or-loc-link)
- (let ((sym-name (symbol-name (symbol-at-point))))
- (eglot--dcase loc-or-loc-link
- (((LocationLink) targetUri targetSelectionRange)
- (collect (eglot--xref-make-match sym-name
- targetUri targetSelectionRange)))
- (((Location) uri range)
- (collect (eglot--xref-make-match sym-name
- uri range))))))
- (if (vectorp response) response (and response (list response)))))))
-
-(cl-defun eglot--lsp-xref-helper (method &key extra-params capability )
- "Helper for `eglot-find-declaration' & friends."
- (let ((eglot--lsp-xref-refs (eglot--lsp-xrefs-for-method
- method
- :extra-params extra-params
- :capability capability)))
- (if eglot--lsp-xref-refs
- (xref-find-references "LSP identifier at point.")
- (eglot--message "%s returned no references" method))))
-
-(defun eglot-find-declaration ()
- "Find declaration for SYM, the identifier at point."
- (interactive)
- (eglot--lsp-xref-helper :textDocument/declaration))
-
-(defun eglot-find-implementation ()
- "Find implementation for SYM, the identifier at point."
- (interactive)
- (eglot--lsp-xref-helper :textDocument/implementation))
-
-(defun eglot-find-typeDefinition ()
- "Find type definition for SYM, the identifier at point."
- (interactive)
- (eglot--lsp-xref-helper :textDocument/typeDefinition))
-
-(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) _identifier)
- (eglot--lsp-xrefs-for-method :textDocument/definition))
-
-(cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier)
- (or
- eglot--lsp-xref-refs
- (eglot--lsp-xrefs-for-method
- :textDocument/references :extra-params `(:context (:includeDeclaration t)))))
-
-(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
- (when (eglot--server-capable :workspaceSymbolProvider)
- (eglot--collecting-xrefs (collect)
- (mapc
- (eglot--lambda ((SymbolInformation) name location)
- (eglot--dbind ((Location) uri range) location
- (collect (eglot--xref-make-match name uri range))))
- (jsonrpc-request (eglot--current-server-or-lose)
- :workspace/symbol
- `(:query ,pattern))))))
-
-(defun eglot-format-buffer ()
- "Format contents of current buffer."
- (interactive)
- (eglot-format nil nil))
-
-(defun eglot-format (&optional beg end)
- "Format region BEG END.
-If either BEG or END is nil, format entire buffer.
-Interactively, format active region, or entire buffer if region
-is not active."
- (interactive (and (region-active-p) (list (region-beginning) (region-end))))
- (pcase-let ((`(,method ,cap ,args)
- (cond
- ((and beg end)
- `(:textDocument/rangeFormatting
- :documentRangeFormattingProvider
- (:range ,(list :start (eglot--pos-to-lsp-position beg)
- :end (eglot--pos-to-lsp-position end)))))
- (t
- '(:textDocument/formatting :documentFormattingProvider nil)))))
- (unless (eglot--server-capable cap)
- (eglot--error "Server can't format!"))
- (eglot--apply-text-edits
- (jsonrpc-request
- (eglot--current-server-or-lose)
- method
- (cl-list*
- :textDocument (eglot--TextDocumentIdentifier)
- :options (list :tabSize tab-width
- :insertSpaces (if indent-tabs-mode :json-false t))
- args)
- :deferred method))))
-
-(defun eglot-completion-at-point ()
- "EGLOT's `completion-at-point' function."
- ;; Commit logs for this function help understand what's going on.
- (when-let (completion-capability (eglot--server-capable :completionProvider))
- (let* ((server (eglot--current-server-or-lose))
- (sort-completions
- (lambda (completions)
- (cl-sort completions
- #'string-lessp
- :key (lambda (c)
- (or (plist-get
- (get-text-property 0 'eglot--lsp-item c)
- :sortText)
- "")))))
- (metadata `(metadata (category . eglot)
- (display-sort-function . ,sort-completions)))
- resp items (cached-proxies :none)
- (proxies
- (lambda ()
- (if (listp cached-proxies) cached-proxies
- (setq resp
- (jsonrpc-request server
- :textDocument/completion
- (eglot--CompletionParams)
- :deferred :textDocument/completion
- :cancel-on-input t))
- (setq items (append
- (if (vectorp resp) resp (plist-get resp :items))
- nil))
- (setq cached-proxies
- (mapcar
- (jsonrpc-lambda
- (&rest item &key label insertText insertTextFormat
- &allow-other-keys)
- (let ((proxy
- (cond ((and (eql insertTextFormat 2)
- (eglot--snippet-expansion-fn))
- (string-trim-left label))
- ((and insertText
- (not (string-empty-p insertText)))
- insertText)
- (t
- (string-trim-left label)))))
- (unless (zerop (length proxy))
- (put-text-property 0 1 'eglot--lsp-item item proxy))
- proxy))
- items)))))
- (resolved (make-hash-table))
- (resolve-maybe
- ;; Maybe completion/resolve JSON object `lsp-comp' into
- ;; another JSON object, if at all possible. Otherwise,
- ;; just return lsp-comp.
- (lambda (lsp-comp)
- (or (gethash lsp-comp resolved)
- (setf (gethash lsp-comp resolved)
- (if (and (eglot--server-capable :completionProvider
- :resolveProvider)
- (plist-get lsp-comp :data))
- (jsonrpc-request server :completionItem/resolve
- lsp-comp :cancel-on-input t)
- lsp-comp)))))
- (bounds (bounds-of-thing-at-point 'symbol)))
- (list
- (or (car bounds) (point))
- (or (cdr bounds) (point))
- (lambda (probe pred action)
- (cond
- ((eq action 'metadata) metadata) ; metadata
- ((eq action 'lambda) ; test-completion
- (test-completion probe (funcall proxies)))
- ((eq (car-safe action) 'boundaries) nil) ; boundaries
- ((null action) ; try-completion
- (try-completion probe (funcall proxies)))
- ((eq action t) ; all-completions
- (all-completions
- ""
- (funcall proxies)
- (lambda (proxy)
- (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
- (filterText (plist-get item :filterText)))
- (and (or (null pred) (funcall pred proxy))
- (string-prefix-p
- probe (or filterText proxy) completion-ignore-case))))))))
- :annotation-function
- (lambda (proxy)
- (eglot--dbind ((CompletionItem) detail kind)
- (get-text-property 0 'eglot--lsp-item proxy)
- (let* ((detail (and (stringp detail)
- (not (string= detail ""))
- detail))
- (annotation
- (or detail
- (cdr (assoc kind eglot--kind-names)))))
- (when annotation
- (concat " "
- (propertize annotation
- 'face 'font-lock-function-name-face))))))
- :company-kind
- ;; Associate each lsp-item with a lsp-kind symbol.
- (lambda (proxy)
- (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))
- (kind (alist-get (plist-get lsp-item :kind)
- eglot--kind-names)))
- (intern (downcase kind))))
- :company-doc-buffer
- (lambda (proxy)
- (let* ((documentation
- (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)))
- (plist-get (funcall resolve-maybe lsp-comp) :documentation)))
- (formatted (and documentation
- (eglot--format-markup documentation))))
- (when formatted
- (with-current-buffer (get-buffer-create " *eglot doc*")
- (erase-buffer)
- (insert formatted)
- (current-buffer)))))
- :company-require-match 'never
- :company-prefix-length
- (save-excursion
- (when (car bounds) (goto-char (car bounds)))
- (when (listp completion-capability)
- (looking-back
- (regexp-opt
- (cl-coerce (cl-getf completion-capability :triggerCharacters) 'list))
- (line-beginning-position))))
- :exit-function
- (lambda (proxy status)
- (when (eq status 'finished)
- ;; To assist in using this whole `completion-at-point'
- ;; function inside `completion-in-region', ensure the exit
- ;; function runs in the buffer where the completion was
- ;; triggered from. This should probably be in Emacs itself.
- ;; (github#505)
- (with-current-buffer (if (minibufferp)
- (window-buffer (minibuffer-selected-window))
- (current-buffer))
- (eglot--dbind ((CompletionItem) insertTextFormat
- insertText textEdit additionalTextEdits label)
- (funcall
- resolve-maybe
- (or (get-text-property 0 'eglot--lsp-item proxy)
- ;; When selecting from the *Completions*
- ;; buffer, `proxy' won't have any properties.
- ;; A lookup should fix that (github#148)
- (get-text-property
- 0 'eglot--lsp-item
- (cl-find proxy (funcall proxies) :test #'string=))))
- (let ((snippet-fn (and (eql insertTextFormat 2)
- (eglot--snippet-expansion-fn))))
- (cond (textEdit
- ;; Undo (yes, undo) the newly inserted completion.
- ;; If before completion the buffer was "foo.b" and
- ;; now is "foo.bar", `proxy' will be "bar". We
- ;; want to delete only "ar" (`proxy' minus the
- ;; symbol whose bounds we've calculated before)
- ;; (github#160).
- (delete-region (+ (- (point) (length proxy))
- (if bounds
- (- (cdr bounds) (car bounds))
- 0))
- (point))
- (eglot--dbind ((TextEdit) range newText) textEdit
- (pcase-let ((`(,beg . ,end)
- (eglot--range-region range)))
- (delete-region beg end)
- (goto-char beg)
- (funcall (or snippet-fn #'insert) newText)))
- (when (cl-plusp (length additionalTextEdits))
- (eglot--apply-text-edits additionalTextEdits)))
- (snippet-fn
- ;; A snippet should be inserted, but using plain
- ;; `insertText'. This requires us to delete the
- ;; whole completion, since `insertText' is the full
- ;; completion's text.
- (delete-region (- (point) (length proxy)) (point))
- (funcall snippet-fn (or insertText label)))))
- (eglot--signal-textDocument/didChange)
- (eldoc)))))))))
-
-(defun eglot--hover-info (contents &optional range)
- (let ((heading (and range (pcase-let ((`(,beg . ,end) (eglot--range-region range)))
- (concat (buffer-substring beg end) ": "))))
- (body (mapconcat #'eglot--format-markup
- (if (vectorp contents) contents (list contents)) "\n")))
- (when (or heading (cl-plusp (length body))) (concat heading body))))
-
-(defun eglot--sig-info (sigs active-sig sig-help-active-param)
- (cl-loop
- for (sig . moresigs) on (append sigs nil) for i from 0
- concat
- (eglot--dbind ((SignatureInformation) label documentation parameters activeParameter) sig
- (with-temp-buffer
- (save-excursion (insert label))
- (let ((active-param (or activeParameter sig-help-active-param))
- params-start params-end)
- ;; Ad-hoc attempt to parse label as <name>(<params>)
- (when (looking-at "\\([^(]+\\)(\\([^)]+\\))")
- (setq params-start (match-beginning 2) params-end (match-end 2))
- (add-face-text-property (match-beginning 1) (match-end 1)
- 'font-lock-function-name-face))
- (when (eql i active-sig)
- ;; Decide whether to add one-line-summary to signature line
- (when (and (stringp documentation)
- (string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)"
- documentation))
- (setq documentation (match-string 1 documentation))
- (unless (string-prefix-p (string-trim documentation) label)
- (goto-char (point-max))
- (insert ": " (eglot--format-markup documentation))))
- ;; Decide what to do with the active parameter...
- (when (and (eql i active-sig) active-param
- (< -1 active-param (length parameters)))
- (eglot--dbind ((ParameterInformation) label documentation)
- (aref parameters active-param)
- ;; ...perhaps highlight it in the formals list
- (when params-start
- (goto-char params-start)
- (pcase-let
- ((`(,beg ,end)
- (if (stringp label)
- (let ((case-fold-search nil))
- (and (re-search-forward
- (concat "\\<" (regexp-quote label) "\\>")
- params-end t)
- (list (match-beginning 0) (match-end 0))))
- (mapcar #'1+ (append label nil)))))
- (if (and beg end)
- (add-face-text-property
- beg end
- 'eldoc-highlight-function-argument))))
- ;; ...and/or maybe add its doc on a line by its own.
- (when documentation
- (goto-char (point-max))
- (insert "\n"
- (propertize
- (if (stringp label)
- label
- (apply #'buffer-substring (mapcar #'1+ label)))
- 'face 'eldoc-highlight-function-argument)
- ": " (eglot--format-markup documentation))))))
- (buffer-string))))
- when moresigs concat "\n"))
-
-(defun eglot-signature-eldoc-function (cb)
- "A member of `eldoc-documentation-functions', for signatures."
- (when (eglot--server-capable :signatureHelpProvider)
- (let ((buf (current-buffer)))
- (jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/signatureHelp (eglot--TextDocumentPositionParams)
- :success-fn
- (eglot--lambda ((SignatureHelp)
- signatures activeSignature activeParameter)
- (eglot--when-buffer-window buf
- (funcall cb
- (unless (seq-empty-p signatures)
- (eglot--sig-info signatures
- activeSignature
- activeParameter)))))
- :deferred :textDocument/signatureHelp))
- t))
-
-(defun eglot-hover-eldoc-function (cb)
- "A member of `eldoc-documentation-functions', for hover."
- (when (eglot--server-capable :hoverProvider)
- (let ((buf (current-buffer)))
- (jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/hover (eglot--TextDocumentPositionParams)
- :success-fn (eglot--lambda ((Hover) contents range)
- (eglot--when-buffer-window buf
- (let ((info (unless (seq-empty-p contents)
- (eglot--hover-info contents range))))
- (funcall cb info :buffer t))))
- :deferred :textDocument/hover))
- (eglot--highlight-piggyback cb)
- t))
-
-(defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.")
-
-(defun eglot--highlight-piggyback (_cb)
- "Request and handle `:textDocument/documentHighlight'"
- ;; FIXME: Obviously, this is just piggy backing on eldoc's calls for
- ;; convenience, as shown by the fact that we just ignore cb.
- (let ((buf (current-buffer)))
- (when (eglot--server-capable :documentHighlightProvider)
- (jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/documentHighlight (eglot--TextDocumentPositionParams)
- :success-fn
- (lambda (highlights)
- (mapc #'delete-overlay eglot--highlights)
- (setq eglot--highlights
- (eglot--when-buffer-window buf
- (mapcar
- (eglot--lambda ((DocumentHighlight) range)
- (pcase-let ((`(,beg . ,end)
- (eglot--range-region range)))
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face 'eglot-highlight-symbol-face)
- (overlay-put ov 'modification-hooks
- `(,(lambda (o &rest _) (delete-overlay o))))
- ov)))
- highlights))))
- :deferred :textDocument/documentHighlight)
- nil)))
-
-(defun eglot-imenu ()
- "EGLOT's `imenu-create-index-function'."
- (cl-labels
- ((visit (_name one-obj-array)
- (imenu-default-goto-function
- nil (car (eglot--range-region
- (eglot--dcase (aref one-obj-array 0)
- (((SymbolInformation) location)
- (plist-get location :range))
- (((DocumentSymbol) selectionRange)
- selectionRange))))))
- (unfurl (obj)
- (eglot--dcase obj
- (((SymbolInformation)) (list obj))
- (((DocumentSymbol) name children)
- (cons obj
- (mapcar
- (lambda (c)
- (plist-put
- c :containerName
- (let ((existing (plist-get c :containerName)))
- (if existing (format "%s::%s" name existing)
- name))))
- (mapcan #'unfurl children)))))))
- (mapcar
- (pcase-lambda (`(,kind . ,objs))
- (cons
- (alist-get kind eglot--symbol-kind-names "Unknown")
- (mapcan (pcase-lambda (`(,container . ,objs))
- (let ((elems (mapcar (lambda (obj)
- (list (plist-get obj :name)
- `[,obj] ;; trick
- #'visit))
- objs)))
- (if container (list (cons container elems)) elems)))
- (seq-group-by
- (lambda (e) (plist-get e :containerName)) objs))))
- (seq-group-by
- (lambda (obj) (plist-get obj :kind))
- (mapcan #'unfurl
- (jsonrpc-request (eglot--current-server-or-lose)
- :textDocument/documentSymbol
- `(:textDocument
- ,(eglot--TextDocumentIdentifier))
- :cancel-on-input non-essential))))))
-
-(defun eglot--apply-text-edits (edits &optional version)
- "Apply EDITS for current buffer if at VERSION, or if it's nil."
- (unless (or (not version) (equal version eglot--versioned-identifier))
- (jsonrpc-error "Edits on `%s' require version %d, you have %d"
- (current-buffer) version eglot--versioned-identifier))
- (atomic-change-group
- (let* ((change-group (prepare-change-group))
- (howmany (length edits))
- (reporter (make-progress-reporter
- (format "[eglot] applying %s edits to `%s'..."
- howmany (current-buffer))
- 0 howmany))
- (done 0))
- (mapc (pcase-lambda (`(,newText ,beg . ,end))
- (let ((source (current-buffer)))
- (with-temp-buffer
- (insert newText)
- (let ((temp (current-buffer)))
- (with-current-buffer source
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
-
- ;; On emacs versions < 26.2,
- ;; `replace-buffer-contents' is buggy - it calls
- ;; change functions with invalid arguments - so we
- ;; manually call the change functions here.
- ;;
- ;; See emacs bugs #32237, #32278:
- ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237
- ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278
- (let ((inhibit-modification-hooks t)
- (length (- end beg))
- (beg (marker-position beg))
- (end (marker-position end)))
- (run-hook-with-args 'before-change-functions
- beg end)
- (replace-buffer-contents temp)
- (run-hook-with-args 'after-change-functions
- beg (+ beg (length newText))
- length))))
- (progress-reporter-update reporter (cl-incf done)))))))
- (mapcar (eglot--lambda ((TextEdit) range newText)
- (cons newText (eglot--range-region range 'markers)))
- (reverse edits)))
- (undo-amalgamate-change-group change-group)
- (progress-reporter-done reporter))))
-
-(defun eglot--apply-workspace-edit (wedit &optional confirm)
- "Apply the workspace edit WEDIT. If CONFIRM, ask user first."
- (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit
- (let ((prepared
- (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits)
- (eglot--dbind ((VersionedTextDocumentIdentifier) uri version)
- textDocument
- (list (eglot--uri-to-path uri) edits version)))
- documentChanges)))
- (cl-loop for (uri edits) on changes by #'cddr
- do (push (list (eglot--uri-to-path uri) edits) prepared))
- (if (or confirm
- (cl-notevery #'find-buffer-visiting
- (mapcar #'car prepared)))
- (unless (y-or-n-p
- (format "[eglot] Server wants to edit:\n %s\n Proceed? "
- (mapconcat #'identity (mapcar #'car prepared) "\n ")))
- (eglot--error "User cancelled server edit")))
- (cl-loop for edit in prepared
- for (path edits version) = edit
- do (with-current-buffer (find-file-noselect path)
- (eglot--apply-text-edits edits version))
- finally (eldoc) (eglot--message "Edit successful!")))))
-
-(defun eglot-rename (newname)
- "Rename the current symbol to NEWNAME."
- (interactive
- (list (read-from-minibuffer (format "Rename `%s' to: " (symbol-at-point))
- nil nil nil nil
- (symbol-name (symbol-at-point)))))
- (unless (eglot--server-capable :renameProvider)
- (eglot--error "Server can't rename!"))
- (eglot--apply-workspace-edit
- (jsonrpc-request (eglot--current-server-or-lose)
- :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
- :newName ,newname))
- current-prefix-arg))
-
-(defun eglot--region-bounds () "Region bounds if active, else point and nil."
- (if (use-region-p) `(,(region-beginning) ,(region-end)) `(,(point) nil)))
-
-(defun eglot-code-actions (beg &optional end action-kind)
- "Offer to execute actions of ACTION-KIND between BEG and END.
-If ACTION-KIND is nil, consider all kinds of actions.
-Interactively, default BEG and END to region's bounds else BEG is
-point and END is nil, which results in a request for code actions
-at point. With prefix argument, prompt for ACTION-KIND."
- (interactive
- `(,@(eglot--region-bounds)
- ,(and current-prefix-arg
- (completing-read "[eglot] Action kind: "
- '("quickfix" "refactor.extract" "refactor.inline"
- "refactor.rewrite" "source.organizeImports")))))
- (unless (eglot--server-capable :codeActionProvider)
- (eglot--error "Server can't execute code actions!"))
- (let* ((server (eglot--current-server-or-lose))
- (actions
- (jsonrpc-request
- server
- :textDocument/codeAction
- (list :textDocument (eglot--TextDocumentIdentifier)
- :range (list :start (eglot--pos-to-lsp-position beg)
- :end (eglot--pos-to-lsp-position end))
- :context
- `(:diagnostics
- [,@(cl-loop for diag in (flymake-diagnostics beg end)
- when (cdr (assoc 'eglot-lsp-diag
- (eglot--diag-data diag)))
- collect it)]
- ,@(when action-kind `(:only [,action-kind]))))
- :deferred t))
- (menu-items
- (or (cl-loop for action across actions
- ;; Do filtering ourselves, in case the `:only'
- ;; didn't go through.
- when (or (not action-kind)
- (equal action-kind (plist-get action :kind)))
- collect (cons (plist-get action :title) action))
- (apply #'eglot--error
- (if action-kind `("No \"%s\" code actions here" ,action-kind)
- `("No code actions here")))))
- (preferred-action (cl-find-if
- (lambda (menu-item)
- (plist-get (cdr menu-item) :isPreferred))
- menu-items))
- (default-action (car (or preferred-action (car menu-items))))
- (action (if (and action-kind (null (cadr menu-items)))
- (cdr (car menu-items))
- (if (listp last-nonmenu-event)
- (x-popup-menu last-nonmenu-event `("Eglot code actions:"
- ("dummy" ,@menu-items)))
- (cdr (assoc (completing-read
- (format "[eglot] Pick an action (default %s): "
- default-action)
- menu-items nil t nil nil default-action)
- menu-items))))))
- (eglot--dcase action
- (((Command) command arguments)
- (eglot-execute-command server (intern command) arguments))
- (((CodeAction) edit command)
- (when edit (eglot--apply-workspace-edit edit))
- (when command
- (eglot--dbind ((Command) command arguments) command
- (eglot-execute-command server (intern command) arguments)))))))
-
-(defmacro eglot--code-action (name kind)
- "Define NAME to execute KIND code action."
- `(defun ,name (beg &optional end)
- ,(format "Execute '%s' code actions between BEG and END." kind)
- (interactive (eglot--region-bounds))
- (eglot-code-actions beg end ,kind)))
-
-(eglot--code-action eglot-code-action-organize-imports "source.organizeImports")
-(eglot--code-action eglot-code-action-extract "refactor.extract")
-(eglot--code-action eglot-code-action-inline "refactor.inline")
-(eglot--code-action eglot-code-action-rewrite "refactor.rewrite")
-(eglot--code-action eglot-code-action-quickfix "quickfix")
-
-
-;;; Dynamic registration
-;;;
-(cl-defmethod eglot-register-capability
- (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers)
- "Handle dynamic registration of workspace/didChangeWatchedFiles"
- (eglot-unregister-capability server method id)
- (let* (success
- (globs (mapcar
- (eglot--lambda ((FileSystemWatcher) globPattern)
- (eglot--glob-compile globPattern t t))
- watchers))
- (dirs-to-watch
- (delete-dups (mapcar #'file-name-directory
- (project-files
- (eglot--project server))))))
- (cl-labels
- ((handle-event
- (event)
- (pcase-let ((`(,desc ,action ,file ,file1) event))
- (cond
- ((and (memq action '(created changed deleted))
- (cl-find file globs :test (lambda (f g) (funcall g f))))
- (jsonrpc-notify
- server :workspace/didChangeWatchedFiles
- `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
- :type ,(cl-case action
- (created 1)
- (changed 2)
- (deleted 3)))))))
- ((eq action 'renamed)
- (handle-event `(,desc 'deleted ,file))
- (handle-event `(,desc 'created ,file1)))))))
- (unwind-protect
- (progn
- (dolist (dir dirs-to-watch)
- (push (file-notify-add-watch dir '(change) #'handle-event)
- (gethash id (eglot--file-watches server))))
- (setq
- success
- `(:message ,(format "OK, watching %s directories in %s watchers"
- (length dirs-to-watch) (length watchers)))))
- (unless success
- (eglot-unregister-capability server method id))))))
-
-(cl-defmethod eglot-unregister-capability
- (server (_method (eql workspace/didChangeWatchedFiles)) id)
- "Handle dynamic unregistration of workspace/didChangeWatchedFiles"
- (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches server)))
- (remhash id (eglot--file-watches server))
- (list t "OK"))
-
-
-;;; Glob heroics
-;;;
-(defun eglot--glob-parse (glob)
- "Compute list of (STATE-SYM EMITTER-FN PATTERN)."
- (with-temp-buffer
- (save-excursion (insert glob))
- (cl-loop
- with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**)
- (:* "\\*" eglot--glob-emit-*)
- (:? "\\?" eglot--glob-emit-?)
- (:{} "{[^][*{}]+}" eglot--glob-emit-{})
- (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range)
- (:literal "[^][,*?{}]+" eglot--glob-emit-self))
- until (eobp)
- collect (cl-loop
- for (_token regexp emitter) in grammar
- thereis (and (re-search-forward (concat "\\=" regexp) nil t)
- (list (cl-gensym "state-") emitter (match-string 0)))
- finally (error "Glob '%s' invalid at %s" (buffer-string) (point))))))
-
-(defun eglot--glob-compile (glob &optional byte-compile noerror)
- "Convert GLOB into Elisp function. Maybe BYTE-COMPILE it.
-If NOERROR, return predicate, else erroring function."
- (let* ((states (eglot--glob-parse glob))
- (body `(with-current-buffer (get-buffer-create " *eglot-glob-matcher*")
- (erase-buffer)
- (save-excursion (insert string))
- (cl-labels ,(cl-loop for (this that) on states
- for (self emit text) = this
- for next = (or (car that) 'eobp)
- collect (funcall emit text self next))
- (or (,(caar states))
- (error "Glob done but more unmatched text: '%s'"
- (buffer-substring (point) (point-max)))))))
- (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body))))
- (if byte-compile (byte-compile form) form)))
-
-(defun eglot--glob-emit-self (text self next)
- `(,self () (re-search-forward ,(concat "\\=" (regexp-quote text))) (,next)))
-
-(defun eglot--glob-emit-** (_ self next)
- `(,self () (or (ignore-errors (save-excursion (,next)))
- (and (re-search-forward "\\=/?[^/]+/?") (,self)))))
-
-(defun eglot--glob-emit-* (_ self next)
- `(,self () (re-search-forward "\\=[^/]")
- (or (ignore-errors (save-excursion (,next))) (,self))))
-
-(defun eglot--glob-emit-? (_ self next)
- `(,self () (re-search-forward "\\=[^/]") (,next)))
-
-(defun eglot--glob-emit-{} (arg self next)
- (let ((alternatives (split-string (substring arg 1 (1- (length arg))) ",")))
- `(,self ()
- (or ,@(cl-loop for alt in alternatives
- collect `(re-search-forward ,(concat "\\=" alt) nil t))
- (error "Failed matching any of %s" ',alternatives))
- (,next))))
-
-(defun eglot--glob-emit-range (arg self next)
- (when (eq ?! (aref arg 1)) (aset arg 1 ?^))
- `(,self () (re-search-forward ,(concat "\\=" arg)) (,next)))
-
-
-;;; Rust-specific
-;;;
-(defclass eglot-rls (eglot-lsp-server) () :documentation "Rustlang's RLS.")
-
-(cl-defmethod jsonrpc-connection-ready-p ((server eglot-rls) what)
- "Except for :completion, RLS isn't ready until Indexing done."
- (and (cl-call-next-method)
- (or ;; RLS normally ready for this, even if building.
- (eq :textDocument/completion what)
- (pcase-let ((`(,_id ,what ,done ,_detail) (eglot--spinner server)))
- (and (equal "Indexing" what) done)))))
-
-(cl-defmethod eglot-handle-notification
- ((server eglot-rls) (_method (eql window/progress))
- &key id done title message &allow-other-keys)
- "Handle notification window/progress"
- (setf (eglot--spinner server) (list id title done message)))
-
-
-;;; eclipse-jdt-specific
-;;;
-(defclass eglot-eclipse-jdt (eglot-lsp-server) ()
- :documentation "Eclipse's Java Development Tools Language Server.")
-
-(cl-defmethod eglot-initialization-options ((server eglot-eclipse-jdt))
- "Passes through required jdt initialization options"
- `(:workspaceFolders
- [,@(cl-delete-duplicates
- (mapcar #'eglot--path-to-uri
- (let* ((root (project-root (eglot--project server))))
- (cons root
- (mapcar
- #'file-name-directory
- (append
- (file-expand-wildcards (concat root "*/pom.xml"))
- (file-expand-wildcards (concat root "*/build.gradle"))
- (file-expand-wildcards (concat root "*/.project")))))))
- :test #'string=)]
- ,@(if-let ((home (or (getenv "JAVA_HOME")
- (ignore-errors
- (expand-file-name
- ".."
- (file-name-directory
- (file-chase-links (executable-find "javac"))))))))
- `(:settings (:java (:home ,home)))
- (ignore (eglot--warn "JAVA_HOME env var not set")))))
-
-(defun eglot--eclipse-jdt-contact (interactive)
- "Return a contact for connecting to eclipse.jdt.ls server, as a cons cell.
-If INTERACTIVE, prompt user for details."
- (cl-labels
- ((is-the-jar
- (path)
- (and (string-match-p
- "org\\.eclipse\\.equinox\\.launcher_.*\\.jar$"
- (file-name-nondirectory path))
- (file-exists-p path))))
- (let* ((classpath (or (getenv "CLASSPATH") path-separator))
- (cp-jar (cl-find-if #'is-the-jar (split-string classpath path-separator)))
- (jar cp-jar)
- (dir
- (cond
- (jar (file-name-as-directory
- (expand-file-name ".." (file-name-directory jar))))
- (interactive
- (expand-file-name
- (read-directory-name
- (concat "Path to eclipse.jdt.ls directory (could not"
- " find it in CLASSPATH): ")
- nil nil t)))
- (t (error "Could not find eclipse.jdt.ls jar in CLASSPATH"))))
- (repodir
- (concat dir
- "org.eclipse.jdt.ls.product/target/repository/"))
- (repodir (if (file-directory-p repodir) repodir dir))
- (config
- (concat
- repodir
- (cond
- ((string= system-type "darwin") "config_mac")
- ((string= system-type "windows-nt") "config_win")
- (t "config_linux"))))
- (workspace
- (expand-file-name (md5 (project-root (eglot--current-project)))
- (concat user-emacs-directory
- "eglot-eclipse-jdt-cache"))))
- (unless jar
- (setq jar
- (cl-find-if #'is-the-jar
- (directory-files (concat repodir "plugins") t))))
- (unless (and jar (file-exists-p jar) (file-directory-p config))
- (error "Could not find required eclipse.jdt.ls files (build required?)"))
- (when (and interactive (not cp-jar)
- (y-or-n-p (concat "Add path to the server program "
- "to CLASSPATH environment variable?")))
- (setenv "CLASSPATH" (concat (getenv "CLASSPATH") path-separator jar)))
- (unless (file-directory-p workspace)
- (make-directory workspace t))
- (cons 'eglot-eclipse-jdt
- (list (executable-find "java")
- "-Declipse.application=org.eclipse.jdt.ls.core.id1"
- "-Dosgi.bundles.defaultStartLevel=4"
- "-Declipse.product=org.eclipse.jdt.ls.core.product"
- "-jar" jar
- "-configuration" config
- "-data" workspace)))))
-
-(cl-defmethod eglot-execute-command
- ((_server eglot-eclipse-jdt) (_cmd (eql java.apply.workspaceEdit)) arguments)
- "Eclipse JDT breaks spec and replies with edits as arguments."
- (mapc #'eglot--apply-workspace-edit arguments))
-
-(provide 'eglot)
-;;; eglot.el ends here
-
-;; Local Variables:
-;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"
-;; bug-reference-url-format: "https://github.com/joaotavora/eglot/issues/%s"
-;; checkdoc-force-docstrings-flag: nil
-;; End:
diff --git a/elpa/eglot-20211116.823/eglot.elc b/elpa/eglot-20211116.823/eglot.elc
Binary files differ.
diff --git a/elpa/marginalia-0.10.signed b/elpa/marginalia-0.10.signed
@@ -1 +0,0 @@
-Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2021-11-14T23:05:02+0100 using RSA
-\ No newline at end of file
diff --git a/elpa/marginalia-0.10/LICENSE b/elpa/marginalia-0.10/LICENSE
@@ -1,674 +0,0 @@
- 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/marginalia-0.10/README.org b/elpa/marginalia-0.10/README.org
@@ -1,193 +0,0 @@
-#+title: marginalia.el - Marginalia in the minibuffer
-#+author: Omar Antolín Camarena, Daniel Mendler
-#+language: en
-#+export_file_name: marginalia.texi
-#+texinfo_dir_category: Emacs
-#+texinfo_dir_title: Marginalia: (marginalia).
-#+texinfo_dir_desc: Marginalia in the minibuffer
-
-#+html: <a href="http://elpa.gnu.org/packages/marginalia.html"><img alt="GNU ELPA" src="https://elpa.gnu.org/packages/marginalia.svg"/></a>
-#+html: <a href="http://elpa.gnu.org/devel/marginalia.html"><img alt="GNU-devel ELPA" src="https://elpa.gnu.org/devel/marginalia.svg"/></a>
-#+html: <a href="https://melpa.org/#/marginalia"><img alt="MELPA" src="https://melpa.org/packages/marginalia-badge.svg"/></a>
-#+html: <a href="https://stable.melpa.org/#/marginalia"><img alt="MELPA Stable" src="https://stable.melpa.org/packages/marginalia-badge.svg"/></a>
-
-* Introduction
-
-#+html: <img src="https://upload.wikimedia.org/wikipedia/commons/4/4f/Marginalia_%285095211566%29.jpg" align="right" width="30%">
-
-This package provides =marginalia-mode= which adds marginalia to the
-minibuffer completions.
-[[https://en.wikipedia.org/wiki/Marginalia][Marginalia]] are marks or
-annotations placed at the margin of the page of a book or in this case
-helpful colorful annotations placed at the margin of the minibuffer for
-your completion candidates. Marginalia can only add annotations to be
-displayed with the completion candidates. It cannot modify the
-appearance of the candidates themselves, which are shown as supplied by
-the original commands.
-
-The annotations are added based on the completion category. For example
-=find-file= reports the =file= category and =M-x= reports the =command= category. You
-can cycle between more or less detailed annotators or even disable the annotator
-with command =marginalia-cycle=.
-
-#+html: <img src="https://github.com/minad/marginalia/blob/main/marginalia-mode.png?raw=true">
-
-* Configuration
-
-It is recommended to use Marginalia together with either the [[https://github.com/raxod502/selectrum][Selectrum]], [[https://github.com/minad/vertico][Vertico]]
-or the [[https://github.com/oantolin/icomplete-vertical][Icomplete-vertical]] completion system. Furthermore Marginalia can be
-combined with [[https://github.com/oantolin/embark][Embark]] for action support and [[https://github.com/minad/consult][Consult]], which provides many useful
-commands.
-
-#+begin_src emacs-lisp
-;; Enable richer annotations using the Marginalia package
-(use-package marginalia
- ;; Either bind `marginalia-cycle` globally or only in the minibuffer
- :bind (("M-A" . marginalia-cycle)
- :map minibuffer-local-map
- ("M-A" . marginalia-cycle))
-
- ;; The :init configuration is always executed (Not lazy!)
- :init
-
- ;; Must be in the :init section of use-package such that the mode gets
- ;; enabled right away. Note that this forces loading the package.
- (marginalia-mode))
-#+end_src
-
-* Information shown by the annotators
-
-In general, to learn more about what different annotations mean, a good starting
-point is to look at ~marginalia-annotator-registry~, and follow up to the
-annotation function of the category you are interested in.
-
-For example the annotations for elisp symbols include their symbol class - v for
-variable, f for function, c for command, etc. For more information on what the
-different classifications mean, see the docstring of ~marginalia--symbol-class~.
-
-* Adding custom annotators or classifiers
-
-Commands that support minibuffer completion use a completion table of all the
-available candidates. Candidates are associated with a *category* such as =command=,
-=file=, =face=, or =variable= depending on what the candidates are. Based on the
-category of the candidates, Marginalia selects an *annotator* to generate
-annotations for display for each candidate.
-
-Unfortunately, not all commands (including Emacs' builtin ones) specify the
-category of their candidates. To compensate for this shortcoming, Marginalia
-hooks into the emacs completion framework and runs the *classifiers* listed in the
-variable =marginalia-classifiers=, which use the command's prompt or other
-properties of the candidates to specify the completion category.
-
-For example, the =marginalia-classify-by-prompt= classifier checks the minibuffer
-prompt against regexps listed in the =marginalia-prompt-categories= alist to
-determine a category. The following is already included but would be a way to
-assign the category =face= to all candidates from commands with prompts that
-include the word "face".
-
-#+begin_src emacs-lisp
- (add-to-list 'marginalia-prompt-categories '("\\<face\\>" . face))
-#+end_src
-
-The =marginalia-classify-by-command-name= classifier uses the alist
-=marginalia-command-categories= to specify the completion category based on the
-command name. This is particularily useful if the prompt classifier yields a
-false positive.
-
-Completion categories are also important for [[https://github.com/oantolin/embark][Embark]], which associates actions
-based on the completion category and benefits from Marginalia's classifiers.
-
-Once the category of the candidates is known, Marginalia looks in the
-=marginalia-annotator-registry= to find the associated annotator to use. An
-annotator is a function that takes a completion candidate string as an argument
-and returns an annotation string to be displayed after the candidate in the
-minibuffer. More than one annotator can be assigned to each each category,
-displaying more, less or different information. Use the =marginalia-cycle= command
-to cycle between the annotations of different annotators defined for the current
-category.
-
-Here's an example of a basic face annotator:
-
-#+begin_src emacs-lisp
- (defun my-face-annotator (cand)
- (when-let (sym (intern-soft cand))
- (concat (propertize " " 'display '(space :align-to center))
- (propertize "The quick brown fox jumps over the lazy dog" 'face sym))))
-#+end_src
-
-Look at Marginalia's various annotators for examples of formating annotations.
-In particular, the helper function =marginalia--fields= can be used to format
-information into columns.
-
-After defining a new annotator, associate it with a category in the annotator
-registry as follows:
-
-#+begin_src emacs-lisp
- (add-to-list 'marginalia-annotator-registry
- '(face my-face-annotator marginalia-annotate-face builtin none))
-#+end_src
-
-This makes the =my-face-annotator= the first of four annotators for the face
-category. The others are the annotator provided by Marginalia
-(=marginalia-annotate-face=), the =builtin= annotator as defined by Emacs and the
-=none= annotator, which disables the annotations. With this setting, after
-invoking =M-x describe-face RET= you can cycle between all of these annotators
-using =marginalia-cycle=.
-
-* Disabling annotators, builtin or lightweight annotators
-
-Marginalia activates rich annotators by default. Depending on your preference
-you may want to use the builtin annotators or even no annotators by default and
-only activate the annotators on demand by invoking ~marginalia-cycle~.
-
-In order to use the builtin annotators by default, you can use the following
-command. Replace =builtin= by =none= to disable annotators by default.
-
-#+begin_src emacs-lisp
- (defun marginalia-use-builtin ()
- (interactive)
- (mapc
- (lambda (x)
- (setcdr x (cons 'builtin (remq 'builtin (cdr x)))))
- marginalia-annotator-registry))
-#+end_src
-
-If a completion category supports two annotators, you can toggle between
-those using this command.
-
-#+begin_src emacs-lisp
- (defun marginalia-toggle ()
- (interactive)
- (mapc
- (lambda (x)
- (setcdr x (append (reverse (remq 'none
- (remq 'builtin (cdr x))))
- '(builtin none))))
- marginalia-annotator-registry))
-#+end_src
-
-After cycling the annotators you may want to automatically save the
-configuration. This can be achieved using an advice which calls
-~customize-save-variable~.
-
-#+begin_src emacs-lisp
- (advice-add #'marginalia-cycle :after
- (lambda ()
- (let ((inhibit-message t))
- (customize-save-variable 'marginalia-annotator-registry
- marginalia-annotator-registry))))
-#+end_src
-
-In order to disable an annotator permanently, the ~marginalia-annotator-registry~
-can be modified. For example if you prefer to never see file annotations, you
-can delete all file annotators from the registry.
-
-#+begin_src emacs-lisp
- (setq marginalia-annotator-registry
- (assq-delete-all 'file marginalia-annotator-registry))
-#+end_src
-
-* Contributions
-
-Since this package is part of [[http://elpa.gnu.org/packages/marginalia.html][GNU ELPA]] contributions require a copyright
-assignment to the FSF.
diff --git a/elpa/marginalia-0.10/dir b/elpa/marginalia-0.10/dir
@@ -1,18 +0,0 @@
-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
-* Marginalia: (marginalia). Marginalia in the minibuffer.
diff --git a/elpa/marginalia-0.10/marginalia-autoloads.el b/elpa/marginalia-0.10/marginalia-autoloads.el
@@ -1,49 +0,0 @@
-;;; marginalia-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-
-;;;### (autoloads nil "marginalia" "marginalia.el" (0 0 0 0))
-;;; Generated autoloads from marginalia.el
-
-(defvar marginalia-mode nil "\
-Non-nil if Marginalia mode is enabled.
-See the `marginalia-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `marginalia-mode'.")
-
-(custom-autoload 'marginalia-mode "marginalia" nil)
-
-(autoload 'marginalia-mode "marginalia" "\
-Annotate completion candidates with richer information.
-
-If called interactively, enable Marginalia mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'marginalia-cycle "marginalia" "\
-Cycle between annotators in `marginalia-annotator-registry'." t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "marginalia" '("marginalia-")))
-
-;;;***
-
-;;;### (autoloads nil nil ("marginalia-pkg.el") (0 0 0 0))
-
-;;;***
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; marginalia-autoloads.el ends here
diff --git a/elpa/marginalia-0.10/marginalia-mode.png b/elpa/marginalia-0.10/marginalia-mode.png
Binary files differ.
diff --git a/elpa/marginalia-0.10/marginalia-pkg.el b/elpa/marginalia-0.10/marginalia-pkg.el
@@ -1,2 +0,0 @@
-;; Generated package description from marginalia.el -*- no-byte-compile: t -*-
-(define-package "marginalia" "0.10" "Enrich existing commands with completion annotations" '((emacs "26.1")) :authors '(("Omar Antolín Camarena <omar@matem.unam.mx>, Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '("Omar Antolín Camarena <omar@matem.unam.mx>, Daniel Mendler" . "mail@daniel-mendler.de") :url "https://github.com/minad/marginalia")
diff --git a/elpa/marginalia-0.10/marginalia.el b/elpa/marginalia-0.10/marginalia.el
@@ -1,1112 +0,0 @@
-;;; marginalia.el --- Enrich existing commands with completion annotations -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Omar Antolín Camarena <omar@matem.unam.mx>, Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Omar Antolín Camarena <omar@matem.unam.mx>, Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2020
-;; Version: 0.10
-;; Package-Requires: ((emacs "26.1"))
-;; Homepage: https://github.com/minad/marginalia
-
-;; 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:
-
-;; Enrich existing commands with completion annotations
-
-;;; Code:
-
-(eval-when-compile
- (require 'subr-x)
- (require 'cl-lib))
-
-;;;; Customization
-
-(defgroup marginalia nil
- "Enrich existing commands with completion annotations."
- :group 'convenience
- :group 'minibuffer
- :prefix "marginalia-")
-
-(defcustom marginalia-truncate-width 80
- "Maximum truncation width of annotation fields.
-
-This value is adjusted depending on the `window-width'."
- :type 'integer)
-
-(defcustom marginalia-separator-threshold 160
- "Use wider separator for window widths larger than this value."
- :type 'integer)
-
-;; See https://github.com/minad/marginalia/issues/42 for the discussion
-;; regarding the alignment.
-(defcustom marginalia-align-offset nil
- "Additional offset at the right margin used by `marginalia--align'.
-
-This value should be set to nil to enable auto-configuration.
-It can also be set to an integer value of 1 or larger to force an offset."
- :type '(choice (const nil) integer))
-
-(defcustom marginalia-margin-min 8
- "Minimum whitespace margin at the right side."
- :type 'integer)
-
-(defcustom marginalia-margin-threshold 200
- "Use whitespace margin for window widths larger than this value."
- :type 'integer)
-
-(defcustom marginalia-max-relative-age (* 60 60 24 14)
- "Maximum relative age in seconds displayed by the file annotator.
-
-Set to `most-positive-fixnum' to always use a relative age, or 0 to never show a relative age."
- :type 'integer)
-
-(defcustom marginalia-annotator-registry
- (mapcar
- (lambda (x) (append x '(builtin none)))
- '((command marginalia-annotate-command marginalia-annotate-binding)
- (embark-keybinding marginalia-annotate-embark-keybinding)
- (customize-group marginalia-annotate-customize-group)
- (variable marginalia-annotate-variable)
- (function marginalia-annotate-function)
- (face marginalia-annotate-face)
- (color marginalia-annotate-color)
- (unicode-name marginalia-annotate-char)
- (minor-mode marginalia-annotate-minor-mode)
- (symbol marginalia-annotate-symbol)
- (environment-variable marginalia-annotate-environment-variable)
- (input-method marginalia-annotate-input-method)
- (coding-system marginalia-annotate-coding-system)
- (charset marginalia-annotate-charset)
- (package marginalia-annotate-package)
- (imenu marginalia-annotate-imenu)
- (bookmark marginalia-annotate-bookmark)
- (file marginalia-annotate-file)
- (project-file marginalia-annotate-project-file)
- (buffer marginalia-annotate-buffer)
- (consult-multi marginalia-annotate-consult-multi)))
- "Annotator function registry.
-Associates completion categories with annotation functions.
-Each annotation function must return a string,
-which is appended to the completion candidate."
- :type '(alist :key-type symbol :value-type (repeat symbol)))
-
-(defcustom marginalia-classifiers
- '(marginalia-classify-by-command-name
- marginalia-classify-original-category
- marginalia-classify-by-prompt
- marginalia-classify-symbol)
- "List of functions to determine current completion category.
-Each function should take no arguments and return a symbol
-indicating the category, or nil to indicate it could not
-determine it."
- :type 'hook)
-
-(defcustom marginalia-prompt-categories
- '(("\\<customize group\\>" . customize-group)
- ("\\<M-x\\>" . command)
- ("\\<package\\>" . package)
- ("\\<bookmark\\>" . bookmark)
- ("\\<color\\>" . color)
- ("\\<face\\>" . face)
- ("\\<environment variable\\>" . environment-variable)
- ("\\<function\\>" . function)
- ("\\<variable\\>" . variable)
- ("\\<input method\\>" . input-method)
- ("\\<charset\\>" . charset)
- ("\\<coding system\\>" . coding-system)
- ("\\<minor mode\\>" . minor-mode)
- ("\\<[Ll]ibrary\\>" . library))
- "Associates regexps to match against minibuffer prompts with categories."
- :type '(alist :key-type regexp :value-type symbol))
-
-(defcustom marginalia-censor-variables
- '("pass")
- "The values of variables matching any of these regular expressions is not shown."
- :type '(repeat (choice symbol regexp)))
-
-(defcustom marginalia-command-categories
- '((imenu . imenu))
- "Associate commands with a completion category."
- :type '(alist :key-type symbol :value-type symbol))
-
-(defcustom marginalia-bookmark-type-transformers
- (let ((words (regexp-opt '("handle" "handler" "jump" "bookmark"))))
- `((,(format "-+%s-+" words) . "-")
- (,(format "\\`%s-+" words) . "")
- (,(format "-%s\\'" words) . "")
- ("\\`default\\'" . "File")
- (".*" . ,#'capitalize)))
- "List of bookmark type transformers."
- :type '(alist :key-type regexp :value-type (choice string function)))
-
-(defgroup marginalia-faces nil
- "Faces used by `marginalia-mode'."
- :group 'marginalia
- :group 'faces)
-
-(defface marginalia-key
- '((t :inherit font-lock-keyword-face))
- "Face used to highlight keys.")
-
-(defface marginalia-type
- '((t :inherit marginalia-key))
- "Face used to highlight types.")
-
-(defface marginalia-char
- '((t :inherit marginalia-key))
- "Face used to highlight character annotations.")
-
-(defface marginalia-lighter
- '((t :inherit marginalia-size))
- "Face used to highlight minor mode lighters.")
-
-(defface marginalia-on
- '((t :inherit success))
- "Face used to signal enabled modes.")
-
-(defface marginalia-off
- '((t :inherit error))
- "Face used to signal disabled modes.")
-
-(defface marginalia-documentation
- '((t :inherit completions-annotations))
- "Face used to highlight documentation strings.")
-
-(defface marginalia-value
- '((t :inherit marginalia-key))
- "Face used to highlight general variable values.")
-
-(defface marginalia-null
- '((t :inherit font-lock-comment-face))
- "Face used to highlight null or unbound variable values.")
-
-(defface marginalia-true
- '((t :inherit font-lock-builtin-face))
- "Face used to highlight true variable values.")
-
-(defface marginalia-function
- '((t :inherit font-lock-function-name-face))
- "Face used to highlight function symbols.")
-
-(defface marginalia-symbol
- '((t :inherit font-lock-type-face))
- "Face used to highlight general symbols.")
-
-(defface marginalia-list
- '((t :inherit font-lock-constant-face))
- "Face used to highlight list expressions.")
-
-(defface marginalia-mode
- '((t :inherit marginalia-key))
- "Face used to highlight buffer major modes.")
-
-(defface marginalia-date
- '((t :inherit marginalia-key))
- "Face used to highlight dates.")
-
-(defface marginalia-version
- '((t :inherit marginalia-number))
- "Face used to highlight package versions.")
-
-(defface marginalia-archive
- '((t :inherit warning))
- "Face used to highlight package archives.")
-
-(defface marginalia-installed
- '((t :inherit success))
- "Face used to highlight the status of packages.")
-
-(defface marginalia-size
- '((t :inherit marginalia-number))
- "Face used to highlight sizes.")
-
-(defface marginalia-number
- '((t :inherit font-lock-constant-face))
- "Face used to highlight numeric values.")
-
-(defface marginalia-string
- '((t :inherit font-lock-string-face))
- "Face used to highlight string values.")
-
-(defface marginalia-modified
- '((t :inherit font-lock-negation-char-face))
- "Face used to highlight buffer modification indicators.")
-
-(defface marginalia-file-name
- '((t :inherit marginalia-documentation))
- "Face used to highlight file names.")
-
-(defface marginalia-file-owner
- '((t :inherit font-lock-preprocessor-face))
- "Face used to highlight file owner and group names.")
-
-(defface marginalia-file-priv-no
- '((t :inherit shadow))
- "Face used to highlight the no file privilege attribute.")
-
-(defface marginalia-file-priv-dir
- '((t :inherit font-lock-keyword-face))
- "Face used to highlight the dir file privilege attribute.")
-
-(defface marginalia-file-priv-link
- '((t :inherit font-lock-keyword-face))
- "Face used to highlight the link file privilege attribute.")
-
-(defface marginalia-file-priv-read
- '((t :inherit font-lock-type-face))
- "Face used to highlight the read file privilege attribute.")
-
-(defface marginalia-file-priv-write
- '((t :inherit font-lock-builtin-face))
- "Face used to highlight the write file privilege attribute.")
-
-(defface marginalia-file-priv-exec
- '((t :inherit font-lock-function-name-face))
- "Face used to highlight the exec file privilege attribute.")
-
-(defface marginalia-file-priv-other
- '((t :inherit font-lock-constant-face))
- "Face used to highlight some other file privilege attribute.")
-
-(defface marginalia-file-priv-rare
- '((t :inherit font-lock-variable-name-face))
- "Face used to highlight a rare file privilege attribute.")
-
-;;;; Pre-declarations for external packages
-
-(defvar bookmark-alist)
-(declare-function bookmark-get-handler "bookmark")
-(declare-function bookmark-get-filename "bookmark")
-(declare-function bookmark-get-front-context-string "bookmark")
-
-(defvar package--builtins)
-(defvar package-archive-contents)
-(declare-function package--from-builtin "package")
-(declare-function package-desc-archive "package")
-(declare-function package-desc-status "package")
-(declare-function package-desc-summary "package")
-(declare-function package-desc-version "package")
-(declare-function package-version-join "package")
-(declare-function project-current "project")
-
-(declare-function color-rgb-to-hex "color")
-(declare-function color-rgb-to-hsl "color")
-(declare-function color-hsl-to-rgb "color")
-
-(declare-function selectrum--get-full "ext:selectrum")
-
-;;;; Marginalia mode
-
-(defvar marginalia--fontified-file-modes nil
- "List of fontified file modes.")
-
-(defvar-local marginalia--cache nil
- "The cache, pair of list and hashtable.")
-
-(defvar marginalia--cache-size 100
- "Size of the cache, set to 0 to disable the cache.
-Disabling the cache is useful on non-incremental UIs like default completion or
-for performance profiling of the annotators.")
-
-(defvar marginalia--separator " "
- "Field separator.")
-
-(defvar marginalia--margin 0
- "Right margin.")
-
-(defvar-local marginalia--command nil
- "Last command symbol saved in order to allow annotations.")
-
-(defvar-local marginalia--base-position 0
- "Last completion base position saved to get full file paths.")
-
-(defvar marginalia--metadata nil
- "Completion metadata from the current completion.")
-
-(defun marginalia--truncate (str width)
- "Truncate string STR to WIDTH."
- (truncate-string-to-width
- (if-let (pos (string-match-p "\n" str))
- (substring str 0 pos)
- str)
- width 0 32 t))
-
-(defun marginalia--align (str)
- "Align STR at the right margin."
- (unless (string-blank-p str)
- (concat " "
- (propertize
- " "
- 'display
- `(space :align-to (- right ,marginalia--margin ,(string-width str))))
- str)))
-
-(cl-defmacro marginalia--field (field &key truncate format face width)
- "Format FIELD as a string according to some options.
-
-TRUNCATE is the truncation width.
-FORMAT is a format string. This must be used if the field value is not a string.
-FACE is the name of the face, with which the field should be propertized.
-WIDTH is the format width. This can be specified as alternative to FORMAT."
- (cl-assert (not (and width format)))
- (when width
- (setq field `(or ,field "")
- format (format "%%%ds" (- width))))
- (setq field (if format
- `(format ,format ,field)
- `(or ,field "")))
- (when truncate (setq field `(marginalia--truncate ,field ,truncate)))
- (when face (setq field `(propertize ,field 'face ,face)))
- field)
-
-(defmacro marginalia--fields (&rest fields)
- "Format annotation FIELDS as a string with separators in between."
- `(marginalia--align (concat ,@(cdr (mapcan (lambda (field)
- (list 'marginalia--separator `(marginalia--field ,@field)))
- fields)))))
-
-(defun marginalia--documentation (str)
- "Format documentation string STR."
- (when str
- (marginalia--fields
- (str :truncate marginalia-truncate-width :face 'marginalia-documentation))))
-
-(defun marginalia-annotate-binding (cand)
- "Annotate command CAND with keybinding."
- (when-let* ((sym (intern-soft cand))
- (key (and (commandp sym) (where-is-internal sym nil 'first-only))))
- (propertize (format " (%s)" (key-description key)) 'face 'marginalia-key)))
-
-(defun marginalia--annotator (cat)
- "Return annotation function for category CAT."
- (pcase (car (alist-get cat marginalia-annotator-registry))
- ('none (lambda (_) nil))
- ('builtin nil)
- (fun fun)))
-
-;; This annotator is consult-specific, it will annotate commands with `consult-multi' category
-(defun marginalia-annotate-consult-multi (cand)
- "Annotate consult-multi CAND with the buffer class."
- (if-let* ((multi (get-text-property 0 'consult-multi cand))
- (annotate (marginalia--annotator (car multi))))
- ;; Use the Marginalia annotator corresponding to the consult-multi category.
- (funcall annotate (cdr multi))
- ;; Apply the original annotation function on the original candidate, if there is one.
- ;; NOTE: Use `alist-get' instead of `completion-metadata-get' to bypass our
- ;; `marginalia--completion-metadata-get' advice!
- (when-let (annotate (alist-get 'annotation-function marginalia--metadata))
- (funcall annotate cand))))
-
-(defconst marginalia--advice-regexp
- (rx bos
- (1+ (seq (? "This function has ")
- (or ":before" ":after" ":around" ":override"
- ":before-while" ":before-until" ":after-while"
- ":after-until" ":filter-args" ":filter-return")
- " advice: " (0+ nonl) "\n"))
- "\n")
- "Regexp to match lines about advice in function documentation strings.")
-
-;; Taken from advice--make-docstring, is this robust?
-(defun marginalia--advised (fun)
- "Return t if function FUN is advised."
- (let ((flist (indirect-function fun)))
- (advice--p (if (eq 'macro (car-safe flist)) (cdr flist) flist))))
-
-;; Symbol class characters from Emacs 28 `help--symbol-completion-table-affixation'
-;; ! and * are our additions
-(defun marginalia--symbol-class (s)
- "Return symbol class characters for symbol S.
-
-Function:
-f function
-c command
-C interactive-only command
-m macro
-p pure
-s side-effect-free
-@ autoloaded
-! advised
-- obsolete
-
-Variable:
-u custom (U modified compared to global value)
-v variable
-l local (L modified compared to default value)
-- obsolete
-
-Other:
-a face
-t cl-type"
- (format
- "%-6s"
- (concat
- (when (fboundp s)
- (concat
- (cond
- ((get s 'pure) "p")
- ((get s 'side-effect-free) "s"))
- (cond
- ((commandp s) (if (get s 'interactive-only) "C" "c"))
- ((eq (car-safe (symbol-function s)) 'macro) "m")
- (t "f"))
- (and (autoloadp (symbol-function s)) "@")
- (and (marginalia--advised s) "!")
- (and (get s 'byte-obsolete-info) "-")))
- (when (boundp s)
- (concat
- (when (local-variable-if-set-p s)
- (if (ignore-errors
- (not (equal (symbol-value s)
- (default-value s))))
- "L" "l"))
- (if (custom-variable-p s)
- (if (ignore-errors
- (not (equal
- (symbol-value s)
- (eval (car (get s 'standard-value))))))
- "U" "u")
- "v")
- (and (get s 'byte-obsolete-variable) "-")))
- (and (facep s) "a")
- (and (fboundp 'cl-find-class) (cl-find-class s) "t"))))
-
-(defun marginalia--function-doc (sym)
- "Documentation string of function SYM."
- (when-let (str (ignore-errors (documentation sym)))
- (save-match-data
- (if (string-match marginalia--advice-regexp str)
- (substring str (match-end 0))
- str))))
-
-;; Derived from elisp-get-fnsym-args-string
-(defun marginalia--function-args (sym)
- "Return function arguments for SYM."
- (let ((tmp))
- (elisp-function-argstring
- (cond
- ((listp (setq tmp (gethash (indirect-function sym)
- advertised-signature-table t)))
- tmp)
- ((setq tmp (help-split-fundoc
- (ignore-errors (documentation sym t))
- sym))
- (substitute-command-keys (car tmp)))
- (t (help-function-arglist sym))))))
-
-(defun marginalia-annotate-symbol (cand)
- "Annotate symbol CAND with its documentation string."
- (when-let (sym (intern-soft cand))
- (concat
- (marginalia-annotate-binding cand)
- (marginalia--fields
- ((marginalia--symbol-class sym) :face 'marginalia-type)
- ((cond
- ((fboundp sym) (marginalia--function-doc sym))
- ((facep sym) (documentation-property sym 'face-documentation))
- (t (documentation-property sym 'variable-documentation)))
- :truncate marginalia-truncate-width :face 'marginalia-documentation)))))
-
-(defun marginalia-annotate-command (cand)
- "Annotate command CAND with its documentation string.
-Similar to `marginalia-annotate-symbol', but does not show symbol class."
- (when-let (sym (intern-soft cand))
- (concat
- (marginalia-annotate-binding cand)
- (marginalia--documentation (marginalia--function-doc sym)))))
-
-(defun marginalia-annotate-embark-keybinding (cand)
- "Annotate Embark keybinding CAND with its documentation string.
-Similar to `marginalia-annotate-command', but does not show the
-keybinding since CAND includes it."
- (when-let (cmd (get-text-property 0 'embark-command cand))
- (marginalia--documentation (marginalia--function-doc cmd))))
-
-(defun marginalia-annotate-imenu (cand)
- "Annotate imenu CAND with its documentation string."
- (when (derived-mode-p 'emacs-lisp-mode)
- ;; Strip until the last whitespace in order to support flat imenu
- (marginalia-annotate-symbol (replace-regexp-in-string "^.* " "" cand))))
-
-(defun marginalia-annotate-function (cand)
- "Annotate function CAND with its documentation string."
- (when-let (sym (intern-soft cand))
- (when (functionp sym)
- (concat
- (marginalia-annotate-binding cand)
- (marginalia--fields
- ((marginalia--symbol-class sym) :face 'marginalia-type)
- ((marginalia--function-args sym) :face 'marginalia-value
- :truncate (/ marginalia-truncate-width 2))
- ((marginalia--function-doc sym) :truncate marginalia-truncate-width
- :face 'marginalia-documentation))))))
-
-(defun marginalia--variable-value (sym)
- "Return the variable value of SYM as string."
- (cond
- ((not (boundp sym))
- (propertize "#<unbound>" 'face 'marginalia-null))
- ((and marginalia-censor-variables
- (let ((name (symbol-name sym)))
- (seq-find (lambda (r)
- (if (symbolp r)
- (eq r sym)
- (string-match-p r name)))
- marginalia-censor-variables)))
- (propertize "*****" 'face 'marginalia-null))
- (t (let ((val (symbol-value sym)))
- (pcase (symbol-value sym)
- ('nil (propertize "nil" 'face 'marginalia-null))
- ('t (propertize "t" 'face 'marginalia-true))
- ((pred keymapp) (propertize "#<keymap>" 'face 'marginalia-value))
- ((pred bool-vector-p) (propertize "#<bool-vector>" 'face 'marginalia-value))
- ((pred hash-table-p) (propertize "#<hash-table>" 'face 'marginalia-value))
- ((pred syntax-table-p) (propertize "#<syntax-table>" 'face 'marginalia-value))
- ;; Emacs BUG: abbrev-table-p throws an error
- ((guard (ignore-errors (abbrev-table-p val))) (propertize "#<abbrev-table>" 'face 'marginalia-value))
- ((pred char-table-p) (propertize "#<char-table>" 'face 'marginalia-value))
- ((pred byte-code-function-p) (propertize "#<byte-code-function>" 'face 'marginalia-function))
- ((and (pred functionp) (pred symbolp))
- ;; NOTE: We are not consistent here, values are generally printed unquoted. But we
- ;; make an exception for function symbols to visually distinguish them from symbols.
- ;; I am not entirely happy with this, but we should not add quotation to every type.
- (propertize (format "#'%s" val) 'face 'marginalia-function))
- ((pred recordp) (propertize (format "#<record %s>" (type-of val)) 'face 'marginalia-value))
- ((pred symbolp) (propertize (symbol-name val) 'face 'marginalia-symbol))
- ((pred numberp) (propertize (number-to-string val) 'face 'marginalia-number))
- (_ (let ((print-escape-newlines t)
- (print-escape-control-characters t)
- (print-escape-multibyte t)
- (print-level 10)
- (print-length marginalia-truncate-width))
- (propertize
- (prin1-to-string
- (if (stringp val)
- ;; Get rid of string properties to save some of the precious space
- (substring-no-properties
- val 0
- (min (length val) marginalia-truncate-width))
- val))
- 'face
- (cond
- ((listp val) 'marginalia-list)
- ((stringp val) 'marginalia-string)
- (t 'marginalia-value))))))))))
-
-(defun marginalia-annotate-variable (cand)
- "Annotate variable CAND with its documentation string."
- (when-let (sym (intern-soft cand))
- (marginalia--fields
- ((marginalia--symbol-class sym) :face 'marginalia-type)
- ((marginalia--variable-value sym) :truncate (/ marginalia-truncate-width 2))
- ((documentation-property sym 'variable-documentation)
- :truncate marginalia-truncate-width :face 'marginalia-documentation))))
-
-(defun marginalia-annotate-environment-variable (cand)
- "Annotate environment variable CAND with its current value."
- (when-let (val (getenv cand))
- (marginalia--fields
- (val :truncate marginalia-truncate-width :face 'marginalia-value))))
-
-(defun marginalia-annotate-face (cand)
- "Annotate face CAND with its documentation string and face example."
- (when-let (sym (intern-soft cand))
- (marginalia--fields
- ("abcdefghijklmNOPQRSTUVWXYZ" :face sym)
- ((documentation-property sym 'face-documentation)
- :truncate marginalia-truncate-width :face 'marginalia-documentation))))
-
-(defun marginalia-annotate-color (cand)
- "Annotate face CAND with its documentation string and face example."
- (when-let (rgb (color-name-to-rgb cand))
- (pcase-let* ((`(,r ,g ,b) rgb)
- (`(,h ,s ,l) (apply #'color-rgb-to-hsl rgb))
- (cr (color-rgb-to-hex r 0 0))
- (cg (color-rgb-to-hex 0 g 0))
- (cb (color-rgb-to-hex 0 0 b))
- (ch (apply #'color-rgb-to-hex (color-hsl-to-rgb h 1 0.5)))
- (cs (apply #'color-rgb-to-hex (color-hsl-to-rgb h s 0.5)))
- (cl (apply #'color-rgb-to-hex (color-hsl-to-rgb 0 0 l))))
- (marginalia--fields
- (" " :face `(:background ,(apply #'color-rgb-to-hex rgb)))
- ((format "%s%s%s %s"
- (propertize "r" 'face `(:background ,cr :foreground ,(readable-foreground-color cr)))
- (propertize "g" 'face `(:background ,cg :foreground ,(readable-foreground-color cg)))
- (propertize "b" 'face `(:background ,cb :foreground ,(readable-foreground-color cb)))
- (color-rgb-to-hex r g b 2)))
- ((format "%s%s%s %3s° %3s%% %3s%%"
- (propertize "h" 'face `(:background ,ch :foreground ,(readable-foreground-color ch)))
- (propertize "s" 'face `(:background ,cs :foreground ,(readable-foreground-color cs)))
- (propertize "l" 'face `(:background ,cl :foreground ,(readable-foreground-color cl)))
- (round (* 360 h))
- (round (* 100 s))
- (round (* 100 l))))))))
-
-(defun marginalia-annotate-char (cand)
- "Annotate character CAND with its general character category and character code."
- (when-let (char (char-from-name cand t))
- (concat
- (propertize (format " (%c)" char) 'face 'marginalia-char)
- (marginalia--fields
- (char :format "%06X" :face 'marginalia-number)
- ((char-code-property-description
- 'general-category
- (get-char-code-property char 'general-category))
- :width 30 :face 'marginalia-documentation)))))
-
-(defun marginalia-annotate-minor-mode (cand)
- "Annotate minor-mode CAND with status and documentation string."
- (let* ((sym (intern-soft cand))
- (mode (if (and sym (boundp sym))
- sym
- (lookup-minor-mode-from-indicator cand)))
- (lighter (cdr (assq mode minor-mode-alist)))
- (lighter-str (and lighter (string-trim (format-mode-line (cons t lighter))))))
- (concat
- (marginalia--fields
- ((if (and (boundp mode) (symbol-value mode))
- (propertize "On" 'face 'marginalia-on)
- (propertize "Off" 'face 'marginalia-off)) :width 3)
- ((if (local-variable-if-set-p mode) "Local" "Global") :width 6 :face 'marginalia-type)
- (lighter-str :width 20 :face 'marginalia-lighter)
- ((marginalia--function-doc mode)
- :truncate marginalia-truncate-width :face 'marginalia-documentation)))))
-
-(defun marginalia-annotate-package (cand)
- "Annotate package CAND with its description summary."
- (when-let* ((pkg-alist (and (bound-and-true-p package-alist) package-alist))
- (pkg (intern-soft (replace-regexp-in-string "-[[:digit:]\\.-]+\\'" "" cand)))
- ;; taken from `describe-package-1'
- (desc (or (car (alist-get pkg pkg-alist))
- (if-let (built-in (assq pkg package--builtins))
- (package--from-builtin built-in)
- (car (alist-get pkg package-archive-contents))))))
- (marginalia--fields
- ((package-version-join (package-desc-version desc)) :width 16 :face 'marginalia-version)
- ((cond
- ((package-desc-archive desc) (propertize (package-desc-archive desc) 'face 'marginalia-archive))
- (t (propertize (or (package-desc-status desc) "orphan") 'face 'marginalia-installed))) :width 10)
- ((package-desc-summary desc) :truncate marginalia-truncate-width :face 'marginalia-documentation))))
-
-(defun marginalia--bookmark-type (bm)
- "Return bookmark type string of BM.
-
-The string is transformed according to `marginalia-bookmark-type-transformers'."
- (let ((handler (or (bookmark-get-handler bm) 'bookmark-default-handler)))
- ;; Some libraries use lambda handlers instead of symbols. For
- ;; example the function `xwidget-webkit-bookmark-make-record' is
- ;; affected. I consider this bad style since then the lambda is
- ;; persisted.
- (when-let (str (and (symbolp handler) (symbol-name handler)))
- (dolist (transformer marginalia-bookmark-type-transformers str)
- (when (string-match-p (car transformer) str)
- (setq str
- (if (stringp (cdr transformer))
- (replace-regexp-in-string (car transformer) (cdr transformer) str)
- (funcall (cdr transformer) str))))))))
-
-(defun marginalia-annotate-bookmark (cand)
- "Annotate bookmark CAND with its file name and front context string."
- (when-let ((bm (assoc cand bookmark-alist)))
- (let ((front (bookmark-get-front-context-string bm)))
- (marginalia--fields
- ((marginalia--bookmark-type bm) :width 10 :face 'marginalia-type)
- ((bookmark-get-filename bm) :truncate 40 :face 'marginalia-file-name)
- ((if (or (not front) (string= front ""))
- ""
- (concat (string-trim
- (replace-regexp-in-string
- "[ \t]+" " "
- (replace-regexp-in-string "\n" "\\\\n" front))) "…"))
- :truncate 20 :face 'marginalia-documentation)))))
-
-(defun marginalia-annotate-customize-group (cand)
- "Annotate customization group CAND with its documentation string."
- (marginalia--documentation (documentation-property (intern cand) 'group-documentation)))
-
-(defun marginalia-annotate-input-method (cand)
- "Annotate input method CAND with its description."
- (marginalia--documentation (nth 4 (assoc cand input-method-alist))))
-
-(defun marginalia-annotate-charset (cand)
- "Annotate charset CAND with its description."
- (marginalia--documentation (charset-description (intern cand))))
-
-(defun marginalia-annotate-coding-system (cand)
- "Annotate coding system CAND with its description."
- (marginalia--documentation (coding-system-doc-string (intern cand))))
-
-(defun marginalia--buffer-status (buffer)
- "Return the status of BUFFER as a string."
- (format-mode-line '((:propertize "%1*%1+%1@" face marginalia-modified)
- marginalia--separator
- (7 (:propertize "%I" face marginalia-size))
- marginalia--separator
- ;; InactiveMinibuffer has 18 letters, but there are longer names.
- ;; For example Org-Agenda produces very long mode names.
- ;; Therefore we have to truncate.
- (20 (-20 (:propertize mode-name face marginalia-mode))))
- nil nil buffer))
-
-(defun marginalia--buffer-file (buffer)
- "Return the file or process name of BUFFER."
- (if-let (proc (get-buffer-process buffer))
- (format "(%s %s) %s"
- proc (process-status proc)
- (abbreviate-file-name (buffer-local-value 'default-directory buffer)))
- (abbreviate-file-name
- (or (cond
- ;; see ibuffer-buffer-file-name
- ((buffer-file-name buffer))
- ((when-let (dir (and (local-variable-p 'dired-directory buffer)
- (buffer-local-value 'dired-directory buffer)))
- (expand-file-name (if (stringp dir) dir (car dir))
- (buffer-local-value 'default-directory buffer))))
- ((local-variable-p 'list-buffers-directory buffer)
- (buffer-local-value 'list-buffers-directory buffer)))
- ""))))
-
-(defun marginalia-annotate-buffer (cand)
- "Annotate buffer CAND with modification status, file name and major mode."
- (when-let (buffer (get-buffer cand))
- (marginalia--fields
- ((marginalia--buffer-status buffer))
- ((marginalia--buffer-file buffer)
- :truncate (/ marginalia-truncate-width 2)
- :face 'marginalia-file-name))))
-
-(defun marginalia--full-candidate (cand)
- "Return completion candidate CAND in full.
-For some completion tables, the completion candidates offered are
-meant to be only a part of the full minibuffer contents. For
-example, during file name completion the candidates are one path
-component of a full file path."
- (if-let (win (active-minibuffer-window))
- (with-current-buffer (window-buffer win)
- (if (bound-and-true-p selectrum-is-active)
- (selectrum--get-full cand)
- (concat (substring (minibuffer-contents-no-properties)
- 0 marginalia--base-position)
- cand)))
- ;; no minibuffer is active, trust that cand already conveys all
- ;; necessary information (there's not much else we can do)
- cand))
-
-(defun marginalia--remote-protocol (path)
- "Return the remote protocol of PATH."
- (save-match-data
- (setq path (substitute-in-file-name path))
- (and (string-match "\\`/\\([^/|:]+\\):" path)
- (match-string 1 path))))
-
-(defun marginalia--annotate-local-file (cand)
- "Annotate local file CAND."
- (when-let (attrs (ignore-errors
- ;; may throw permission denied errors
- (file-attributes (substitute-in-file-name
- (marginalia--full-candidate cand))
- 'integer)))
- (marginalia--fields
- ((marginalia--file-owner attrs)
- :width 12 :face 'marginalia-file-owner)
- ((marginalia--file-modes attrs))
- ((file-size-human-readable (file-attribute-size attrs))
- :face 'marginalia-size :width -7)
- ((marginalia--time (file-attribute-modification-time attrs))
- :face 'marginalia-date :width -12))))
-
-(defun marginalia-annotate-file (cand)
- "Annotate file CAND with its size, modification time and other attributes.
-These annotations are skipped for remote paths."
- (if-let (remote (or (marginalia--remote-protocol cand)
- (when-let (win (active-minibuffer-window))
- (with-current-buffer (window-buffer win)
- (marginalia--remote-protocol (minibuffer-contents-no-properties))))))
- (marginalia--fields (remote :format "*%s*" :face 'marginalia-documentation))
- (marginalia--annotate-local-file cand)))
-
-(defun marginalia--file-owner (attrs)
- "Return file owner given ATTRS."
- (let ((uid (file-attribute-user-id attrs))
- (gid (file-attribute-group-id attrs)))
- (if (or (/= (user-uid) uid) (/= (group-gid) gid))
- (format "%s:%s" (or (user-login-name uid) uid) (or (group-name gid) gid))
- "")))
-
-(defun marginalia--file-modes (attrs)
- "Return fontified file modes given the ATTRS."
- ;; Without caching this can a be significant portion of the time
- ;; `marginalia-annotate-file' takes to execute. Caching improves performance
- ;; by about a factor of 20.
- (setq attrs (file-attribute-modes attrs))
- (or (car (member attrs marginalia--fontified-file-modes))
- (progn
- (setq attrs (substring attrs)) ;; copy because attrs is about to be modified
- (dotimes (i (length attrs))
- (put-text-property
- i (1+ i) 'face
- (pcase (aref attrs i)
- (?- 'marginalia-file-priv-no)
- (?d 'marginalia-file-priv-dir)
- (?l 'marginalia-file-priv-link)
- (?r 'marginalia-file-priv-read)
- (?w 'marginalia-file-priv-write)
- (?x 'marginalia-file-priv-exec)
- ((or ?s ?S ?t ?T) 'marginalia-file-priv-other)
- (_ 'marginalia-file-priv-rare))
- attrs))
- (push attrs marginalia--fontified-file-modes)
- attrs)))
-
-(defconst marginalia--time-relative
- `((100 "sec" 1)
- (,(* 60 100) "min" 60.0)
- (,(* 3600 30) "hour" 3600.0)
- (,(* 3600 24 400) "day" ,(* 3600.0 24.0))
- (nil "year" ,(* 365.25 24 3600)))
- "Formatting used by the function `marginalia--time-relative'.")
-
-;; Taken from `seconds-to-string'.
-(defun marginalia--time-relative (time)
- "Format TIME as a relative age."
- (setq time (float-time (time-since time)))
- (if (<= time 0)
- "0 secs ago"
- (let ((sts marginalia--time-relative) here)
- (while (and (car (setq here (pop sts))) (<= (car here) time)))
- (setq time (round time (caddr here)))
- (format "%s %s%s ago" time (cadr here) (if (= time 1) "" "s")))))
-
-(defun marginalia--time-absolute (time)
- "Format TIME as an absolute age."
- (let ((system-time-locale "C"))
- (format-time-string
- ;; decoded-time-year is only available on Emacs 27, use nth 5 here.
- (if (> (nth 5 (decode-time (current-time)))
- (nth 5 (decode-time time)))
- " %Y %b %d"
- "%b %d %H:%M")
- time)))
-
-(defun marginalia--time (time)
- "Format file age TIME, suitably for use in annotations."
- (if (< (float-time (time-since time)) marginalia-max-relative-age)
- (marginalia--time-relative time)
- (marginalia--time-absolute time)))
-
-(defmacro marginalia--project-root ()
- "Return project root."
- (require 'project)
- `(when-let (proj (project-current))
- ,(if (fboundp 'project-root)
- '(project-root proj)
- '(car (project-roots proj)))))
-
-(defun marginalia-annotate-project-file (cand)
- "Annotate file CAND with its size, modification time and other attributes."
- ;; TODO project-find-file can be called from outside all projects in
- ;; which case it prompts for a project first; we don't support that
- ;; case yet, since there is no current project.
- (when-let (root (marginalia--project-root))
- (marginalia-annotate-file (expand-file-name cand root))))
-
-(defun marginalia-classify-by-command-name ()
- "Lookup category for current command."
- (and marginalia--command
- (alist-get marginalia--command marginalia-command-categories)))
-
-(defun marginalia-classify-original-category ()
- "Return original category reported by completion metadata."
- ;; NOTE: Use `alist-get' instead of `completion-metadata-get' to bypass our
- ;; `marginalia--completion-metadata-get' advice!
- (when-let (cat (alist-get 'category marginalia--metadata))
- ;; Ignore Emacs 28 symbol-help category in order to ensure that the
- ;; categories are refined to our categories function and variable.
- (and (not (eq cat 'symbol-help)) cat)))
-
-(defun marginalia-classify-symbol ()
- "Determine if currently completing symbols."
- (when-let (mct minibuffer-completion-table)
- (when (or (eq mct 'help--symbol-completion-table)
- (obarrayp mct)
- (and (not (functionp mct)) (consp mct) (symbolp (car mct)))) ; assume list of symbols
- 'symbol)))
-
-(defun marginalia-classify-by-prompt ()
- "Determine category by matching regexps against the minibuffer prompt.
-This runs through the `marginalia-prompt-categories' alist
-looking for a regexp that matches the prompt."
- (when-let (prompt (minibuffer-prompt))
- (setq prompt
- (replace-regexp-in-string "(.*default.*)\\|\\[.*\\]" "" prompt))
- (cl-loop for (regexp . category) in marginalia-prompt-categories
- when (string-match-p regexp prompt)
- return category)))
-
-(defmacro marginalia--context (metadata &rest body)
- "Setup annotator context with completion METADATA around BODY."
- (declare (indent 1))
- (let ((w (make-symbol "w"))
- (c (make-symbol "c"))
- (o (make-symbol "o")))
- ;; Take the window width of the current window (minibuffer window!)
- `(let ((marginalia--metadata ,metadata)
- (,c marginalia--cache)
- (,w (window-width))
- ;; Compute marginalia-align-offset. If the right-fringe-width is
- ;; zero, use an additional offset of 1 by default! See
- ;; https://github.com/minad/marginalia/issues/42 for the discussion
- ;; regarding the alignment.
- (,o (if (eq 0 (nth 1 (window-fringes))) 1 0)))
- ;; We generally run the annotators in the original window.
- ;; `with-selected-window' is necessary because of `lookup-minor-mode-from-indicator'.
- ;; Otherwise it would probably suffice to only change the current buffer.
- ;; We need the `selected-window' fallback for Embark Occur.
- (with-selected-window (or (minibuffer-selected-window) (selected-window))
- (let ((marginalia--cache ,c) ;; Take the cache from the minibuffer
- (marginalia-truncate-width (min (/ ,w 2) marginalia-truncate-width))
- (marginalia--separator (if (>= ,w marginalia-separator-threshold) " " " "))
- (marginalia--margin
- (+ (or marginalia-align-offset ,o)
- (if (>= ,w (+ marginalia-margin-min marginalia-margin-threshold))
- (- ,w marginalia-margin-threshold)
- 0))))
- ,@body)))))
-
-(defun marginalia--cache-reset ()
- "Reset the cache."
- (when marginalia--cache
- (setq marginalia--cache (and (> marginalia--cache-size 0)
- (cons nil (make-hash-table :test #'equal
- :size marginalia--cache-size))))))
-
-(defun marginalia--cached (fun key)
- "Cached application of function FUN with KEY.
-
-The cache keeps around the last `marginalia--cache-size' computed annotations.
-The cache is mainly useful when scrolling in completion UIs like Vertico or
-Selectrum."
- (if marginalia--cache
- (let ((ht (cdr marginalia--cache)))
- (or (gethash key ht)
- (let ((val (funcall fun key)))
- (setcar marginalia--cache (cons key (car marginalia--cache)))
- (puthash key val ht)
- (when (>= (hash-table-count ht) marginalia--cache-size)
- (let ((end (last (car marginalia--cache) 2)))
- (remhash (cadr end) ht)
- (setcdr end nil)))
- val)))
- (funcall fun key)))
-
-(defun marginalia--completion-metadata-get (metadata prop)
- "Meant as :before-until advice for `completion-metadata-get'.
-METADATA is the metadata.
-PROP is the property which is looked up."
- (pcase prop
- ('annotation-function
- ;; we do want the advice triggered for completion-metadata-get
- (when-let* ((cat (completion-metadata-get metadata 'category))
- (annotate (marginalia--annotator cat)))
- (lambda (cand)
- (marginalia--context metadata
- (marginalia--cached annotate cand)))))
- ('affixation-function
- ;; We do want the advice triggered for `completion-metadata-get'.
- ;; Return wrapper around `annotation-function'.
- (when-let* ((cat (completion-metadata-get metadata 'category))
- (annotate (marginalia--annotator cat)))
- (lambda (cands)
- (marginalia--context metadata
- (mapcar (lambda (x) (list x "" (or (marginalia--cached annotate x) ""))) cands)))))
- ('category
- ;; Find the completion category by trying each of our classifiers.
- ;; Store the metadata for `marginalia-classify-original-category'.
- (let ((marginalia--metadata metadata))
- (run-hook-with-args-until-success 'marginalia-classifiers)))))
-
-(defun marginalia--minibuffer-setup ()
- "Setup the minibuffer for Marginalia.
-Remember `this-command' for `marginalia-classify-by-command-name'."
- (setq marginalia--cache t marginalia--command this-command)
- ;; Reset cache if window size changes, recompute alignment
- (add-hook 'window-state-change-hook #'marginalia--cache-reset nil 'local)
- (marginalia--cache-reset))
-
-(defun marginalia--base-position (completions)
- "Record the base position of COMPLETIONS."
- ;; NOTE: As a small optimization track the base position only for file completions,
- ;; since `marginalia--full-candidate' is only used for files as of now.
- (when minibuffer-completing-file-name
- (let ((base (or (cdr (last completions)) 0)))
- (unless (= marginalia--base-position base)
- (marginalia--cache-reset)
- (setq marginalia--base-position base))))
- completions)
-
-;;;###autoload
-(define-minor-mode marginalia-mode
- "Annotate completion candidates with richer information."
- :global t :group 'marginalia
- (if marginalia-mode
- (progn
- ;; Ensure that we remember this-command in order to select the annotation function.
- (add-hook 'minibuffer-setup-hook #'marginalia--minibuffer-setup)
- ;; Replace the metadata function.
- (advice-add #'completion-metadata-get :before-until #'marginalia--completion-metadata-get)
- ;; Record completion base position, for marginalia--full-candidate
- (advice-add #'completion-all-completions :filter-return #'marginalia--base-position))
- (advice-remove #'completion-all-completions #'marginalia--base-position)
- (advice-remove #'completion-metadata-get #'marginalia--completion-metadata-get)
- (remove-hook 'minibuffer-setup-hook #'marginalia--minibuffer-setup)))
-
-;;;###autoload
-(defun marginalia-cycle ()
- "Cycle between annotators in `marginalia-annotator-registry'."
- (interactive)
- (if-let* ((win (active-minibuffer-window))
- (buf (window-buffer win)))
- (with-current-buffer buf
- (let* ((pt (max 0 (- (point) (minibuffer-prompt-end))))
- (metadata (completion-metadata (buffer-substring-no-properties
- (minibuffer-prompt-end)
- (+ (minibuffer-prompt-end) pt))
- minibuffer-completion-table
- minibuffer-completion-predicate))
- (cat (completion-metadata-get metadata 'category)))
- (unless cat
- (user-error "Marginalia: Unknown completion category"))
- (setq cat (assq cat marginalia-annotator-registry))
- (unless cat
- (user-error "Marginalia: No annotators found"))
- (marginalia--cache-reset)
- (setcdr cat (append (cddr cat) (list (cadr cat))))
- ;; When the builtin annotator is selected and no builtin function is available, skip to
- ;; the next annotator. Note that we cannot use `completion-metadata-get' to access the
- ;; metadata since we must bypass the `marginalia--completion-metadata-get' advice.
- (when (and (eq (cadr cat) 'builtin)
- (not (assq 'annotation-function metadata))
- (not (assq 'affixation-function metadata))
- (not (plist-get completion-extra-properties :annotation-function))
- (not (plist-get completion-extra-properties :affixation-function)))
- (setcdr cat (append (cddr cat) (list (cadr cat)))))
- (message "Marginalia: Use annotator `%s' for category `%s'" (cadr cat) (car cat))))
- (user-error "Marginalia: No active minibuffer")))
-
-(provide 'marginalia)
-;;; marginalia.el ends here
diff --git a/elpa/marginalia-0.10/marginalia.elc b/elpa/marginalia-0.10/marginalia.elc
Binary files differ.
diff --git a/elpa/marginalia-0.10/marginalia.info b/elpa/marginalia-0.10/marginalia.info
@@ -1,238 +0,0 @@
-This is marginalia.info, produced by makeinfo version 6.7 from
-marginalia.texi.
-
-INFO-DIR-SECTION Emacs
-START-INFO-DIR-ENTRY
-* Marginalia: (marginalia). Marginalia in the minibuffer.
-END-INFO-DIR-ENTRY
-
-
-File: marginalia.info, Node: Top, Next: Introduction, Up: (dir)
-
-marginalia.el - Marginalia in the minibuffer
-********************************************
-
-* Menu:
-
-* Introduction::
-* Configuration::
-* Information shown by the annotators::
-* Adding custom annotators or classifiers::
-* Disabling annotators, builtin or lightweight annotators: Disabling annotators builtin or lightweight annotators.
-* Contributions::
-
-
-File: marginalia.info, Node: Introduction, Next: Configuration, Prev: Top, Up: Top
-
-1 Introduction
-**************
-
-This package provides ‘marginalia-mode’ which adds marginalia to the
-minibuffer completions. Marginalia
-(https://en.wikipedia.org/wiki/Marginalia) are marks or annotations
-placed at the margin of the page of a book or in this case helpful
-colorful annotations placed at the margin of the minibuffer for your
-completion candidates. Marginalia can only add annotations to be
-displayed with the completion candidates. It cannot modify the
-appearance of the candidates themselves, which are shown as supplied by
-the original commands.
-
- The annotations are added based on the completion category. For
-example ‘find-file’ reports the ‘file’ category and ‘M-x’ reports the
-‘command’ category. You can cycle between more or less detailed
-annotators or even disable the annotator with command
-‘marginalia-cycle’.
-
-
-File: marginalia.info, Node: Configuration, Next: Information shown by the annotators, Prev: Introduction, Up: Top
-
-2 Configuration
-***************
-
-It is recommended to use Marginalia together with either the Selectrum
-(https://github.com/raxod502/selectrum), Vertico
-(https://github.com/minad/vertico) or the Icomplete-vertical
-(https://github.com/oantolin/icomplete-vertical) completion system.
-Furthermore Marginalia can be combined with Embark
-(https://github.com/oantolin/embark) for action support and Consult
-(https://github.com/minad/consult), which provides many useful commands.
-
- ;; Enable richer annotations using the Marginalia package
- (use-package marginalia
- ;; Either bind `marginalia-cycle` globally or only in the minibuffer
- :bind (("M-A" . marginalia-cycle)
- :map minibuffer-local-map
- ("M-A" . marginalia-cycle))
-
- ;; The :init configuration is always executed (Not lazy!)
- :init
-
- ;; Must be in the :init section of use-package such that the mode gets
- ;; enabled right away. Note that this forces loading the package.
- (marginalia-mode))
-
-
-File: marginalia.info, Node: Information shown by the annotators, Next: Adding custom annotators or classifiers, Prev: Configuration, Up: Top
-
-3 Information shown by the annotators
-*************************************
-
-In general, to learn more about what different annotations mean, a good
-starting point is to look at ‘marginalia-annotator-registry’, and follow
-up to the annotation function of the category you are interested in.
-
- For example the annotations for elisp symbols include their symbol
-class - v for variable, f for function, c for command, etc. For more
-information on what the different classifications mean, see the
-docstring of ‘marginalia--symbol-class’.
-
-
-File: marginalia.info, Node: Adding custom annotators or classifiers, Next: Disabling annotators builtin or lightweight annotators, Prev: Information shown by the annotators, Up: Top
-
-4 Adding custom annotators or classifiers
-*****************************************
-
-Commands that support minibuffer completion use a completion table of
-all the available candidates. Candidates are associated with a
-*category* such as ‘command’, ‘file’, ‘face’, or ‘variable’ depending on
-what the candidates are. Based on the category of the candidates,
-Marginalia selects an *annotator* to generate annotations for display
-for each candidate.
-
- Unfortunately, not all commands (including Emacs’ builtin ones)
-specify the category of their candidates. To compensate for this
-shortcoming, Marginalia hooks into the emacs completion framework and
-runs the *classifiers* listed in the variable ‘marginalia-classifiers’,
-which use the command’s prompt or other properties of the candidates to
-specify the completion category.
-
- For example, the ‘marginalia-classify-by-prompt’ classifier checks
-the minibuffer prompt against regexps listed in the
-‘marginalia-prompt-categories’ alist to determine a category. The
-following is already included but would be a way to assign the category
-‘face’ to all candidates from commands with prompts that include the
-word "face".
-
- (add-to-list 'marginalia-prompt-categories '("\\<face\\>" . face))
-
- The ‘marginalia-classify-by-command-name’ classifier uses the alist
-‘marginalia-command-categories’ to specify the completion category based
-on the command name. This is particularily useful if the prompt
-classifier yields a false positive.
-
- Completion categories are also important for Embark
-(https://github.com/oantolin/embark), which associates actions based on
-the completion category and benefits from Marginalia’s classifiers.
-
- Once the category of the candidates is known, Marginalia looks in the
-‘marginalia-annotator-registry’ to find the associated annotator to use.
-An annotator is a function that takes a completion candidate string as
-an argument and returns an annotation string to be displayed after the
-candidate in the minibuffer. More than one annotator can be assigned to
-each each category, displaying more, less or different information. Use
-the ‘marginalia-cycle’ command to cycle between the annotations of
-different annotators defined for the current category.
-
- Here’s an example of a basic face annotator:
-
- (defun my-face-annotator (cand)
- (when-let (sym (intern-soft cand))
- (concat (propertize " " 'display '(space :align-to center))
- (propertize "The quick brown fox jumps over the lazy dog" 'face sym))))
-
- Look at Marginalia’s various annotators for examples of formating
-annotations. In particular, the helper function ‘marginalia--fields’
-can be used to format information into columns.
-
- After defining a new annotator, associate it with a category in the
-annotator registry as follows:
-
- (add-to-list 'marginalia-annotator-registry
- '(face my-face-annotator marginalia-annotate-face builtin none))
-
- This makes the ‘my-face-annotator’ the first of four annotators for
-the face category. The others are the annotator provided by Marginalia
-(‘marginalia-annotate-face’), the ‘builtin’ annotator as defined by
-Emacs and the ‘none’ annotator, which disables the annotations. With
-this setting, after invoking ‘M-x describe-face RET’ you can cycle
-between all of these annotators using ‘marginalia-cycle’.
-
-
-File: marginalia.info, Node: Disabling annotators builtin or lightweight annotators, Next: Contributions, Prev: Adding custom annotators or classifiers, Up: Top
-
-5 Disabling annotators, builtin or lightweight annotators
-*********************************************************
-
-Marginalia activates rich annotators by default. Depending on your
-preference you may want to use the builtin annotators or even no
-annotators by default and only activate the annotators on demand by
-invoking ‘marginalia-cycle’.
-
- In order to use the builtin annotators by default, you can use the
-following command. Replace ‘builtin’ by ‘none’ to disable annotators by
-default.
-
- (defun marginalia-use-builtin ()
- (interactive)
- (mapc
- (lambda (x)
- (setcdr x (cons 'builtin (remq 'builtin (cdr x)))))
- marginalia-annotator-registry))
-
- If a completion category supports two annotators, you can toggle
-between those using this command.
-
- (defun marginalia-toggle ()
- (interactive)
- (mapc
- (lambda (x)
- (setcdr x (append (reverse (remq 'none
- (remq 'builtin (cdr x))))
- '(builtin none))))
- marginalia-annotator-registry))
-
- After cycling the annotators you may want to automatically save the
-configuration. This can be achieved using an advice which calls
-‘customize-save-variable’.
-
- (advice-add #'marginalia-cycle :after
- (lambda ()
- (let ((inhibit-message t))
- (customize-save-variable 'marginalia-annotator-registry
- marginalia-annotator-registry))))
-
- In order to disable an annotator permanently, the
-‘marginalia-annotator-registry’ can be modified. For example if you
-prefer to never see file annotations, you can delete all file annotators
-from the registry.
-
- (setq marginalia-annotator-registry
- (assq-delete-all 'file marginalia-annotator-registry))
-
-
-File: marginalia.info, Node: Contributions, Prev: Disabling annotators builtin or lightweight annotators, Up: Top
-
-6 Contributions
-***************
-
-Since this package is part of GNU ELPA
-(http://elpa.gnu.org/packages/marginalia.html) contributions require a
-copyright assignment to the FSF.
-
-
-
-Tag Table:
-Node: Top203
-Node: Introduction626
-Node: Configuration1584
-Node: Information shown by the annotators2730
-Node: Adding custom annotators or classifiers3425
-Node: Disabling annotators builtin or lightweight annotators7066
-Node: Contributions9108
-
-End Tag Table
-
-
-Local Variables:
-coding: utf-8
-End:
diff --git a/elpa/paredit-24/paredit-autoloads.el b/elpa/paredit-24/paredit-autoloads.el
@@ -1,41 +0,0 @@
-;;; paredit-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-
-;;;### (autoloads nil "paredit" "paredit.el" (0 0 0 0))
-;;; Generated autoloads from paredit.el
-
-(autoload 'paredit-mode "paredit" "\
-Minor mode for pseudo-structurally editing Lisp code.
-With a prefix argument, enable Paredit Mode even if there are
- unbalanced parentheses in the buffer.
-Paredit behaves badly if parentheses are unbalanced, so exercise
- caution when forcing Paredit Mode to be enabled, and consider
- fixing unbalanced parentheses instead.
-\\<paredit-mode-map>
-
-If called interactively, enable Paredit mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp,
-also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'enable-paredit-mode "paredit" "\
-Turn on pseudo-structural editing of Lisp code." t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paredit" '("?\\" "disable-paredit-mode" "paredit-")))
-
-;;;***
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; paredit-autoloads.el ends here
diff --git a/elpa/paredit-24/paredit-pkg.el b/elpa/paredit-24/paredit-pkg.el
@@ -1,2 +0,0 @@
-;;; Generated package description from paredit.el -*- no-byte-compile: t -*-
-(define-package "paredit" "24" "minor mode for editing parentheses" 'nil :commit "82bb75ceb2ddc272d6618d94874b7fc13181a409" :authors '(("Taylor R. Campbell")) :maintainer '("Taylor R. Campbell") :keywords '("lisp"))
diff --git a/elpa/paredit-24/paredit.el b/elpa/paredit-24/paredit.el
@@ -1,2916 +0,0 @@
-;;; paredit.el --- minor mode for editing parentheses -*- Mode: Emacs-Lisp -*-
-
-;; Copyright (C) 2005--2014 Taylor R. Campbell
-
-;; Author: Taylor R. Campbell
-;; Version: 24
-;; Package-Version: 24
-;; Package-Commit: 82bb75ceb2ddc272d6618d94874b7fc13181a409
-;; Created: 2005-07-31
-;; Keywords: lisp
-
-;; Paredit 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.
-;;
-;; Paredit 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 paredit. If not, see <http://www.gnu.org/licenses/>.
-
-;;; The currently released version of paredit is available at
-;;; <http://mumble.net/~campbell/emacs/paredit.el>.
-;;;
-;;; The latest beta version of paredit is available at
-;;; <http://mumble.net/~campbell/emacs/paredit-beta.el>.
-;;;
-;;; The Git repository for paredit is available at
-;;; <http://mumble.net/~campbell/git/paredit.git>
-;;;
-;;; Release notes are available at
-;;; <http://mumble.net/~campbell/emacs/paredit.release>.
-
-;;; Install paredit by placing `paredit.el' in `/path/to/elisp', a
-;;; directory of your choice, and adding to your .emacs file:
-;;;
-;;; (add-to-list 'load-path "/path/to/elisp")
-;;; (autoload 'enable-paredit-mode "paredit"
-;;; "Turn on pseudo-structural editing of Lisp code."
-;;; t)
-;;;
-;;; Start Paredit Mode on the fly with `M-x enable-paredit-mode RET',
-;;; or always enable it in a major mode `M' (e.g., `lisp') with:
-;;;
-;;; (add-hook M-mode-hook 'enable-paredit-mode)
-;;;
-;;; Customize paredit using `eval-after-load':
-;;;
-;;; (eval-after-load 'paredit
-;;; '(progn
-;;; (define-key paredit-mode-map (kbd "ESC M-A-C-s-)")
-;;; 'paredit-dwim)))
-;;;
-;;; Send questions, bug reports, comments, feature suggestions, &c.,
-;;; via email to the author's surname at mumble.net.
-;;;
-;;; Paredit should run in GNU Emacs 21 or later and XEmacs 21.5.28 or
-;;; later.
-
-;;; The paredit minor mode, Paredit Mode, binds common character keys,
-;;; such as `(', `)', `"', and `\', to commands that carefully insert
-;;; S-expression structures in the buffer:
-;;;
-;;; ( inserts `()', leaving the point in the middle;
-;;; ) moves the point over the next closing delimiter;
-;;; " inserts `""' if outside a string, or inserts an escaped
-;;; double-quote if in the middle of a string, or moves over the
-;;; closing double-quote if at the end of a string; and
-;;; \ prompts for the character to escape, to avoid inserting lone
-;;; backslashes that may break structure.
-;;;
-;;; In comments, these keys insert themselves. If necessary, you can
-;;; insert these characters literally outside comments by pressing
-;;; `C-q' before these keys, in case a mistake has broken the
-;;; structure.
-;;;
-;;; These key bindings are designed so that when typing new code in
-;;; Paredit Mode, you can generally type exactly the same sequence of
-;;; keys you would have typed without Paredit Mode.
-;;;
-;;; Paredit Mode also binds common editing keys, such as `DEL', `C-d',
-;;; and `C-k', to commands that respect S-expression structures in the
-;;; buffer:
-;;;
-;;; DEL deletes the previous character, unless it is a delimiter: DEL
-;;; will move the point backward over a closing delimiter, and
-;;; will delete a delimiter pair together if between an open and
-;;; closing delimiter;
-;;;
-;;; C-d deletes the next character in much the same manner; and
-;;;
-;;; C-k kills all S-expressions that begin anywhere between the point
-;;; and the end of the line or the closing delimiter of the
-;;; enclosing list, whichever is first.
-;;;
-;;; If necessary, you can delete a character, kill a line, &c.,
-;;; irrespective of S-expression structure, by pressing `C-u' before
-;;; these keys, in case a mistake has broken the structure.
-;;;
-;;; Finally, Paredit Mode binds some keys to complex S-expression
-;;; editing operations. For example, `C-<right>' makes the enclosing
-;;; list slurp up an S-expression to its right (here `|' denotes the
-;;; point):
-;;;
-;;; (foo (bar | baz) quux) C-<right> (foo (bar | baz quux))
-;;;
-;;; Some paredit commands automatically reindent code. When they do,
-;;; they try to indent as locally as possible, to avoid interfering
-;;; with any indentation you might have manually written. Only the
-;;; advanced S-expression manipulation commands automatically reindent,
-;;; and only the forms that they immediately operated upon (and their
-;;; subforms).
-;;;
-;;; This code is written for clarity, not efficiency. It frequently
-;;; walks over S-expressions redundantly. If you have problems with
-;;; the time it takes to execute some of the commands, let me know.
-
-;;; This assumes Unix-style LF line endings.
-
-(defconst paredit-version 24)
-(defconst paredit-beta-p nil)
-
-(eval-and-compile
-
- (defun paredit-xemacs-p ()
- ;; No idea where I got this definition from. Edward O'Connor
- ;; (hober in #emacs) suggested the current definition.
- ;; (and (boundp 'running-xemacs)
- ;; running-xemacs)
- (featurep 'xemacs))
-
- (defun paredit-gnu-emacs-p ()
- ;++ This could probably be improved.
- (not (paredit-xemacs-p)))
-
- (defmacro xcond (&rest clauses)
- "Exhaustive COND.
-Signal an error if no clause matches."
- `(cond ,@clauses
- (t (error "XCOND lost."))))
-
- (defalias 'paredit-warn (if (fboundp 'warn) 'warn 'message))
-
- (defvar paredit-sexp-error-type
- (with-temp-buffer
- (insert "(")
- (condition-case condition
- (backward-sexp)
- (error (if (eq (car condition) 'error)
- (paredit-warn "%s%s%s%s%s"
- "Paredit is unable to discriminate"
- " S-expression parse errors from"
- " other errors. "
- " This may cause obscure problems. "
- " Please upgrade Emacs."))
- (car condition)))))
-
- (defmacro paredit-handle-sexp-errors (body &rest handler)
- `(condition-case ()
- ,body
- (,paredit-sexp-error-type ,@handler)))
-
- (put 'paredit-handle-sexp-errors 'lisp-indent-function 1)
-
- (defmacro paredit-ignore-sexp-errors (&rest body)
- `(paredit-handle-sexp-errors (progn ,@body)
- nil))
-
- (put 'paredit-ignore-sexp-errors 'lisp-indent-function 0)
-
- (defmacro paredit-preserving-column (&rest body)
- "Evaluate BODY and restore point to former column, relative to code.
-Assumes BODY will change only indentation.
-If point was on code, it moves with the code.
-If point was on indentation, it stays in indentation."
- (let ((column (make-symbol "column"))
- (indentation (make-symbol "indentation")))
- `(let ((,column (current-column))
- (,indentation (paredit-current-indentation)))
- (let ((value (progn ,@body)))
- (paredit-restore-column ,column ,indentation)
- value))))
-
- (put 'paredit-preserving-column 'lisp-indent-function 0)
-
- nil)
-
-;;;; Minor Mode Definition
-
-(defvar paredit-mode-map (make-sparse-keymap)
- "Keymap for the paredit minor mode.")
-
-(defvar paredit-override-check-parens-function
- (lambda (condition) condition nil)
- "Function to tell whether unbalanced text should inhibit Paredit Mode.")
-
-;;;###autoload
-(define-minor-mode paredit-mode
- "Minor mode for pseudo-structurally editing Lisp code.
-With a prefix argument, enable Paredit Mode even if there are
- unbalanced parentheses in the buffer.
-Paredit behaves badly if parentheses are unbalanced, so exercise
- caution when forcing Paredit Mode to be enabled, and consider
- fixing unbalanced parentheses instead.
-\\<paredit-mode-map>"
- :lighter " Paredit"
- ;; Setting `paredit-mode' to false here aborts enabling Paredit Mode.
- (if (and paredit-mode
- (not current-prefix-arg))
- (condition-case condition
- (check-parens)
- (error
- (if (not (funcall paredit-override-check-parens-function condition))
- (progn (setq paredit-mode nil)
- (signal (car condition) (cdr condition))))))))
-
-(defun paredit-override-check-parens-interactively (condition)
- (y-or-n-p (format "Enable Paredit Mode despite condition %S? " condition)))
-
-;;;###autoload
-(defun enable-paredit-mode ()
- "Turn on pseudo-structural editing of Lisp code."
- (interactive)
- (paredit-mode +1))
-
-(defun disable-paredit-mode ()
- "Turn off pseudo-structural editing of Lisp code."
- (interactive)
- (paredit-mode -1))
-
-(defvar paredit-backward-delete-key
- (xcond ((paredit-xemacs-p) "BS")
- ((paredit-gnu-emacs-p) "DEL")))
-
-(defvar paredit-forward-delete-keys
- (xcond ((paredit-xemacs-p) '("DEL"))
- ((paredit-gnu-emacs-p) '("<delete>" "<deletechar>"))))
-
-;;;; Paredit Keys
-
-;;; Separating the definition and initialization of this variable
-;;; simplifies the development of paredit, since re-evaluating DEFVAR
-;;; forms doesn't actually do anything.
-
-(defvar paredit-commands nil
- "List of paredit commands with their keys and examples.")
-
-;;; Each specifier is of the form:
-;;; (key[s] function (example-input example-output) ...)
-;;; where key[s] is either a single string suitable for passing to KBD
-;;; or a list of such strings. Entries in this list may also just be
-;;; strings, in which case they are headings for the next entries.
-
-(progn (setq paredit-commands
- `(
- "Basic Insertion Commands"
- ("(" paredit-open-round
- ("(a b |c d)"
- "(a b (|) c d)")
- ("(foo \"bar |baz\" quux)"
- "(foo \"bar (|baz\" quux)"))
- (")" paredit-close-round
- ("(a b |c )" "(a b c)|")
- ("; Hello,| world!"
- "; Hello,)| world!"))
- ("M-)" paredit-close-round-and-newline
- ("(defun f (x| ))"
- "(defun f (x)\n |)")
- ("; (Foo.|"
- "; (Foo.)|"))
- ("[" paredit-open-square
- ("(a b |c d)"
- "(a b [|] c d)")
- ("(foo \"bar |baz\" quux)"
- "(foo \"bar [|baz\" quux)"))
- ("]" paredit-close-square
- ("(define-key keymap [frob| ] 'frobnicate)"
- "(define-key keymap [frob]| 'frobnicate)")
- ("; [Bar.|"
- "; [Bar.]|"))
-
- ("\"" paredit-doublequote
- ("(frob grovel |full lexical)"
- "(frob grovel \"|\" full lexical)"
- "(frob grovel \"\"| full lexical)")
- ("(foo \"bar |baz\" quux)"
- "(foo \"bar \\\"|baz\" quux)")
- ("(frob grovel) ; full |lexical"
- "(frob grovel) ; full \"|lexical"))
- ("M-\"" paredit-meta-doublequote
- ("(foo \"bar |baz\" quux)"
- "(foo \"bar baz\"| quux)")
- ("(foo |(bar #\\x \"baz \\\\ quux\") zot)"
- ,(concat "(foo \"|(bar #\\\\x \\\"baz \\\\"
- "\\\\ quux\\\")\" zot)")))
- ("\\" paredit-backslash
- ("(string #|)\n ; Character to escape: x"
- "(string #\\x|)")
- ("\"foo|bar\"\n ; Character to escape: \""
- "\"foo\\\"|bar\""))
- (";" paredit-semicolon
- ("|(frob grovel)"
- ";|(frob grovel)")
- ("(frob |grovel)"
- "(frob ;|grovel\n )")
- ("(frob |grovel (bloit\n zargh))"
- "(frob ;|grovel\n (bloit\n zargh))")
- ("(frob grovel) |"
- "(frob grovel) ;|"))
- ("M-;" paredit-comment-dwim
- ("(foo |bar) ; baz"
- "(foo bar) ; |baz")
- ("(frob grovel)|"
- "(frob grovel) ;|")
- ("(zot (foo bar)\n|\n (baz quux))"
- "(zot (foo bar)\n ;; |\n (baz quux))")
- ("(zot (foo bar) |(baz quux))"
- "(zot (foo bar)\n ;; |\n (baz quux))")
- ("|(defun hello-world ...)"
- ";;; |\n(defun hello-world ...)"))
-
- ("C-j" paredit-newline
- ("(let ((n (frobbotz))) |(display (+ n 1)\nport))"
- ,(concat "(let ((n (frobbotz)))"
- "\n |(display (+ n 1)"
- "\n port))")))
-
- "Deleting & Killing"
- (("C-d" ,@paredit-forward-delete-keys)
- paredit-forward-delete
- ("(quu|x \"zot\")" "(quu| \"zot\")")
- ("(quux |\"zot\")"
- "(quux \"|zot\")"
- "(quux \"|ot\")")
- ("(foo (|) bar)" "(foo | bar)")
- ("|(foo bar)" "(|foo bar)"))
- (,paredit-backward-delete-key
- paredit-backward-delete
- ("(\"zot\" q|uux)" "(\"zot\" |uux)")
- ("(\"zot\"| quux)"
- "(\"zot|\" quux)"
- "(\"zo|\" quux)")
- ("(foo (|) bar)" "(foo | bar)")
- ("(foo bar)|" "(foo bar|)"))
- ("C-k" paredit-kill
- ("(foo bar)| ; Useless comment!"
- "(foo bar)|")
- ("(|foo bar) ; Useful comment!"
- "(|) ; Useful comment!")
- ("|(foo bar) ; Useless line!"
- "|")
- ("(foo \"|bar baz\"\n quux)"
- "(foo \"|\"\n quux)"))
- ("M-d" paredit-forward-kill-word
- ("|(foo bar) ; baz"
- "(| bar) ; baz"
- "(|) ; baz"
- "() ;|")
- (";;;| Frobnicate\n(defun frobnicate ...)"
- ";;;|\n(defun frobnicate ...)"
- ";;;\n(| frobnicate ...)"))
- (,(concat "M-" paredit-backward-delete-key)
- paredit-backward-kill-word
- ("(foo bar) ; baz\n(quux)|"
- "(foo bar) ; baz\n(|)"
- "(foo bar) ; |\n()"
- "(foo |) ; \n()"
- "(|) ; \n()"))
-
- "Movement & Navigation"
- ("C-M-f" paredit-forward
- ("(foo |(bar baz) quux)"
- "(foo (bar baz)| quux)")
- ("(foo (bar)|)"
- "(foo (bar))|"))
- ("C-M-b" paredit-backward
- ("(foo (bar baz)| quux)"
- "(foo |(bar baz) quux)")
- ("(|(foo) bar)"
- "|((foo) bar)"))
- ("C-M-u" paredit-backward-up)
- ("C-M-d" paredit-forward-down)
- ("C-M-p" paredit-backward-down) ; Built-in, these are FORWARD-
- ("C-M-n" paredit-forward-up) ; & BACKWARD-LIST, which have
- ; no need given C-M-f & C-M-b.
-
- "Depth-Changing Commands"
- ("M-(" paredit-wrap-round
- ("(foo |bar baz)"
- "(foo (|bar) baz)"))
- ("M-s" paredit-splice-sexp
- ("(foo (bar| baz) quux)"
- "(foo bar| baz quux)"))
- (("M-<up>" "ESC <up>")
- paredit-splice-sexp-killing-backward
- ("(foo (let ((x 5)) |(sqrt n)) bar)"
- "(foo |(sqrt n) bar)"))
- (("M-<down>" "ESC <down>")
- paredit-splice-sexp-killing-forward
- ("(a (b c| d e) f)"
- "(a b c| f)"))
- ("M-r" paredit-raise-sexp
- ("(dynamic-wind in (lambda () |body) out)"
- "(dynamic-wind in |body out)"
- "|body"))
- ("M-?" paredit-convolute-sexp
- ("(let ((x 5) (y 3)) (frob |(zwonk)) (wibblethwop))"
- "(frob |(let ((x 5) (y 3)) (zwonk) (wibblethwop)))"))
-
- "Barfage & Slurpage"
- (("C-)" "C-<right>")
- paredit-forward-slurp-sexp
- ("(foo (bar |baz) quux zot)"
- "(foo (bar |baz quux) zot)")
- ("(a b ((c| d)) e f)"
- "(a b ((c| d) e) f)"))
- (("C-}" "C-<left>")
- paredit-forward-barf-sexp
- ("(foo (bar |baz quux) zot)"
- "(foo (bar |baz) quux zot)"))
- (("C-(" "C-M-<left>" "ESC C-<left>")
- paredit-backward-slurp-sexp
- ("(foo bar (baz| quux) zot)"
- "(foo (bar baz| quux) zot)")
- ("(a b ((c| d)) e f)"
- "(a (b (c| d)) e f)"))
- (("C-{" "C-M-<right>" "ESC C-<right>")
- paredit-backward-barf-sexp
- ("(foo (bar baz |quux) zot)"
- "(foo bar (baz |quux) zot)"))
-
- "Miscellaneous Commands"
- ("M-S" paredit-split-sexp
- ("(hello| world)"
- "(hello)| (world)")
- ("\"Hello, |world!\""
- "\"Hello, \"| \"world!\""))
- ("M-J" paredit-join-sexps
- ("(hello)| (world)"
- "(hello| world)")
- ("\"Hello, \"| \"world!\""
- "\"Hello, |world!\"")
- ("hello-\n| world"
- "hello-|world"))
- ("C-c C-M-l" paredit-recenter-on-sexp)
- ("M-q" paredit-reindent-defun)
- ))
- nil) ; end of PROGN
-
-;;;;; Command Examples
-
-(eval-and-compile
- (defmacro paredit-do-commands (vars string-case &rest body)
- (let ((spec (nth 0 vars))
- (keys (nth 1 vars))
- (fn (nth 2 vars))
- (examples (nth 3 vars)))
- `(dolist (,spec paredit-commands)
- (if (stringp ,spec)
- ,string-case
- (let ((,keys (let ((k (car ,spec)))
- (cond ((stringp k) (list k))
- ((listp k) k)
- (t (error "Invalid paredit command %s."
- ,spec)))))
- (,fn (cadr ,spec))
- (,examples (cddr ,spec)))
- ,@body)))))
-
- (put 'paredit-do-commands 'lisp-indent-function 2))
-
-(defun paredit-define-keys ()
- (paredit-do-commands (spec keys fn examples)
- nil ; string case
- (dolist (key keys)
- (define-key paredit-mode-map (read-kbd-macro key) fn))))
-
-(defun paredit-function-documentation (fn)
- (let ((original-doc (get fn 'paredit-original-documentation))
- (doc (documentation fn 'function-documentation)))
- (or original-doc
- (progn (put fn 'paredit-original-documentation doc)
- doc))))
-
-(defun paredit-annotate-mode-with-examples ()
- (let ((contents
- (list (paredit-function-documentation 'paredit-mode))))
- (paredit-do-commands (spec keys fn examples)
- (push (concat "\n \n" spec "\n")
- contents)
- (let ((name (symbol-name fn)))
- (if (string-match (symbol-name 'paredit-) name)
- (push (concat "\n\n\\[" name "]\t" name
- (if examples
- (mapconcat (lambda (example)
- (concat
- "\n"
- (mapconcat 'identity
- example
- "\n --->\n")
- "\n"))
- examples
- "")
- "\n (no examples)\n"))
- contents))))
- (put 'paredit-mode 'function-documentation
- (apply 'concat (reverse contents))))
- ;; PUT returns the huge string we just constructed, which we don't
- ;; want it to return.
- nil)
-
-(defun paredit-annotate-functions-with-examples ()
- (paredit-do-commands (spec keys fn examples)
- nil ; string case
- (put fn 'function-documentation
- (concat (paredit-function-documentation fn)
- "\n\n\\<paredit-mode-map>\\[" (symbol-name fn) "]\n"
- (mapconcat (lambda (example)
- (concat "\n"
- (mapconcat 'identity
- example
- "\n ->\n")
- "\n"))
- examples
- "")))))
-
-;;;;; HTML Examples
-
-(defun paredit-insert-html-examples ()
- "Insert HTML for a paredit quick reference table."
- (interactive)
- (let ((insert-lines
- (lambda (&rest lines) (dolist (line lines) (insert line) (newline))))
- (initp nil))
- (paredit-do-commands (spec keys fn examples)
- (progn (if initp
- (funcall insert-lines "</table>")
- (setq initp t))
- (funcall insert-lines (concat "<h3>" spec "</h3>"))
- (funcall insert-lines "<table>"))
- (let ((name (symbol-name fn))
- (keys
- (mapconcat (lambda (key)
- (concat "<tt>" (paredit-html-quote key) "</tt>"))
- keys
- ", ")))
- (funcall insert-lines "<tr>")
- (funcall insert-lines (concat " <th align=\"left\">" keys "</th>"))
- (funcall insert-lines (concat " <th align=\"left\">" name "</th>"))
- (funcall insert-lines "</tr>")
- (funcall insert-lines
- "<tr><td colspan=\"2\"><table cellpadding=\"5\"><tr>")
- (dolist (example examples)
- (let ((prefix "<td><table border=\"1\"><tr><td><table><tr><td><pre>")
- (examples
- (mapconcat 'paredit-html-quote
- example
- (concat "</pre></td></tr>"
- "<tr><th>↓</th></tr>"
- "<tr><td><pre>")))
- (suffix "</pre></td></tr></table></td></tr></table></td>"))
- (funcall insert-lines (concat prefix examples suffix))))
- (funcall insert-lines "</tr></table></td></tr>")))
- (funcall insert-lines "</table>")))
-
-(defun paredit-html-quote (string)
- (with-temp-buffer
- (dotimes (i (length string))
- (insert (let ((c (elt string i)))
- (cond ((eq c ?\<) "<")
- ((eq c ?\>) ">")
- ((eq c ?\&) "&")
- ((eq c ?\') "'")
- ((eq c ?\") """)
- (t c)))))
- (buffer-string)))
-
-;;;; Delimiter Insertion
-
-(eval-and-compile
- (defun paredit-conc-name (&rest strings)
- (intern (apply 'concat strings)))
-
- (defmacro define-paredit-pair (open close name)
- `(progn
- (defun ,(paredit-conc-name "paredit-open-" name) (&optional n)
- ,(concat "Insert a balanced " name " pair.
-With a prefix argument N, put the closing " name " after N
- S-expressions forward.
-If the region is active, `transient-mark-mode' is enabled, and the
- region's start and end fall in the same parenthesis depth, insert a
- " name " pair around the region.
-If in a string or a comment, insert a single " name ".
-If in a character literal, do nothing. This prevents changing what was
- in the character literal to a meaningful delimiter unintentionally.")
- (interactive "P")
- (cond ((or (paredit-in-string-p)
- (paredit-in-comment-p))
- (insert ,open))
- ((not (paredit-in-char-p))
- (paredit-insert-pair n ,open ,close 'goto-char)
- (save-excursion (backward-up-list) (indent-sexp)))))
- (defun ,(paredit-conc-name "paredit-close-" name) ()
- ,(concat "Move past one closing delimiter and reindent.
-\(Agnostic to the specific closing delimiter.)
-If in a string or comment, insert a single closing " name ".
-If in a character literal, do nothing. This prevents changing what was
- in the character literal to a meaningful delimiter unintentionally.")
- (interactive)
- (paredit-move-past-close ,close))
- (defun ,(paredit-conc-name "paredit-close-" name "-and-newline") ()
- ,(concat "Move past one closing delimiter, add a newline,"
- " and reindent.
-If there was a margin comment after the closing delimiter, preserve it
- on the same line.")
- (interactive)
- (paredit-move-past-close-and-newline ,close))
- (defun ,(paredit-conc-name "paredit-wrap-" name)
- (&optional argument)
- ,(concat "Wrap the following S-expression.
-See `paredit-wrap-sexp' for more details.")
- (interactive "P")
- (paredit-wrap-sexp argument ,open ,close))
- (add-to-list 'paredit-wrap-commands
- ',(paredit-conc-name "paredit-wrap-" name)))))
-
-(defvar paredit-wrap-commands '(paredit-wrap-sexp)
- "List of paredit commands that wrap S-expressions.
-Used by `paredit-yank-pop'; for internal paredit use only.")
-
-(define-paredit-pair ?\( ?\) "round")
-(define-paredit-pair ?\[ ?\] "square")
-(define-paredit-pair ?\{ ?\} "curly")
-(define-paredit-pair ?\< ?\> "angled")
-
-;;; Aliases for the old names.
-
-(defalias 'paredit-open-parenthesis 'paredit-open-round)
-(defalias 'paredit-close-parenthesis 'paredit-close-round)
-(defalias 'paredit-close-parenthesis-and-newline
- 'paredit-close-round-and-newline)
-
-(defalias 'paredit-open-bracket 'paredit-open-square)
-(defalias 'paredit-close-bracket 'paredit-close-square)
-(defalias 'paredit-close-bracket-and-newline
- 'paredit-close-square-and-newline)
-
-(defun paredit-move-past-close (close)
- (paredit-move-past-close-and close
- (lambda ()
- (paredit-blink-paren-match nil))))
-
-(defun paredit-move-past-close-and-newline (close)
- (paredit-move-past-close-and close
- (lambda ()
- (let ((comment.point (paredit-find-comment-on-line)))
- (newline)
- (if comment.point
- (save-excursion
- (forward-line -1)
- (end-of-line)
- (indent-to (cdr comment.point))
- (insert (car comment.point)))))
- (lisp-indent-line)
- (paredit-ignore-sexp-errors (indent-sexp))
- (paredit-blink-paren-match t))))
-
-(defun paredit-move-past-close-and (close if-moved)
- (if (or (paredit-in-string-p)
- (paredit-in-comment-p))
- (insert close)
- (if (paredit-in-char-p) (forward-char))
- (paredit-move-past-close-and-reindent close)
- (funcall if-moved)))
-
-(defun paredit-find-comment-on-line ()
- "Find a margin comment on the current line.
-Return nil if there is no such comment or if there is anything but
- whitespace until such a comment.
-If such a comment exists, delete the comment (including all leading
- whitespace) and return a cons whose car is the comment as a string
- and whose cdr is the point of the comment's initial semicolon,
- relative to the start of the line."
- (save-excursion
- (paredit-skip-whitespace t (point-at-eol))
- (and (eq ?\; (char-after))
- (not (eq ?\; (char-after (1+ (point)))))
- (not (or (paredit-in-string-p)
- (paredit-in-char-p)))
- (let* ((start ;Move to before the semicolon.
- (progn (backward-char) (point)))
- (comment
- (buffer-substring start (point-at-eol))))
- (paredit-skip-whitespace nil (point-at-bol))
- (delete-region (point) (point-at-eol))
- (cons comment (- start (point-at-bol)))))))
-
-(defun paredit-insert-pair (n open close forward)
- (let* ((regionp
- (and (paredit-region-active-p)
- (paredit-region-safe-for-insert-p)))
- (end
- (and regionp
- (not n)
- (prog1 (region-end) (goto-char (region-beginning))))))
- (let ((spacep (paredit-space-for-delimiter-p nil open)))
- (if spacep (insert " "))
- (insert open)
- (save-excursion
- ;; Move past the desired region.
- (cond (n
- (funcall forward
- (paredit-scan-sexps-hack (point)
- (prefix-numeric-value n))))
- (regionp
- (funcall forward (+ end (if spacep 2 1)))))
- ;; The string case can happen if we are inserting string
- ;; delimiters. The comment case may happen by moving to the
- ;; end of a buffer that has a comment with no trailing newline.
- (if (and (not (paredit-in-string-p))
- (paredit-in-comment-p))
- (newline))
- (insert close)
- (if (paredit-space-for-delimiter-p t close)
- (insert " "))))))
-
-;++ This needs a better name...
-
-(defun paredit-scan-sexps-hack (point n)
- (save-excursion
- (goto-char point)
- (let ((direction (if (< 0 n) +1 -1))
- (magnitude (abs n))
- (count 0))
- (catch 'exit
- (while (< count magnitude)
- (let ((p
- (paredit-handle-sexp-errors (scan-sexps (point) direction)
- nil)))
- (if (not p) (throw 'exit nil))
- (goto-char p))
- (setq count (+ count 1)))))
- (point)))
-
-(defun paredit-region-safe-for-insert-p ()
- (save-excursion
- (let ((beginning (region-beginning))
- (end (region-end)))
- (goto-char beginning)
- (let* ((beginning-state (paredit-current-parse-state))
- (end-state
- (parse-partial-sexp beginning end nil nil beginning-state)))
- (and (= (nth 0 beginning-state) ; 0. depth in parens
- (nth 0 end-state))
- (eq (nth 3 beginning-state) ; 3. non-nil if inside a
- (nth 3 end-state)) ; string
- (eq (nth 4 beginning-state) ; 4. comment status, yada
- (nth 4 end-state))
- (eq (nth 5 beginning-state) ; 5. t if following char
- (nth 5 end-state))))))) ; quote
-
-(defvar paredit-space-for-delimiter-predicates nil
- "List of predicates for whether to put space by delimiter at point.
-Each predicate is a function that is is applied to two arguments, ENDP
- and DELIMITER, and that returns a boolean saying whether to put a
- space next to the delimiter -- before the delimiter if ENDP is false,
- after the delimiter if ENDP is true.
-If any predicate returns false, no space is inserted: every predicate
- has veto power.
-Each predicate may assume that the point is not at the beginning of the
- buffer, if ENDP is false, or at the end of the buffer, if ENDP is
- true; and that the point is not preceded, if ENDP is false, or
- followed, if ENDP is true, by a word or symbol constituent, a quote,
- or the delimiter matching DELIMITER.
-Each predicate should examine only text before the point, if ENDP is
- false, or only text after the point, if ENDP is true.")
-
-(defun paredit-space-for-delimiter-p (endp delimiter)
- ;; If at the buffer limit, don't insert a space. If there is a word,
- ;; symbol, other quote, or non-matching parenthesis delimiter (i.e. a
- ;; close when want an open the string or an open when we want to
- ;; close the string), do insert a space.
- (and (not (if endp (eobp) (bobp)))
- (memq (char-syntax (if endp (char-after) (char-before)))
- (list ?w ?_ ?\"
- (let ((matching (matching-paren delimiter)))
- (and matching (char-syntax matching)))
- (and (not endp)
- (eq ?\" (char-syntax delimiter))
- ?\) )))
- (catch 'exit
- (dolist (predicate paredit-space-for-delimiter-predicates)
- (if (not (funcall predicate endp delimiter))
- (throw 'exit nil)))
- t)))
-
-(defun paredit-move-past-close-and-reindent (close)
- (let ((open (paredit-missing-close)))
- (if open
- (if (eq close (matching-paren open))
- (save-excursion
- (message "Missing closing delimiter: %c" close)
- (insert close))
- (error "Mismatched missing closing delimiter: %c ... %c"
- open close))))
- (up-list)
- (if (catch 'return ; This CATCH returns T if it
- (while t ; should delete leading spaces
- (save-excursion ; and NIL if not.
- (let ((before-paren (1- (point))))
- (back-to-indentation)
- (cond ((not (eq (point) before-paren))
- ;; Can't call PAREDIT-DELETE-LEADING-WHITESPACE
- ;; here -- we must return from SAVE-EXCURSION
- ;; first.
- (throw 'return t))
- ((save-excursion (forward-line -1)
- (end-of-line)
- (paredit-in-comment-p))
- ;; Moving the closing delimiter any further
- ;; would put it into a comment, so we just
- ;; indent the closing delimiter where it is and
- ;; abort the loop, telling its continuation that
- ;; no leading whitespace should be deleted.
- (lisp-indent-line)
- (throw 'return nil))
- (t (delete-indentation)))))))
- (paredit-delete-leading-whitespace)))
-
-(defun paredit-missing-close ()
- (save-excursion
- (paredit-handle-sexp-errors (backward-up-list)
- (error "Not inside a list."))
- (let ((open (char-after)))
- (paredit-handle-sexp-errors (progn (forward-sexp) nil)
- open))))
-
-(defun paredit-delete-leading-whitespace ()
- ;; This assumes that we're on the closing delimiter already.
- (save-excursion
- (backward-char)
- (while (let ((syn (char-syntax (char-before))))
- (and (or (eq syn ?\ ) (eq syn ?-)) ; whitespace syntax
- ;; The above line is a perfect example of why the
- ;; following test is necessary.
- (not (paredit-in-char-p (1- (point))))))
- (delete-char -1))))
-
-(defun paredit-blink-paren-match (another-line-p)
- (if (and blink-matching-paren
- (or (not show-paren-mode) another-line-p))
- (paredit-ignore-sexp-errors
- (save-excursion
- (backward-sexp)
- (forward-sexp)
- ;; SHOW-PAREN-MODE inhibits any blinking, so we disable it
- ;; locally here.
- (let ((show-paren-mode nil))
- (blink-matching-open))))))
-
-(defun paredit-doublequote (&optional n)
- "Insert a pair of double-quotes.
-With a prefix argument N, wrap the following N S-expressions in
- double-quotes, escaping intermediate characters if necessary.
-If the region is active, `transient-mark-mode' is enabled, and the
- region's start and end fall in the same parenthesis depth, insert a
- pair of double-quotes around the region, again escaping intermediate
- characters if necessary.
-Inside a comment, insert a literal double-quote.
-At the end of a string, move past the closing double-quote.
-In the middle of a string, insert a backslash-escaped double-quote.
-If in a character literal, do nothing. This prevents accidentally
- changing a what was in the character literal to become a meaningful
- delimiter unintentionally."
- (interactive "P")
- (cond ((paredit-in-string-p)
- (if (eq (point) (- (paredit-enclosing-string-end) 1))
- (forward-char) ; Just move past the closing quote.
- ;; Don't split a \x into an escaped backslash and a string end.
- (if (paredit-in-string-escape-p) (forward-char))
- (insert ?\\ ?\" )))
- ((paredit-in-comment-p)
- (insert ?\" ))
- ((not (paredit-in-char-p))
- (paredit-insert-pair n ?\" ?\" 'paredit-forward-for-quote))))
-
-(defun paredit-meta-doublequote (&optional n)
- "Move to the end of the string.
-If not in a string, act as `paredit-doublequote'; if not prefix argument
- is specified and the region is not active or `transient-mark-mode' is
- disabled, the default is to wrap one S-expression, however, not zero."
- (interactive "P")
- (if (not (paredit-in-string-p))
- (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
- (goto-char (paredit-enclosing-string-end))))
-
-(defun paredit-meta-doublequote-and-newline (&optional n)
- "Move to the end of the string, insert a newline, and indent.
-If not in a string, act as `paredit-doublequote'; if not prefix argument
- is specified and the region is not active or `transient-mark-mode' is
- disabled, the default is to wrap one S-expression, however, not zero."
- (interactive "P")
- (if (not (paredit-in-string-p))
- (paredit-doublequote (or n (and (not (paredit-region-active-p)) 1)))
- (progn (goto-char (paredit-enclosing-string-end))
- (newline)
- (lisp-indent-line)
- (paredit-ignore-sexp-errors (indent-sexp)))))
-
-(defun paredit-forward-for-quote (end)
- (let ((state (paredit-current-parse-state)))
- (while (< (point) end)
- (let ((new-state (parse-partial-sexp (point) (1+ (point))
- nil nil state)))
- (if (paredit-in-string-p new-state)
- (if (not (paredit-in-string-escape-p))
- (setq state new-state)
- ;; Escape character: turn it into an escaped escape
- ;; character by appending another backslash.
- (insert ?\\ )
- ;; Now the point is after both escapes, and we want to
- ;; rescan from before the first one to after the second
- ;; one.
- (setq state
- (parse-partial-sexp (- (point) 2) (point)
- nil nil state))
- ;; Advance the end point, since we just inserted a new
- ;; character.
- (setq end (1+ end)))
- ;; String: escape by inserting a backslash before the quote.
- (backward-char)
- (insert ?\\ )
- ;; The point is now between the escape and the quote, and we
- ;; want to rescan from before the escape to after the quote.
- (setq state
- (parse-partial-sexp (1- (point)) (1+ (point))
- nil nil state))
- ;; Advance the end point for the same reason as above.
- (setq end (1+ end)))))))
-
-;;;; Escape Insertion
-
-(defun paredit-backslash ()
- "Insert a backslash followed by a character to escape."
- (interactive)
- (cond ((paredit-in-string-p) (paredit-backslash-interactive))
- ((paredit-in-comment-p) (insert ?\\))
- ((paredit-in-char-p) (forward-char) (paredit-backslash-interactive))
- (t (paredit-backslash-interactive))))
-
-(defun paredit-backslash-interactive ()
- (insert ?\\ )
- ;; Read a character to insert after the backslash. If anything
- ;; goes wrong -- the user hits delete (entering the rubout
- ;; `character'), aborts with C-g, or enters non-character input
- ;; -- then delete the backslash to avoid a dangling escape.
- (let ((delete-p t))
- (unwind-protect
- (let ((char (read-char "Character to escape: ")))
- (if (not (eq char ?\^?))
- (progn (message "Character to escape: %c" char)
- (insert char)
- (setq delete-p nil))))
- (if delete-p
- (progn (message "Deleting escape.")
- (delete-char -1))))))
-
-(defun paredit-newline ()
- "Insert a newline and indent it.
-This is like `newline-and-indent', but it not only indents the line
- that the point is on but also the S-expression following the point,
- if there is one.
-Move forward one character first if on an escaped character.
-If in a string, just insert a literal newline.
-If in a comment and if followed by invalid structure, call
- `indent-new-comment-line' to keep the invalid structure in a
- comment."
- (interactive)
- (cond ((paredit-in-string-p)
- (newline))
- ((paredit-in-comment-p)
- (if (paredit-region-ok-p (point) (point-at-eol))
- (progn (newline-and-indent)
- (paredit-ignore-sexp-errors (indent-sexp)))
- (indent-new-comment-line)))
- (t
- (if (paredit-in-char-p)
- (forward-char))
- (newline-and-indent)
- ;; Indent the following S-expression, but don't signal an
- ;; error if there's only a closing delimiter after the point.
- (paredit-ignore-sexp-errors (indent-sexp)))))
-
-(defun paredit-reindent-defun (&optional argument)
- "Reindent the definition that the point is on.
-If the point is in a string or a comment, fill the paragraph instead,
- and with a prefix argument, justify as well."
- (interactive "P")
- (if (or (paredit-in-string-p)
- (paredit-in-comment-p))
- (lisp-fill-paragraph argument)
- (paredit-preserving-column
- (save-excursion
- (end-of-defun)
- (beginning-of-defun)
- (indent-sexp)))))
-
-;;;; Comment Insertion
-
-(defun paredit-semicolon (&optional n)
- "Insert a semicolon.
-With a prefix argument N, insert N semicolons.
-If in a string, do just that and nothing else.
-If in a character literal, move to the beginning of the character
- literal before inserting the semicolon.
-If the enclosing list ends on the line after the point, break the line
- after the last S-expression following the point.
-If a list begins on the line after the point but ends on a different
- line, break the line after the last S-expression following the point
- before the list."
- (interactive "p")
- (if (or (paredit-in-string-p) (paredit-in-comment-p))
- (insert (make-string (or n 1) ?\; ))
- (if (paredit-in-char-p)
- (backward-char 2))
- (let ((line-break-point (paredit-semicolon-find-line-break-point)))
- (if line-break-point
- (paredit-semicolon-with-line-break line-break-point (or n 1))
- (insert (make-string (or n 1) ?\; ))))))
-
-(defun paredit-semicolon-find-line-break-point ()
- (and (not (eolp)) ;Implies (not (eobp)).
- (let ((eol (point-at-eol)))
- (save-excursion
- (catch 'exit
- (while t
- (let ((line-break-point (point)))
- (cond ((paredit-handle-sexp-errors (progn (forward-sexp) t)
- nil)
- ;; Successfully advanced by an S-expression.
- ;; If that S-expression started on this line
- ;; and ended on another one, break here.
- (cond ((not (eq eol (point-at-eol)))
- (throw 'exit
- (and (save-excursion
- (backward-sexp)
- (eq eol (point-at-eol)))
- line-break-point)))
- ((eobp)
- (throw 'exit nil))))
- ((save-excursion
- (paredit-skip-whitespace t (point-at-eol))
- (or (eolp) (eobp) (eq (char-after) ?\;)))
- ;; Can't move further, but there's no closing
- ;; delimiter we're about to clobber -- either
- ;; it's on the next line or we're at the end of
- ;; the buffer. Don't break the line.
- (throw 'exit nil))
- (t
- ;; Can't move because we hit a delimiter at the
- ;; end of this line. Break here.
- (throw 'exit line-break-point))))))))))
-
-(defun paredit-semicolon-with-line-break (line-break-point n)
- (let ((line-break-marker (make-marker)))
- (set-marker line-break-marker line-break-point)
- (set-marker-insertion-type line-break-marker t)
- (insert (make-string (or n 1) ?\; ))
- (save-excursion
- (goto-char line-break-marker)
- (set-marker line-break-marker nil)
- (newline)
- (lisp-indent-line)
- ;; This step is redundant if we are inside a list, but even if we
- ;; are at the top level, we want at least to indent whatever we
- ;; bumped off the line.
- (paredit-ignore-sexp-errors (indent-sexp))
- (paredit-indent-sexps))))
-
-;;; This is all a horrible, horrible hack, primarily for GNU Emacs 21,
-;;; in which there is no `comment-or-uncomment-region'.
-
-(autoload 'comment-forward "newcomment")
-(autoload 'comment-normalize-vars "newcomment")
-(autoload 'comment-region "newcomment")
-(autoload 'comment-search-forward "newcomment")
-(autoload 'uncomment-region "newcomment")
-
-(defun paredit-initialize-comment-dwim ()
- (require 'newcomment)
- (if (not (fboundp 'comment-or-uncomment-region))
- (defalias 'comment-or-uncomment-region
- (lambda (beginning end &optional argument)
- (interactive "*r\nP")
- (if (save-excursion (goto-char beginning)
- (comment-forward (point-max))
- (<= end (point)))
- (uncomment-region beginning end argument)
- (comment-region beginning end argument)))))
- (defalias 'paredit-initialize-comment-dwim 'comment-normalize-vars)
- (comment-normalize-vars))
-
-(defun paredit-comment-dwim (&optional argument)
- "Call the Lisp comment command you want (Do What I Mean).
-This is like `comment-dwim', but it is specialized for Lisp editing.
-If transient mark mode is enabled and the mark is active, comment or
- uncomment the selected region, depending on whether it was entirely
- commented not not already.
-If there is already a comment on the current line, with no prefix
- argument, indent to that comment; with a prefix argument, kill that
- comment.
-Otherwise, insert a comment appropriate for the context and ensure that
- any code following the comment is moved to the next line.
-At the top level, where indentation is calculated to be at column 0,
- insert a triple-semicolon comment; within code, where the indentation
- is calculated to be non-zero, and on the line there is either no code
- at all or code after the point, insert a double-semicolon comment;
- and if the point is after all code on the line, insert a single-
- semicolon margin comment at `comment-column'."
- (interactive "*P")
- (paredit-initialize-comment-dwim)
- (cond ((paredit-region-active-p)
- (comment-or-uncomment-region (region-beginning)
- (region-end)
- argument))
- ((paredit-comment-on-line-p)
- (if argument
- (comment-kill (if (integerp argument) argument nil))
- (comment-indent)))
- (t (paredit-insert-comment))))
-
-(defun paredit-comment-on-line-p ()
- "True if there is a comment on the line following point.
-This is expected to be called only in `paredit-comment-dwim'; do not
- call it elsewhere."
- (save-excursion
- (beginning-of-line)
- (let ((comment-p nil))
- ;; Search forward for a comment beginning. If there is one, set
- ;; COMMENT-P to true; if not, it will be nil.
- (while (progn
- (setq comment-p ;t -> no error
- (comment-search-forward (point-at-eol) t))
- (and comment-p
- (or (paredit-in-string-p)
- (paredit-in-char-p (1- (point))))))
- (forward-char))
- comment-p)))
-
-(defun paredit-insert-comment ()
- (let ((code-after-p
- (save-excursion (paredit-skip-whitespace t (point-at-eol))
- (not (eolp))))
- (code-before-p
- (save-excursion (paredit-skip-whitespace nil (point-at-bol))
- (not (bolp)))))
- (cond ((and (bolp)
- (let ((indent
- (let ((indent (calculate-lisp-indent)))
- (if (consp indent) (car indent) indent))))
- (and indent (zerop indent))))
- ;; Top-level comment
- (if code-after-p (save-excursion (newline)))
- (insert ";;; "))
- ((or code-after-p (not code-before-p))
- ;; Code comment
- (if code-before-p
- (newline-and-indent)
- (lisp-indent-line))
- (insert ";; ")
- (if code-after-p
- (save-excursion
- (newline)
- (lisp-indent-line)
- (paredit-indent-sexps))))
- (t
- ;; Margin comment
- (indent-to comment-column 1) ; 1 -> force one leading space
- (insert ?\; )))))
-
-;;;; Character Deletion
-
-(defun paredit-forward-delete (&optional argument)
- "Delete a character forward or move forward over a delimiter.
-If on an opening S-expression delimiter, move forward into the
- S-expression.
-If on a closing S-expression delimiter, refuse to delete unless the
- S-expression is empty, in which case delete the whole S-expression.
-With a numeric prefix argument N, delete N characters forward.
-With a `C-u' prefix argument, simply delete a character forward,
- without regard for delimiter balancing."
- (interactive "P")
- (cond ((or (consp argument) (eobp))
- (delete-char +1))
- ((integerp argument)
- (if (< argument 0)
- (paredit-backward-delete argument)
- (while (> argument 0)
- (paredit-forward-delete)
- (setq argument (- argument 1)))))
- ((paredit-in-string-p)
- (paredit-forward-delete-in-string))
- ((paredit-in-comment-p)
- (paredit-forward-delete-in-comment))
- ((paredit-in-char-p) ; Escape -- delete both chars.
- (delete-char -1)
- (delete-char +1))
- ((eq (char-after) ?\\ ) ; ditto
- (delete-char +2))
- ((let ((syn (char-syntax (char-after))))
- (or (eq syn ?\( )
- (eq syn ?\" )))
- (if (save-excursion
- (paredit-handle-sexp-errors (progn (forward-sexp) t)
- nil))
- (forward-char)
- (message "Deleting spurious opening delimiter.")
- (delete-char +1)))
- ((and (not (paredit-in-char-p (1- (point))))
- (eq (char-syntax (char-after)) ?\) )
- (eq (char-before) (matching-paren (char-after))))
- (delete-char -1) ; Empty list -- delete both
- (delete-char +1)) ; delimiters.
- ((eq ?\; (char-after))
- (paredit-forward-delete-comment-start))
- ((eq (char-syntax (char-after)) ?\) )
- (if (paredit-handle-sexp-errors
- (save-excursion (forward-char) (backward-sexp) t)
- nil)
- (message "End of list!")
- (progn
- (message "Deleting spurious closing delimiter.")
- (delete-char +1))))
- ;; Just delete a single character, if it's not a closing
- ;; delimiter. (The character literal case is already handled
- ;; by now.)
- (t (delete-char +1))))
-
-(defun paredit-forward-delete-in-string ()
- (let ((start+end (paredit-string-start+end-points)))
- (cond ((not (eq (point) (cdr start+end)))
- ;; If it's not the close-quote, it's safe to delete. But
- ;; first handle the case that we're in a string escape.
- (cond ((paredit-in-string-escape-p)
- ;; We're right after the backslash, so backward
- ;; delete it before deleting the escaped character.
- (delete-char -1))
- ((eq (char-after) ?\\ )
- ;; If we're not in a string escape, but we are on a
- ;; backslash, it must start the escape for the next
- ;; character, so delete the backslash before deleting
- ;; the next character.
- (delete-char +1)))
- (delete-char +1))
- ((eq (1- (point)) (car start+end))
- ;; If it is the close-quote, delete only if we're also right
- ;; past the open-quote (i.e. it's empty), and then delete
- ;; both quotes. Otherwise we refuse to delete it.
- (delete-char -1)
- (delete-char +1)))))
-
-(defun paredit-check-forward-delete-in-comment ()
- ;; Point is in a comment, possibly at eol. We are about to delete
- ;; some characters forward; if we are at eol, we are about to delete
- ;; the line break. Refuse to do so if if moving the next line into
- ;; the comment would break structure.
- (if (eolp)
- (let ((next-line-start (point-at-bol 2))
- (next-line-end (point-at-eol 2)))
- (paredit-check-region next-line-start next-line-end))))
-
-(defun paredit-forward-delete-in-comment ()
- (paredit-check-forward-delete-in-comment)
- (delete-char +1))
-
-(defun paredit-forward-delete-comment-start ()
- ;; Point precedes a comment start (not at eol). Refuse to delete a
- ;; comment start if the comment contains unbalanced junk.
- (paredit-check-region (+ (point) 1) (point-at-eol))
- (delete-char +1))
-
-(defun paredit-backward-delete (&optional argument)
- "Delete a character backward or move backward over a delimiter.
-If on a closing S-expression delimiter, move backward into the
- S-expression.
-If on an opening S-expression delimiter, refuse to delete unless the
- S-expression is empty, in which case delete the whole S-expression.
-With a numeric prefix argument N, delete N characters backward.
-With a `C-u' prefix argument, simply delete a character backward,
- without regard for delimiter balancing."
- (interactive "P")
- (cond ((or (consp argument) (bobp))
- ;++ Should this untabify?
- (delete-char -1))
- ((integerp argument)
- (if (< argument 0)
- (paredit-forward-delete (- 0 argument))
- (while (> argument 0)
- (paredit-backward-delete)
- (setq argument (- argument 1)))))
- ((paredit-in-string-p)
- (paredit-backward-delete-in-string))
- ((paredit-in-comment-p)
- (paredit-backward-delete-in-comment))
- ((paredit-in-char-p) ; Escape -- delete both chars.
- (delete-char -1)
- (delete-char +1))
- ((paredit-in-char-p (1- (point)))
- (delete-char -2)) ; ditto
- ((let ((syn (char-syntax (char-before))))
- (or (eq syn ?\) )
- (eq syn ?\" )))
- (if (save-excursion
- (paredit-handle-sexp-errors (progn (backward-sexp) t)
- nil))
- (backward-char)
- (message "Deleting spurious closing delimiter.")
- (delete-char -1)))
- ((and (eq (char-syntax (char-before)) ?\( )
- (eq (char-after) (matching-paren (char-before))))
- (delete-char -1) ; Empty list -- delete both
- (delete-char +1)) ; delimiters.
- ((bolp)
- (paredit-backward-delete-maybe-comment-end))
- ((eq (char-syntax (char-before)) ?\( )
- (if (paredit-handle-sexp-errors
- (save-excursion (backward-char) (forward-sexp) t)
- nil)
- (message "Beginning of list!")
- (progn
- (message "Deleting spurious closing delimiter.")
- (delete-char -1))))
- ;; Delete it, unless it's an opening delimiter. The case of
- ;; character literals is already handled by now.
- (t
- ;; Turn off the @#&*&!^&(%^ botch in GNU Emacs 24 that changed
- ;; `backward-delete-char' and `backward-delete-char-untabify'
- ;; semantically so that they delete the region in transient
- ;; mark mode.
- (let ((delete-active-region nil))
- (backward-delete-char-untabify +1)))))
-
-(defun paredit-backward-delete-in-string ()
- (let ((start+end (paredit-string-start+end-points)))
- (cond ((not (eq (1- (point)) (car start+end)))
- ;; If it's not the open-quote, it's safe to delete.
- (if (paredit-in-string-escape-p)
- ;; If we're on a string escape, since we're about to
- ;; delete the backslash, we must first delete the
- ;; escaped char.
- (delete-char +1))
- (delete-char -1)
- (if (paredit-in-string-escape-p)
- ;; If, after deleting a character, we find ourselves in
- ;; a string escape, we must have deleted the escaped
- ;; character, and the backslash is behind the point, so
- ;; backward delete it.
- (delete-char -1)))
- ((eq (point) (cdr start+end))
- ;; If it is the open-quote, delete only if we're also right
- ;; past the close-quote (i.e. it's empty), and then delete
- ;; both quotes. Otherwise we refuse to delete it.
- (delete-char -1)
- (delete-char +1)))))
-
-(defun paredit-backward-delete-in-comment ()
- ;; Point is in a comment, possibly just after the comment start.
- ;; Refuse to delete a comment start if the comment contains
- ;; unbalanced junk.
- (if (save-excursion
- (backward-char)
- ;; Must call `paredit-in-string-p' before
- ;; `paredit-in-comment-p'.
- (not (or (paredit-in-string-p) (paredit-in-comment-p))))
- (paredit-check-region (point) (point-at-eol)))
- (backward-delete-char-untabify +1))
-
-(defun paredit-backward-delete-maybe-comment-end ()
- ;; Point is at bol, possibly just after a comment end (i.e., the
- ;; previous line may have had a line comment). Refuse to delete a
- ;; comment end if moving the current line into the previous line's
- ;; comment would break structure.
- (if (save-excursion
- (backward-char)
- (and (not (paredit-in-string-p)) (paredit-in-comment-p)))
- (paredit-check-region (point-at-eol) (point-at-bol)))
- (delete-char -1))
-
-;;;; Killing
-
-(defun paredit-kill (&optional argument)
- "Kill a line as if with `kill-line', but respecting delimiters.
-In a string, act exactly as `kill-line' but do not kill past the
- closing string delimiter.
-On a line with no S-expressions on it starting after the point or
- within a comment, act exactly as `kill-line'.
-Otherwise, kill all S-expressions that start after the point.
-With a `C-u' prefix argument, just do the standard `kill-line'.
-With a numeric prefix argument N, do `kill-line' that many times."
- (interactive "P")
- (cond (argument
- (kill-line (if (integerp argument) argument 1)))
- ((paredit-in-string-p)
- (paredit-kill-line-in-string))
- ((paredit-in-comment-p)
- (paredit-kill-line-in-comment))
- ((save-excursion (paredit-skip-whitespace t (point-at-eol))
- (or (eolp) (eq (char-after) ?\; )))
- ;** Be careful about trailing backslashes.
- (if (paredit-in-char-p)
- (backward-char))
- (kill-line))
- (t (paredit-kill-sexps-on-line))))
-
-(defun paredit-kill-line-in-string ()
- (if (save-excursion (paredit-skip-whitespace t (point-at-eol))
- (eolp))
- (kill-line)
- (save-excursion
- ;; Be careful not to split an escape sequence.
- (if (paredit-in-string-escape-p)
- (backward-char))
- (kill-region (point)
- (min (point-at-eol)
- (cdr (paredit-string-start+end-points)))))))
-
-(defun paredit-kill-line-in-comment ()
- ;; The variable `kill-whole-line' is not relevant: the point is in a
- ;; comment, and hence not at the beginning of the line.
- (paredit-check-forward-delete-in-comment)
- (kill-line))
-
-(defun paredit-kill-sexps-on-line ()
- (if (paredit-in-char-p) ; Move past the \ and prefix.
- (backward-char 2)) ; (# in Scheme/CL, ? in elisp)
- (let ((beginning (point))
- (eol (point-at-eol)))
- (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
- ;; If we got to the end of the list and it's on the same line,
- ;; move backward past the closing delimiter before killing. (This
- ;; allows something like killing the whitespace in ( ).)
- (if end-of-list-p (progn (up-list) (backward-char)))
- (if kill-whole-line
- (paredit-kill-sexps-on-whole-line beginning)
- (kill-region beginning
- ;; If all of the S-expressions were on one line,
- ;; i.e. we're still on that line after moving past
- ;; the last one, kill the whole line, including
- ;; any comments; otherwise just kill to the end of
- ;; the last S-expression we found. Be sure,
- ;; though, not to kill any closing parentheses.
- (if (and (not end-of-list-p)
- (eq (point-at-eol) eol))
- eol
- (point)))))))
-
-;;; Please do not try to understand this code unless you have a VERY
-;;; good reason to do so. I gave up trying to figure it out well
-;;; enough to explain it, long ago.
-
-(defun paredit-forward-sexps-to-kill (beginning eol)
- (let ((end-of-list-p nil)
- (firstp t))
- ;; Move to the end of the last S-expression that started on this
- ;; line, or to the closing delimiter if the last S-expression in
- ;; this list is on the line.
- (catch 'return
- (while t
- ;; This and the `kill-whole-line' business below fix a bug that
- ;; inhibited any S-expression at the very end of the buffer
- ;; (with no trailing newline) from being deleted. It's a
- ;; bizarre fix that I ought to document at some point, but I am
- ;; too busy at the moment to do so.
- (if (and kill-whole-line (eobp)) (throw 'return nil))
- (save-excursion
- (paredit-handle-sexp-errors (forward-sexp)
- (up-list)
- (setq end-of-list-p (eq (point-at-eol) eol))
- (throw 'return nil))
- (if (or (and (not firstp)
- (not kill-whole-line)
- (eobp))
- (paredit-handle-sexp-errors
- (progn (backward-sexp) nil)
- t)
- (not (eq (point-at-eol) eol)))
- (throw 'return nil)))
- (forward-sexp)
- (if (and firstp
- (not kill-whole-line)
- (eobp))
- (throw 'return nil))
- (setq firstp nil)))
- end-of-list-p))
-
-(defun paredit-kill-sexps-on-whole-line (beginning)
- (kill-region beginning
- (or (save-excursion ; Delete trailing indentation...
- (paredit-skip-whitespace t)
- (and (not (eq (char-after) ?\; ))
- (point)))
- ;; ...or just use the point past the newline, if
- ;; we encounter a comment.
- (point-at-eol)))
- (cond ((save-excursion (paredit-skip-whitespace nil (point-at-bol))
- (bolp))
- ;; Nothing but indentation before the point, so indent it.
- (lisp-indent-line))
- ((eobp) nil) ; Protect the CHAR-SYNTAX below against NIL.
- ;; Insert a space to avoid invalid joining if necessary.
- ((let ((syn-before (char-syntax (char-before)))
- (syn-after (char-syntax (char-after))))
- (or (and (eq syn-before ?\) ) ; Separate opposing
- (eq syn-after ?\( )) ; parentheses,
- (and (eq syn-before ?\" ) ; string delimiter
- (eq syn-after ?\" )) ; pairs,
- (and (memq syn-before '(?_ ?w)) ; or word or symbol
- (memq syn-after '(?_ ?w))))) ; constituents.
- (insert " "))))
-
-;;;;; Killing Words
-
-;;; This is tricky and asymmetrical because backward parsing is
-;;; extraordinarily difficult or impossible, so we have to implement
-;;; killing in both directions by parsing forward.
-
-(defun paredit-forward-kill-word ()
- "Kill a word forward, skipping over intervening delimiters."
- (interactive)
- (let ((beginning (point)))
- (skip-syntax-forward " -")
- (let* ((parse-state (paredit-current-parse-state))
- (state (paredit-kill-word-state parse-state 'char-after)))
- (while (not (or (eobp)
- (eq ?w (char-syntax (char-after)))))
- (setq parse-state
- (progn (forward-char 1) (paredit-current-parse-state))
-;; (parse-partial-sexp (point) (1+ (point))
-;; nil nil parse-state)
- )
- (let* ((old-state state)
- (new-state
- (paredit-kill-word-state parse-state 'char-after)))
- (cond ((not (eq old-state new-state))
- (setq parse-state
- (paredit-kill-word-hack old-state
- new-state
- parse-state))
- (setq state
- (paredit-kill-word-state parse-state
- 'char-after))
- (setq beginning (point)))))))
- (goto-char beginning)
- (kill-word 1)))
-
-(defun paredit-backward-kill-word ()
- "Kill a word backward, skipping over any intervening delimiters."
- (interactive)
- (if (not (or (bobp)
- (eq (char-syntax (char-before)) ?w)))
- (let ((end (point)))
- (backward-word 1)
- (forward-word 1)
- (goto-char (min end (point)))
- (let* ((parse-state (paredit-current-parse-state))
- (state
- (paredit-kill-word-state parse-state 'char-before)))
- (while (and (< (point) end)
- (progn
- (setq parse-state
- (parse-partial-sexp (point) (1+ (point))
- nil nil parse-state))
- (or (eq state
- (paredit-kill-word-state parse-state
- 'char-before))
- (progn (backward-char 1) nil)))))
- (if (and (eq state 'comment)
- (eq ?\# (char-after (point)))
- (eq ?\| (char-before (point))))
- (backward-char 1)))))
- (backward-kill-word 1))
-
-;;;;;; Word-Killing Auxiliaries
-
-(defun paredit-kill-word-state (parse-state adjacent-char-fn)
- (cond ((paredit-in-comment-p parse-state) 'comment)
- ((paredit-in-string-p parse-state) 'string)
- ((memq (char-syntax (funcall adjacent-char-fn))
- '(?\( ?\) ))
- 'delimiter)
- (t 'other)))
-
-;;; This optionally advances the point past any comment delimiters that
-;;; should probably not be touched, based on the last state change and
-;;; the characters around the point. It returns a new parse state,
-;;; starting from the PARSE-STATE parameter.
-
-(defun paredit-kill-word-hack (old-state new-state parse-state)
- (cond ((and (not (eq old-state 'comment))
- (not (eq new-state 'comment))
- (not (paredit-in-string-escape-p))
- (eq ?\# (char-before))
- (eq ?\| (char-after)))
- (forward-char 1)
- (paredit-current-parse-state)
-;; (parse-partial-sexp (point) (1+ (point))
-;; nil nil parse-state)
- )
- ((and (not (eq old-state 'comment))
- (eq new-state 'comment)
- (eq ?\; (char-before)))
- (skip-chars-forward ";")
- (paredit-current-parse-state)
-;; (parse-partial-sexp (point) (save-excursion
-;; (skip-chars-forward ";"))
-;; nil nil parse-state)
- )
- (t parse-state)))
-
-(defun paredit-copy-as-kill ()
- "Save in the kill ring the region that `paredit-kill' would kill."
- (interactive)
- (cond ((paredit-in-string-p)
- (paredit-copy-as-kill-in-string))
- ((paredit-in-comment-p)
- (copy-region-as-kill (point) (point-at-eol)))
- ((save-excursion (paredit-skip-whitespace t (point-at-eol))
- (or (eolp) (eq (char-after) ?\; )))
- ;** Be careful about trailing backslashes.
- (save-excursion
- (if (paredit-in-char-p)
- (backward-char))
- (copy-region-as-kill (point) (point-at-eol))))
- (t (paredit-copy-sexps-as-kill))))
-
-(defun paredit-copy-as-kill-in-string ()
- (save-excursion
- (if (paredit-in-string-escape-p)
- (backward-char))
- (copy-region-as-kill (point)
- (min (point-at-eol)
- (cdr (paredit-string-start+end-points))))))
-
-(defun paredit-copy-sexps-as-kill ()
- (save-excursion
- (if (paredit-in-char-p)
- (backward-char 2))
- (let ((beginning (point))
- (eol (point-at-eol)))
- (let ((end-of-list-p (paredit-forward-sexps-to-kill beginning eol)))
- (if end-of-list-p (progn (up-list) (backward-char)))
- (copy-region-as-kill beginning
- (cond (kill-whole-line
- (or (save-excursion
- (paredit-skip-whitespace t)
- (and (not (eq (char-after) ?\; ))
- (point)))
- (point-at-eol)))
- ((and (not end-of-list-p)
- (eq (point-at-eol) eol))
- eol)
- (t
- (point))))))))
-
-;;;; Deleting Regions
-
-(defun paredit-delete-region (start end)
- "Delete the text between point and mark, like `delete-region'.
-If that text is unbalanced, signal an error instead.
-With a prefix argument, skip the balance check."
- (interactive "r")
- (if (and start end (not current-prefix-arg))
- (paredit-check-region-for-delete start end))
- (setq this-command 'delete-region)
- (delete-region start end))
-
-(defun paredit-kill-region (start end)
- "Kill the text between point and mark, like `kill-region'.
-If that text is unbalanced, signal an error instead.
-With a prefix argument, skip the balance check."
- (interactive "r")
- (if (and start end (not current-prefix-arg))
- (paredit-check-region-for-delete start end))
- (setq this-command 'kill-region)
- (kill-region start end))
-
-(defun paredit-check-region-for-delete (start end)
- "Signal an error deleting text between START and END is unsafe."
- (save-excursion
- (goto-char start)
- (let* ((start-state (paredit-current-parse-state))
- (end-state (parse-partial-sexp start end nil nil start-state)))
- (paredit-check-region-for-delete:depth start start-state end end-state)
- (paredit-check-region-for-delete:string start start-state end end-state)
- (paredit-check-region-for-delete:comment start start-state end end-state)
- (paredit-check-region-for-delete:char-quote start start-state
- end end-state))))
-
-(defun paredit-check-region-for-delete:depth (start start-state end end-state)
- (let ((start-depth (nth 0 start-state))
- (end-depth (nth 0 end-state)))
- (if (not (= start-depth end-depth))
- (error "Mismatched parenthesis depth: %S at start, %S at end."
- start-depth
- end-depth))))
-
-(defun paredit-check-region-for-delete:string (start start-state end end-state)
- (let ((start-string-p (nth 3 start-state))
- (end-string-p (nth 3 end-state)))
- (if (not (eq start-string-p end-string-p))
- (error "Mismatched string state: start %sin string, end %sin string."
- (if start-string-p "" "not ")
- (if end-string-p "" "not ")))))
-
-(defun paredit-check-region-for-delete:comment
- (start start-state end end-state)
- (let ((start-comment-state (nth 4 start-state))
- (end-comment-state (nth 4 end-state)))
- (if (not (or (eq start-comment-state end-comment-state)
- ;; If we are moving text into or out of a line
- ;; comment, make sure that the text is balanced. (The
- ;; comment state may be a number, not t or nil at all,
- ;; for nestable comments, which are not handled by
- ;; this heuristic (or any of paredit, really).)
- (and (or (and (eq start-comment-state nil)
- (eq end-comment-state t))
- (and (eq start-comment-state t)
- (eq end-comment-state nil)))
- (save-excursion
- (goto-char end)
- (paredit-region-ok-p (point) (point-at-eol))))))
- (error "Mismatched comment state: %s"
- (cond ((and (integerp start-comment-state)
- (integerp end-comment-state))
- (format "depth %S at start, depth %S at end."
- start-comment-state
- end-comment-state))
- ((integerp start-comment-state)
- "start in nested comment, end otherwise.")
- ((integerp end-comment-state)
- "end in nested comment, start otherwise.")
- (start-comment-state
- "start in comment, end not in comment.")
- (end-comment-state
- "end in comment, start not in comment.")
- (t
- (format "start %S, end %S."
- start-comment-state
- end-comment-state)))))))
-
-(defun paredit-check-region-for-delete:char-quote
- (start start-state end end-state)
- (let ((start-char-quote (nth 5 start-state))
- (end-char-quote (nth 5 end-state)))
- (if (not (eq start-char-quote end-char-quote))
- (let ((phrase "character quotation"))
- (error "Mismatched %s: start %sin %s, end %sin %s."
- phrase
- (if start-char-quote "" "not ")
- phrase
- (if end-char-quote "" "not ")
- phrase)))))
-
-;;;; Point Motion
-
-(eval-and-compile
- (defmacro defun-motion (name bvl doc &rest body)
- `(defun ,name ,bvl
- ,doc
- ,(xcond ((paredit-xemacs-p)
- '(interactive "_"))
- ((paredit-gnu-emacs-p)
- ;++ Not sure this is sufficient for the `^'.
- (if (fboundp 'handle-shift-selection)
- '(interactive "^p")
- '(interactive "p"))))
- ,@body)))
-
-(defun-motion paredit-forward (&optional arg)
- "Move forward an S-expression, or up an S-expression forward.
-If there are no more S-expressions in this one before the closing
- delimiter, move past that closing delimiter; otherwise, move forward
- past the S-expression following the point."
- (let ((n (or arg 1)))
- (cond ((< 0 n) (dotimes (i n) (paredit-move-forward)))
- ((< n 0) (dotimes (i (- n)) (paredit-move-backward))))))
-
-(defun-motion paredit-backward (&optional arg)
- "Move backward an S-expression, or up an S-expression backward.
-If there are no more S-expressions in this one before the opening
- delimiter, move past that opening delimiter backward; otherwise, move
- move backward past the S-expression preceding the point."
- (let ((n (or arg 1)))
- (cond ((< 0 n) (dotimes (i n) (paredit-move-backward)))
- ((< n 0) (dotimes (i (- n)) (paredit-move-forward))))))
-
-(defun paredit-move-forward ()
- (cond ((paredit-in-string-p)
- (let ((end (paredit-enclosing-string-end)))
- ;; `forward-sexp' and `up-list' may move into the next string
- ;; in the buffer. Don't do that; move out of the current one.
- (if (paredit-handle-sexp-errors
- (progn (paredit-handle-sexp-errors (forward-sexp)
- (up-list))
- (<= end (point)))
- t)
- (goto-char end))))
- ((paredit-in-char-p)
- (forward-char))
- (t
- (paredit-handle-sexp-errors (forward-sexp)
- (up-list)))))
-
-(defun paredit-move-backward ()
- (cond ((paredit-in-string-p)
- (let ((start (paredit-enclosing-string-start)))
- (if (paredit-handle-sexp-errors
- (progn (paredit-handle-sexp-errors (backward-sexp)
- (backward-up-list))
- (<= (point) start))
- t)
- (goto-char start))))
- ((paredit-in-char-p)
- ;++ Corner case: a buffer of `\|x'. What to do?
- (backward-char 2))
- (t
- (paredit-handle-sexp-errors (backward-sexp)
- (backward-up-list)))))
-
-;;;; Window Positioning
-
-(defalias 'paredit-recentre-on-sexp 'paredit-recenter-on-sexp)
-
-(defun paredit-recenter-on-sexp (&optional n)
- "Recenter the screen on the S-expression following the point.
-With a prefix argument N, encompass all N S-expressions forward."
- (interactive "P")
- (let* ((p (point))
- (end-point (progn (forward-sexp n) (point)))
- (start-point (progn (goto-char end-point) (backward-sexp n) (point))))
- ;; Point is at beginning of first S-expression.
- (let ((p-visible nil) (start-visible nil))
- (save-excursion
- (forward-line (/ (count-lines start-point end-point) 2))
- (recenter)
- (setq p-visible (pos-visible-in-window-p p))
- (setq start-visible (pos-visible-in-window-p start-point)))
- (cond ((not start-visible)
- ;; Implies (not p-visible). Put the start at the top of
- ;; the screen.
- (recenter 0))
- (p-visible
- ;; Go back to p if we can.
- (goto-char p))))))
-
-(defun paredit-recenter-on-defun ()
- "Recenter the screen on the definition at point."
- (interactive)
- (save-excursion
- (beginning-of-defun)
- (paredit-recenter-on-sexp)))
-
-(defun paredit-focus-on-defun ()
- "Moves display to the top of the definition at point."
- (interactive)
- (beginning-of-defun)
- (recenter 0))
-
-;;;; Generalized Upward/Downward Motion
-
-(defun paredit-up/down (n vertical-direction)
- (let ((horizontal-direction (if (< 0 n) +1 -1)))
- (while (/= n 0)
- (goto-char
- (paredit-next-up/down-point horizontal-direction vertical-direction))
- (setq n (- n horizontal-direction)))))
-
-(defun paredit-next-up/down-point (horizontal-direction vertical-direction)
- (let ((state (paredit-current-parse-state))
- (scan-lists
- (lambda ()
- (scan-lists (point) horizontal-direction vertical-direction))))
- (cond ((paredit-in-string-p state)
- (let ((start+end (paredit-string-start+end-points state)))
- (if (< 0 vertical-direction)
- (if (< 0 horizontal-direction)
- (+ 1 (cdr start+end))
- (car start+end))
- ;; We could let the user try to descend into lists
- ;; within the string, but that would be asymmetric
- ;; with the up case, which rises out of the whole
- ;; string and not just out of a list within the
- ;; string, so this case will just be an error.
- (error "Can't descend further into string."))))
- ((< 0 vertical-direction)
- ;; When moving up, just try to rise up out of the list.
- (or (funcall scan-lists)
- (buffer-end horizontal-direction)))
- ((< vertical-direction 0)
- ;; When moving down, look for a string closer than a list,
- ;; and use that if we find it.
- (let* ((list-start
- (paredit-handle-sexp-errors (funcall scan-lists) nil))
- (string-start
- (paredit-find-next-string-start horizontal-direction
- list-start)))
- (if (and string-start list-start)
- (if (< 0 horizontal-direction)
- (min string-start list-start)
- (max string-start list-start))
- (or string-start
- ;; Scan again: this is a kludgey way to report the
- ;; error if there really was one.
- (funcall scan-lists)
- (buffer-end horizontal-direction)))))
- (t
- (error "Vertical direction must be nonzero in `%s'."
- 'paredit-up/down)))))
-
-(defun paredit-find-next-string-start (horizontal-direction limit)
- (let ((buffer-limit-p (if (< 0 horizontal-direction) 'eobp 'bobp))
- (next-char (if (< 0 horizontal-direction) 'char-after 'char-before))
- (pastp (if (< 0 horizontal-direction) '> '<)))
- (paredit-handle-sexp-errors
- (save-excursion
- (catch 'exit
- (while t
- (if (or (funcall buffer-limit-p)
- (and limit (funcall pastp (point) limit)))
- (throw 'exit nil))
- (forward-sexp horizontal-direction)
- (save-excursion
- (backward-sexp horizontal-direction)
- (if (eq ?\" (char-syntax (funcall next-char)))
- (throw 'exit (+ (point) horizontal-direction)))))))
- nil)))
-
-(defun-motion paredit-forward-down (&optional argument)
- "Move forward down into a list.
-With a positive argument, move forward down that many levels.
-With a negative argument, move backward down that many levels."
- (paredit-up/down (or argument +1) -1))
-
-(defun-motion paredit-backward-up (&optional argument)
- "Move backward up out of the enclosing list.
-With a positive argument, move backward up that many levels.
-With a negative argument, move forward up that many levels.
-If in a string initially, that counts as one level."
- (paredit-up/down (- 0 (or argument +1)) +1))
-
-(defun-motion paredit-forward-up (&optional argument)
- "Move forward up out of the enclosing list.
-With a positive argument, move forward up that many levels.
-With a negative argument, move backward up that many levels.
-If in a string initially, that counts as one level."
- (paredit-up/down (or argument +1) +1))
-
-(defun-motion paredit-backward-down (&optional argument)
- "Move backward down into a list.
-With a positive argument, move backward down that many levels.
-With a negative argument, move forward down that many levels."
- (paredit-up/down (- 0 (or argument +1)) -1))
-
-;;;; Depth-Changing Commands: Wrapping, Splicing, & Raising
-
-(defun paredit-wrap-sexp (&optional argument open close)
- "Wrap the following S-expression.
-If a `C-u' prefix argument is given, wrap all S-expressions following
- the point until the end of the buffer or of the enclosing list.
-If a numeric prefix argument N is given, wrap N S-expressions.
-Automatically indent the newly wrapped S-expression.
-As a special case, if the point is at the end of a list, simply insert
- a parenthesis pair, rather than inserting a lone opening delimiter
- and then signalling an error, in the interest of preserving
- structure.
-By default OPEN and CLOSE are round delimiters."
- (interactive "P")
- (paredit-lose-if-not-in-sexp 'paredit-wrap-sexp)
- (let ((open (or open ?\( ))
- (close (or close ?\) )))
- (paredit-handle-sexp-errors
- ((lambda (n) (paredit-insert-pair n open close 'goto-char))
- (cond ((integerp argument) argument)
- ((consp argument) (paredit-count-sexps-forward))
- ((paredit-region-active-p) nil)
- (t 1)))
- (insert close)
- (backward-char)))
- (save-excursion (backward-up-list) (indent-sexp)))
-
-(defun paredit-yank-pop (&optional argument)
- "Replace just-yanked text with the next item in the kill ring.
-If this command follows a `yank', just run `yank-pop'.
-If this command follows a `paredit-wrap-sexp', or any other paredit
- wrapping command (see `paredit-wrap-commands'), run `yank' and
- reindent the enclosing S-expression.
-If this command is repeated, run `yank-pop' and reindent the enclosing
- S-expression.
-
-The argument is passed on to `yank' or `yank-pop'; see their
- documentation for details."
- (interactive "*p")
- (cond ((eq last-command 'yank)
- (yank-pop argument))
- ((memq last-command paredit-wrap-commands)
- (yank argument)
- ;; `yank' futzes with `this-command'.
- (setq this-command 'paredit-yank-pop)
- (save-excursion (backward-up-list) (indent-sexp)))
- ((eq last-command 'paredit-yank-pop)
- ;; Pretend we just did a `yank', so that we can use
- ;; `yank-pop' without duplicating its definition.
- (setq last-command 'yank)
- (yank-pop argument)
- ;; Return to our original state.
- (setq last-command 'paredit-yank-pop)
- (setq this-command 'paredit-yank-pop)
- (save-excursion (backward-up-list) (indent-sexp)))
- (t (error "Last command was not a yank or a wrap: %s" last-command))))
-
-(defun paredit-splice-sexp (&optional argument)
- "Splice the list that the point is on by removing its delimiters.
-With a prefix argument as in `C-u', kill all S-expressions backward in
- the current list before splicing all S-expressions forward into the
- enclosing list.
-With two prefix arguments as in `C-u C-u', kill all S-expressions
- forward in the current list before splicing all S-expressions
- backward into the enclosing list.
-With a numerical prefix argument N, kill N S-expressions backward in
- the current list before splicing the remaining S-expressions into the
- enclosing list. If N is negative, kill forward.
-Inside a string, unescape all backslashes, or signal an error if doing
- so would invalidate the buffer's structure."
- (interactive "P")
- (if (paredit-in-string-p)
- (paredit-splice-string argument)
- (if (paredit-in-comment-p)
- (error "Can't splice comment."))
- (paredit-handle-sexp-errors (paredit-enclosing-list-start)
- (error "Can't splice top level."))
- (paredit-kill-surrounding-sexps-for-splice argument)
- (let ((delete-start (paredit-enclosing-list-start))
- (delete-end
- (let ((limit
- (save-excursion
- (paredit-ignore-sexp-errors (forward-sexp) (backward-sexp))
- (point))))
- (save-excursion
- (backward-up-list)
- (forward-char +1)
- (paredit-skip-whitespace t limit)
- (point)))))
- (let ((end-marker (make-marker)))
- (save-excursion
- (up-list)
- (delete-char -1)
- (set-marker end-marker (point)))
- (delete-region delete-start delete-end)
- (paredit-splice-reindent delete-start (marker-position end-marker))))))
-
-(defun paredit-splice-reindent (start end)
- (paredit-preserving-column
- ;; If we changed the first subform of the enclosing list, we must
- ;; reindent the whole enclosing list.
- (if (paredit-handle-sexp-errors
- (save-excursion
- (backward-up-list)
- (down-list)
- (paredit-ignore-sexp-errors (forward-sexp))
- (< start (point)))
- nil)
- (save-excursion (backward-up-list) (indent-sexp))
- (paredit-indent-region start end))))
-
-(defun paredit-kill-surrounding-sexps-for-splice (argument)
- (cond ((or (paredit-in-string-p)
- (paredit-in-comment-p))
- (error "Invalid context for splicing S-expressions."))
- ((or (not argument) (eq argument 0)) nil)
- ((or (numberp argument) (eq argument '-))
- ;; Kill S-expressions before/after the point by saving the
- ;; point, moving across them, and killing the region.
- (let* ((argument (if (eq argument '-) -1 argument))
- (saved (paredit-point-at-sexp-boundary (- argument))))
- (goto-char saved)
- (paredit-ignore-sexp-errors (backward-sexp argument))
- (paredit-hack-kill-region saved (point))))
- ((consp argument)
- (let ((v (car argument)))
- (if (= v 4) ;One `C-u'.
- ;; Move backward until we hit the open paren; then
- ;; kill that selected region.
- (let ((end (point)))
- (paredit-ignore-sexp-errors
- (while (not (bobp))
- (backward-sexp)))
- (paredit-hack-kill-region (point) end))
- ;; Move forward until we hit the close paren; then
- ;; kill that selected region.
- (let ((beginning (point)))
- (paredit-ignore-sexp-errors
- (while (not (eobp))
- (forward-sexp)))
- (paredit-hack-kill-region beginning (point))))))
- (t (error "Bizarre prefix argument `%s'." argument))))
-
-(defun paredit-splice-sexp-killing-backward (&optional n)
- "Splice the list the point is on by removing its delimiters, and
- also kill all S-expressions before the point in the current list.
-With a prefix argument N, kill only the preceding N S-expressions."
- (interactive "P")
- (paredit-splice-sexp (if n
- (prefix-numeric-value n)
- '(4))))
-
-(defun paredit-splice-sexp-killing-forward (&optional n)
- "Splice the list the point is on by removing its delimiters, and
- also kill all S-expressions after the point in the current list.
-With a prefix argument N, kill only the following N S-expressions."
- (interactive "P")
- (paredit-splice-sexp (if n
- (- (prefix-numeric-value n))
- '(16))))
-
-(defun paredit-raise-sexp (&optional argument)
- "Raise the following S-expression in a tree, deleting its siblings.
-With a prefix argument N, raise the following N S-expressions. If N
- is negative, raise the preceding N S-expressions.
-If the point is on an S-expression, such as a string or a symbol, not
- between them, that S-expression is considered to follow the point."
- (interactive "P")
- (save-excursion
- (cond ((paredit-in-string-p)
- (goto-char (car (paredit-string-start+end-points))))
- ((paredit-in-char-p)
- (backward-sexp))
- ((paredit-in-comment-p)
- (error "No S-expression to raise in comment.")))
- ;; Select the S-expressions we want to raise in a buffer substring.
- (let* ((n (prefix-numeric-value argument))
- (bound (scan-sexps (point) n))
- (sexps
- (if (< n 0)
- (buffer-substring bound (paredit-point-at-sexp-end))
- (buffer-substring (paredit-point-at-sexp-start) bound))))
- ;; Move up to the list we're raising those S-expressions out of and
- ;; delete it.
- (backward-up-list)
- (delete-region (point) (scan-sexps (point) 1))
- (let* ((indent-start (point))
- (indent-end (save-excursion (insert sexps) (point))))
- (indent-region indent-start indent-end nil)))))
-
-;;; The effects of convolution on the surrounding whitespace are pretty
-;;; random. If you have better suggestions, please let me know.
-
-(defun paredit-convolute-sexp (&optional n)
- "Convolute S-expressions.
-Save the S-expressions preceding point and delete them.
-Splice the S-expressions following point.
-Wrap the enclosing list in a new list prefixed by the saved text.
-With a prefix argument N, move up N lists before wrapping."
- (interactive "p")
- (paredit-lose-if-not-in-sexp 'paredit-convolute-sexp)
- ;; Make sure we can move up before destroying anything.
- (save-excursion (backward-up-list n) (backward-up-list))
- (let (open close) ;++ Is this a good idea?
- (let ((prefix
- (let ((end (point)))
- (paredit-ignore-sexp-errors
- (while (not (bobp)) (backward-sexp)))
- (prog1 (buffer-substring (point) end)
- (backward-up-list)
- (save-excursion (forward-sexp)
- (setq close (char-before))
- (delete-char -1))
- (setq open (char-after))
- (delete-region (point) end)
- ;; I'm not sure this makes sense...
- (if (not (eolp)) (just-one-space))))))
- (backward-up-list n)
- (paredit-insert-pair 1 open close 'goto-char)
- (insert prefix)
- ;; I'm not sure this makes sense either...
- (if (not (eolp)) (just-one-space))
- (save-excursion
- (backward-up-list)
- (paredit-ignore-sexp-errors (indent-sexp))))))
-
-(defun paredit-splice-string (argument)
- (let ((original-point (point))
- (start+end (paredit-string-start+end-points)))
- (let ((start (car start+end))
- (end (cdr start+end)))
- ;; START and END both lie before the respective quote
- ;; characters, which we want to delete; thus we increment START
- ;; by one to extract the string, and we increment END by one to
- ;; delete the string.
- (let* ((escaped-string
- (cond ((not (consp argument))
- (buffer-substring (1+ start) end))
- ((= 4 (car argument))
- (buffer-substring original-point end))
- (t
- (buffer-substring (1+ start) original-point))))
- (unescaped-string
- (paredit-unescape-string escaped-string)))
- (if (not unescaped-string)
- (error "Unspliceable string.")
- (save-excursion
- (goto-char start)
- (delete-region start (1+ end))
- (insert unescaped-string))
- (if (not (and (consp argument)
- (= 4 (car argument))))
- (goto-char (- original-point 1))))))))
-
-(defun paredit-unescape-string (string)
- (with-temp-buffer
- (insert string)
- (goto-char (point-min))
- (while (and (not (eobp))
- ;; nil -> no bound; t -> no errors.
- (search-forward "\\" nil t))
- (delete-char -1)
- (forward-char))
- (paredit-handle-sexp-errors
- (progn (scan-sexps (point-min) (point-max))
- (buffer-string))
- nil)))
-
-;;;; Slurpage & Barfage
-
-(defun paredit-forward-slurp-sexp (&optional argument)
- "Add the S-expression following the current list into that list
- by moving the closing delimiter.
-Automatically reindent the newly slurped S-expression with respect to
- its new enclosing form.
-If in a string, move the opening double-quote forward by one
- S-expression and escape any intervening characters as necessary,
- without altering any indentation or formatting."
- (interactive "P")
- (save-excursion
- (cond ((paredit-in-comment-p)
- (error "Invalid context for slurping S-expressions."))
- ((numberp argument)
- (if (< argument 0)
- (paredit-forward-barf-sexp (- 0 argument))
- (while (< 0 argument)
- (paredit-forward-slurp-sexp)
- (setq argument (- argument 1)))))
- ((paredit-in-string-p)
- ;; If there is anything to slurp into the string, take that.
- ;; Otherwise, try to slurp into the enclosing list.
- (if (save-excursion
- (goto-char (paredit-enclosing-string-end))
- (paredit-handle-sexp-errors (progn (forward-sexp) nil)
- t))
- (progn
- (goto-char (paredit-enclosing-string-end))
- (paredit-forward-slurp-into-list argument))
- (paredit-forward-slurp-into-string argument)))
- (t
- (paredit-forward-slurp-into-list argument)))))
-
-(defun paredit-forward-slurp-into-list (&optional argument)
- (let ((nestedp nil))
- (save-excursion
- (up-list) ; Up to the end of the list to
- (let ((close (char-before))) ; save and delete the closing
- (delete-char -1) ; delimiter.
- (let ((start (point)))
- (catch 'return ; Go to the end of the desired
- (while t ; S-expression, going up a
- (paredit-handle-sexp-errors ; list if it's not in this,
- (progn (forward-sexp)
- (if argument
- (paredit-ignore-sexp-errors
- (while (not (eobp))
- (forward-sexp))))
- (throw 'return nil))
- (setq nestedp t)
- (up-list)
- (setq close ; adjusting for mixed
- (prog1 (char-before) ; delimiters as necessary,
- (delete-char -1)
- (insert close))))))
- (insert close) ; to insert that delimiter.
- (indent-region start (point) nil))))
- (if (and (not nestedp)
- (eq (save-excursion (paredit-skip-whitespace nil) (point))
- (save-excursion (backward-up-list) (forward-char) (point)))
- (eq (save-excursion (forward-sexp) (backward-sexp) (point))
- (save-excursion (paredit-skip-whitespace t) (point))))
- (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
- (save-excursion (paredit-skip-whitespace t) (point))))))
-
-(defun paredit-forward-slurp-into-string (&optional argument)
- (let ((start (paredit-enclosing-string-start))
- (end (paredit-enclosing-string-end)))
- (goto-char end)
- ;; Signal any errors that we might get first, before mucking with
- ;; the buffer's contents.
- (save-excursion (forward-sexp))
- (let ((close (char-before)))
- ;; Skip intervening whitespace if we're slurping into an empty
- ;; string. XXX What about nonempty strings?
- (if (and (= (+ start 2) end)
- (eq (save-excursion (paredit-skip-whitespace t) (point))
- (save-excursion (forward-sexp) (backward-sexp) (point))))
- (delete-region (- (point) 1)
- (save-excursion (paredit-skip-whitespace t) (point)))
- (delete-char -1))
- (paredit-forward-for-quote
- (save-excursion
- (forward-sexp)
- (if argument
- (while (paredit-handle-sexp-errors (progn (forward-sexp) t) nil)))
- (point)))
- (insert close))))
-
-(defun paredit-forward-barf-sexp (&optional argument)
- "Remove the last S-expression in the current list from that list
- by moving the closing delimiter.
-Automatically reindent the newly barfed S-expression with respect to
- its new enclosing form."
- (interactive "P")
- (paredit-lose-if-not-in-sexp 'paredit-forward-barf-sexp)
- (if (and (numberp argument) (< argument 0))
- (paredit-forward-slurp-sexp (- 0 argument))
- (let ((start (point)) (end nil))
- (save-excursion
- (up-list) ; Up to the end of the list to
- (let ((close (char-before))) ; save and delete the closing
- (delete-char -1) ; delimiter.
- (setq end (point))
- (paredit-ignore-sexp-errors ; Go back to where we want to
- (if (or (not argument) ; insert the delimiter.
- (numberp argument))
- (backward-sexp argument)
- (while (paredit-handle-sexp-errors
- (save-excursion (backward-sexp) (<= start (point)))
- nil)
- (backward-sexp))))
- (paredit-skip-whitespace nil) ; Skip leading whitespace.
- (cond ((bobp)
- ;++ We'll have deleted the close, but there's no open.
- ;++ Is that OK?
- (error "Barfing all subexpressions with no open-paren?"))
- ((paredit-in-comment-p) ; Don't put the close-paren in
- (newline))) ; a comment.
- (insert close))
- ;; Reindent all of the newly barfed S-expressions. Start at the
- ;; start of the first barfed S-expression, not at the close we
- ;; just inserted.
- (forward-sexp)
- (backward-sexp)
- (if (or (not argument) (numberp argument))
- (paredit-forward-and-indent argument)
- (indent-region (point) end))))))
-
-(defun paredit-backward-slurp-sexp (&optional argument)
- "Add the S-expression preceding the current list into that list
- by moving the closing delimiter.
-Automatically reindent the whole form into which new S-expression was
- slurped.
-If in a string, move the opening double-quote backward by one
- S-expression and escape any intervening characters as necessary,
- without altering any indentation or formatting."
- (interactive "P")
- (save-excursion
- (cond ((paredit-in-comment-p)
- (error "Invalid context for slurping S-expressions."))
- ((numberp argument)
- (if (< argument 0)
- (paredit-backward-barf-sexp (- 0 argument))
- (while (< 0 argument)
- (paredit-backward-slurp-sexp)
- (setq argument (- argument 1)))))
- ((paredit-in-string-p)
- ;; If there is anything to slurp into the string, take that.
- ;; Otherwise, try to slurp into the enclosing list.
- (if (save-excursion
- (goto-char (paredit-enclosing-string-start))
- (paredit-handle-sexp-errors (progn (backward-sexp) nil)
- t))
- (progn
- (goto-char (paredit-enclosing-string-start))
- (paredit-backward-slurp-into-list argument))
- (paredit-backward-slurp-into-string argument)))
- (t
- (paredit-backward-slurp-into-list argument)))))
-
-(defun paredit-backward-slurp-into-list (&optional argument)
- (let ((nestedp nil))
- (save-excursion
- (backward-up-list)
- (let ((open (char-after)))
- (delete-char +1)
- (catch 'return
- (while t
- (paredit-handle-sexp-errors
- (progn (backward-sexp)
- (if argument
- (paredit-ignore-sexp-errors
- (while (not (bobp))
- (backward-sexp))))
- (throw 'return nil))
- (setq nestedp t)
- (backward-up-list)
- (setq open
- (prog1 (char-after)
- (save-excursion (insert open) (delete-char +1)))))))
- (insert open))
- ;; Reindent the line at the beginning of wherever we inserted the
- ;; opening delimiter, and then indent the whole S-expression.
- (backward-up-list)
- (lisp-indent-line)
- (indent-sexp))
- ;; If we slurped into an empty list, don't leave dangling space:
- ;; (foo |).
- (if (and (not nestedp)
- (eq (save-excursion (paredit-skip-whitespace nil) (point))
- (save-excursion (backward-sexp) (forward-sexp) (point)))
- (eq (save-excursion (up-list) (backward-char) (point))
- (save-excursion (paredit-skip-whitespace t) (point))))
- (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
- (save-excursion (paredit-skip-whitespace t) (point))))))
-
-(defun paredit-backward-slurp-into-string (&optional argument)
- (let ((start (paredit-enclosing-string-start))
- (end (paredit-enclosing-string-end)))
- (goto-char start)
- ;; Signal any errors that we might get first, before mucking with
- ;; the buffer's contents.
- (save-excursion (backward-sexp))
- (let ((open (char-after))
- (target (point)))
- ;; Skip intervening whitespace if we're slurping into an empty
- ;; string. XXX What about nonempty strings?
- (if (and (= (+ start 2) end)
- (eq (save-excursion (paredit-skip-whitespace nil) (point))
- (save-excursion (backward-sexp) (forward-sexp) (point))))
- (delete-region (save-excursion (paredit-skip-whitespace nil) (point))
- (+ (point) 1))
- (delete-char +1))
- (backward-sexp)
- (if argument
- (paredit-ignore-sexp-errors
- (while (not (bobp))
- (backward-sexp))))
- (insert open)
- (paredit-forward-for-quote target))))
-
-(defun paredit-backward-barf-sexp (&optional argument)
- "Remove the first S-expression in the current list from that list
- by moving the closing delimiter.
-Automatically reindent the barfed S-expression and the form from which
- it was barfed."
- (interactive "P")
- (paredit-lose-if-not-in-sexp 'paredit-backward-barf-sexp)
- (if (and (numberp argument) (< argument 0))
- (paredit-backward-slurp-sexp (- 0 argument))
- (let ((end (make-marker)))
- (set-marker end (point))
- (save-excursion
- (backward-up-list)
- (let ((open (char-after)))
- (delete-char +1)
- (paredit-ignore-sexp-errors
- (paredit-forward-and-indent
- (if (or (not argument) (numberp argument))
- argument
- (let ((n 0))
- (save-excursion
- (while (paredit-handle-sexp-errors
- (save-excursion
- (forward-sexp)
- (<= (point) end))
- nil)
- (forward-sexp)
- (setq n (+ n 1))))
- n))))
- (while (progn (paredit-skip-whitespace t) (eq (char-after) ?\; ))
- (forward-line 1))
- (if (eobp)
- ;++ We'll have deleted the close, but there's no open.
- ;++ Is that OK?
- (error "Barfing all subexpressions with no close-paren?"))
- ;** Don't use `insert' here. Consider, e.g., barfing from
- ;** (foo|)
- ;** and how `save-excursion' works.
- (insert-before-markers open))
- (backward-up-list)
- (lisp-indent-line)
- (indent-sexp)))))
-
-;;;; Splitting & Joining
-
-(defun paredit-split-sexp ()
- "Split the list or string the point is on into two."
- (interactive)
- (cond ((paredit-in-string-p)
- (insert "\"")
- (save-excursion (insert " \"")))
- ((or (paredit-in-comment-p)
- (paredit-in-char-p))
- (error "Invalid context for splitting S-expression."))
- (t
- (let ((open (save-excursion (backward-up-list) (char-after)))
- (close (save-excursion (up-list) (char-before))))
- (delete-horizontal-space)
- (insert close)
- (save-excursion
- (insert ?\ )
- (insert open)
- (backward-char)
- (indent-sexp))))))
-
-(defun paredit-join-sexps ()
- "Join the S-expressions adjacent on either side of the point.
-Both must be lists, strings, or atoms; error if there is a mismatch."
- (interactive)
- (cond ((paredit-in-comment-p) (error "Can't join S-expressions in comment."))
- ((paredit-in-string-p) (error "Nothing to join in a string."))
- ((paredit-in-char-p) (error "Can't join characters.")))
- (let ((left-point (paredit-point-at-sexp-end))
- (right-point (paredit-point-at-sexp-start)))
- (let ((left-char (char-before left-point))
- (right-char (char-after right-point)))
- (let ((left-syntax (char-syntax left-char))
- (right-syntax (char-syntax right-char)))
- (cond ((< right-point left-point)
- (error "Can't join a datum with itself."))
- ((and (eq left-syntax ?\) )
- (eq right-syntax ?\( )
- (eq left-char (matching-paren right-char))
- (eq right-char (matching-paren left-char)))
- (paredit-join-lists-internal left-point right-point)
- (paredit-preserving-column
- (save-excursion
- (backward-up-list)
- (indent-sexp))))
- ((and (eq left-syntax ?\" )
- (eq right-syntax ?\" ))
- ;; Delete any intermediate formatting.
- (delete-region (1- left-point) (1+ right-point)))
- ((and (memq left-syntax '(?w ?_)) ; Word or symbol
- (memq right-syntax '(?w ?_)))
- (delete-region left-point right-point))
- (t (error "Mismatched S-expressions to join.")))))))
-
-(defun paredit-join-lists-internal (left-point right-point)
- (save-excursion
- ;; Leave intermediate formatting alone.
- (goto-char right-point)
- (delete-char +1)
- (goto-char left-point)
- (delete-char -1)
- ;; Kludge: Add an extra space in several conditions.
- (if (or
- ;; (foo)| ;x\n(bar) => (foo | ;x\nbar), not (foo| ;x\nbar).
- (and (not (eolp))
- (save-excursion
- (paredit-skip-whitespace t (point-at-eol))
- (eq (char-after) ?\;)))
- ;; (foo)|(bar) => (foo| bar), not (foo|bar).
- (and (= left-point right-point)
- (not (or (eq ?\ (char-syntax (char-before)))
- (eq ?\ (char-syntax (char-after)))))))
- (insert ?\ ))))
-
-;++ How ought paredit-join to handle comments intervening symbols or strings?
-;++ Idea:
-;++
-;++ "foo" | ;bar
-;++ "baz" ;quux
-;++
-;++ =>
-;++
-;++ "foo|baz" ;bar
-;++ ;quux
-;++
-;++ The point should stay where it is relative to the comments, and the
-;++ the comments' columns should all be preserved, perhaps. Hmmmm...
-;++ What about this?
-;++
-;++ "foo" ;bar
-;++ | ;baz
-;++ "quux" ;zot
-
-;++ Should rename:
-;++ paredit-point-at-sexp-start -> paredit-start-of-sexp-after-point
-;++ paredit-point-at-sexp-end -> paredit-end-of-sexp-before-point
-
-;;;; Variations on the Lurid Theme
-
-;;; I haven't the imagination to concoct clever names for these.
-
-(defun paredit-add-to-previous-list ()
- "Add the S-expression following point to the list preceding point."
- (interactive)
- (paredit-lose-if-not-in-sexp 'paredit-add-to-previous-list)
- (save-excursion
- (down-list -1) ;++ backward-down-list...
- (paredit-forward-slurp-sexp)))
-
-(defun paredit-add-to-next-list ()
- "Add the S-expression preceding point to the list following point.
-If no S-expression precedes point, move up the tree until one does."
- (interactive)
- (paredit-lose-if-not-in-sexp 'paredit-add-to-next-list)
- (save-excursion
- (down-list)
- (paredit-backward-slurp-sexp)))
-
-(defun paredit-join-with-previous-list ()
- "Join the list the point is on with the previous list in the buffer."
- (interactive)
- (paredit-lose-if-not-in-sexp 'paredit-join-with-previous-list)
- (save-excursion
- (while (paredit-handle-sexp-errors (save-excursion (backward-sexp) nil)
- (backward-up-list)
- t))
- (paredit-join-sexps)))
-
-(defun paredit-join-with-next-list ()
- "Join the list the point is on with the next list in the buffer."
- (interactive)
- (paredit-lose-if-not-in-sexp 'paredit-join-with-next-list)
- (save-excursion
- (while (paredit-handle-sexp-errors (save-excursion (forward-sexp) nil)
- (up-list)
- t))
- (paredit-join-sexps)))
-
-;;;; Utilities
-
-(defun paredit-in-string-escape-p ()
- "True if the point is on a character escape of a string.
-This is true only if the character is preceded by an odd number of
- backslashes.
-This assumes that `paredit-in-string-p' has already returned true."
- (let ((oddp nil))
- (save-excursion
- (while (eq (char-before) ?\\ )
- (setq oddp (not oddp))
- (backward-char)))
- oddp))
-
-(defun paredit-in-char-p (&optional position)
- "True if point is on a character escape outside a string."
- (save-excursion
- (goto-char (or position (point)))
- (paredit-in-string-escape-p)))
-
-(defun paredit-skip-whitespace (trailing-p &optional limit)
- "Skip past any whitespace, or until the point LIMIT is reached.
-If TRAILING-P is nil, skip leading whitespace; otherwise, skip trailing
- whitespace."
- (funcall (if trailing-p 'skip-chars-forward 'skip-chars-backward)
- " \t\n " ; This should skip using the syntax table, but LF
- limit)) ; is a comment end, not newline, in Lisp mode.
-
-(defalias 'paredit-region-active-p
- (xcond ((paredit-xemacs-p) 'region-active-p)
- ((paredit-gnu-emacs-p)
- (lambda ()
- (and mark-active transient-mark-mode)))))
-
-(defun paredit-hack-kill-region (start end)
- "Kill the region between START and END.
-Do not append to any current kill, and
- do not let the next kill append to this one."
- (interactive "r") ;Eh, why not?
- ;; KILL-REGION sets THIS-COMMAND to tell the next kill that the last
- ;; command was a kill. It also checks LAST-COMMAND to see whether it
- ;; should append. If we bind these locally, any modifications to
- ;; THIS-COMMAND will be masked, and it will not see LAST-COMMAND to
- ;; indicate that it should append.
- (let ((this-command nil)
- (last-command nil))
- (kill-region start end)))
-
-;;;;; Reindentation utilities
-
-;++ Should `paredit-indent-sexps' and `paredit-forward-and-indent' use
-;++ `paredit-indent-region' rather than `indent-region'?
-
-(defun paredit-indent-sexps ()
- "If in a list, indent all following S-expressions in the list."
- (let* ((start (point))
- (end (paredit-handle-sexp-errors (progn (up-list) (point)) nil)))
- (if end
- (indent-region start end nil))))
-
-(defun paredit-forward-and-indent (&optional n)
- "Move forward by N S-expressions, indenting them with `indent-region'."
- (let ((start (point)))
- (forward-sexp n)
- (indent-region start (point) nil)))
-
-(defun paredit-indent-region (start end)
- "Indent the region from START to END.
-Don't reindent the line starting at START, however."
- (if (not (<= start end))
- (error "Incorrectly related points: %S, %S" start end))
- (save-excursion
- (goto-char start)
- (let ((bol (point-at-bol)))
- ;; Skip all S-expressions that end on the starting line, but
- ;; don't go past `end'.
- (if (and (save-excursion (goto-char end) (not (eq bol (point-at-bol))))
- (paredit-handle-sexp-errors
- (catch 'exit
- (while t
- (save-excursion
- (forward-sexp)
- (if (not (eq bol (point-at-bol)))
- (throw 'exit t))
- (if (not (< (point) end))
- (throw 'exit nil)))
- (forward-sexp)))
- nil))
- (progn
- ;; Point is still on the same line, but precedes an
- ;; S-expression that ends on a different line.
- (if (not (eq bol (point-at-bol)))
- (error "Internal error -- we moved forward a line!"))
- (goto-char (+ 1 (point-at-eol)))
- (if (not (<= (point) end))
- (error "Internal error -- we frobnitzed the garfnut!"))
- (indent-region (point) end nil))))))
-
-;;;;; S-expression Parsing Utilities
-
-;++ These routines redundantly traverse S-expressions a great deal.
-;++ If performance issues arise, this whole section will probably have
-;++ to be refactored to preserve the state longer, like paredit.scm
-;++ does, rather than to traverse the definition N times for every key
-;++ stroke as it presently does.
-
-(defun paredit-current-parse-state ()
- "Return parse state of point from beginning of defun."
- (let ((point (point)))
- (beginning-of-defun)
- ;; Calling PARSE-PARTIAL-SEXP will advance the point to its second
- ;; argument (unless parsing stops due to an error, but we assume it
- ;; won't in paredit-mode).
- (parse-partial-sexp (point) point)))
-
-(defun paredit-in-string-p (&optional state)
- "True if the parse state is within a double-quote-delimited string.
-If no parse state is supplied, compute one from the beginning of the
- defun to the point."
- ;; 3. non-nil if inside a string (the terminator character, really)
- (and (nth 3 (or state (paredit-current-parse-state)))
- t))
-
-(defun paredit-string-start+end-points (&optional state)
- "Return a cons of the points of open and close quotes of the string.
-The string is determined from the parse state STATE, or the parse state
- from the beginning of the defun to the point.
-This assumes that `paredit-in-string-p' has already returned true, i.e.
- that the point is already within a string."
- (save-excursion
- ;; 8. character address of start of comment or string; nil if not
- ;; in one
- (let ((start (nth 8 (or state (paredit-current-parse-state)))))
- (goto-char start)
- (forward-sexp 1)
- (cons start (1- (point))))))
-
-(defun paredit-enclosing-string-start ()
- (car (paredit-string-start+end-points)))
-
-(defun paredit-enclosing-string-end ()
- (+ 1 (cdr (paredit-string-start+end-points))))
-
-(defun paredit-enclosing-list-start ()
- (save-excursion
- (backward-up-list)
- (point)))
-
-(defun paredit-enclosing-list-end ()
- (save-excursion
- (up-list)
- (point)))
-
-(defun paredit-in-comment-p (&optional state)
- "True if parse state STATE is within a comment.
-If no parse state is supplied, compute one from the beginning of the
- defun to the point."
- ;; 4. nil if outside a comment, t if inside a non-nestable comment,
- ;; else an integer (the current comment nesting)
- (and (nth 4 (or state (paredit-current-parse-state)))
- t))
-
-(defun paredit-prefix-numeric-value (argument)
- ;++ Kludgerific.
- (cond ((integerp argument) argument)
- ((eq argument '-) -1)
- ((consp argument)
- (cond ((equal argument '(4)) (paredit-count-sexps-forward)) ;C-u
- ((equal argument '(16)) (paredit-count-sexps-backward)) ;C-u C-u
- (t (error "Invalid prefix argument: %S" argument))))
- ((paredit-region-active-p)
- (save-excursion
- (save-restriction
- (narrow-to-region (region-beginning) (region-end))
- (cond ((= (point) (point-min)) (paredit-count-sexps-forward))
- ((= (point) (point-max)) (paredit-count-sexps-backward))
- (t
- (error "Point %S is not start or end of region: %S..%S"
- (point) (region-beginning) (region-end)))))))
- (t 1)))
-
-(defun paredit-count-sexps-forward ()
- (save-excursion
- (let ((n 0) (p nil)) ;hurk
- (paredit-ignore-sexp-errors
- (while (setq p (scan-sexps (point) +1))
- (goto-char p)
- (setq n (+ n 1))))
- n)))
-
-(defun paredit-count-sexps-backward ()
- (save-excursion
- (let ((n 0) (p nil)) ;hurk
- (paredit-ignore-sexp-errors
- (while (setq p (scan-sexps (point) -1))
- (goto-char p)
- (setq n (+ n 1))))
- n)))
-
-(defun paredit-point-at-sexp-boundary (n)
- (cond ((< n 0) (paredit-point-at-sexp-start))
- ((= n 0) (point))
- ((> n 0) (paredit-point-at-sexp-end))))
-
-(defun paredit-point-at-sexp-start ()
- (save-excursion
- (forward-sexp)
- (backward-sexp)
- (point)))
-
-(defun paredit-point-at-sexp-end ()
- (save-excursion
- (backward-sexp)
- (forward-sexp)
- (point)))
-
-(defun paredit-lose-if-not-in-sexp (command)
- (if (or (paredit-in-string-p)
- (paredit-in-comment-p)
- (paredit-in-char-p))
- (error "Invalid context for command `%s'." command)))
-
-(defun paredit-check-region (start end)
- "Signal an error if text between `start' and `end' is unbalanced."
- ;; `narrow-to-region' will move the point, so avoid calling it if we
- ;; don't need to. We don't want to use `save-excursion' because we
- ;; want the point to move if `check-parens' reports an error.
- (if (not (paredit-region-ok-p start end))
- (save-restriction
- (narrow-to-region start end)
- (check-parens))))
-
-(defun paredit-region-ok-p (start end)
- "Return true iff the region between `start' and `end' is balanced.
-This is independent of context -- it doesn't check what state the
- text at `start' is in."
- (save-excursion
- (paredit-handle-sexp-errors
- (progn
- (save-restriction
- (narrow-to-region start end)
- (scan-sexps (point-min) (point-max)))
- t)
- nil)))
-
-(defun paredit-current-indentation ()
- (save-excursion
- (back-to-indentation)
- (current-column)))
-
-(defun paredit-restore-column (column indentation)
- ;; Preserve the point's position either in the indentation or in the
- ;; code: if on code, move with the code; if in indentation, leave it
- ;; in the indentation, either where it was (if still on indentation)
- ;; or at the end of the indentation (if the code moved far enough
- ;; left).
- (let ((indentation* (paredit-current-indentation)))
- (goto-char
- (+ (point-at-bol)
- (cond ((not (< column indentation))
- (+ column (- indentation* indentation)))
- ((<= indentation* column) indentation*)
- (t column))))))
-
-;;;; Initialization
-
-(paredit-define-keys)
-(paredit-annotate-mode-with-examples)
-(paredit-annotate-functions-with-examples)
-
-(provide 'paredit)
-
-;;; Local Variables:
-;;; outline-regexp: " \n;;;;+"
-;;; End:
-
-;;; paredit.el ends here
diff --git a/elpa/paredit-24/paredit.elc b/elpa/paredit-24/paredit.elc
Binary files differ.
diff --git a/elpa/vertico-0.17.signed b/elpa/vertico-0.17.signed
@@ -1 +0,0 @@
-Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2021-12-01T23:15:02+0100 using RSA
-\ No newline at end of file
diff --git a/elpa/vertico-0.17/LICENSE b/elpa/vertico-0.17/LICENSE
@@ -1,674 +0,0 @@
- 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/vertico-0.17/README.org b/elpa/vertico-0.17/README.org
@@ -1,445 +0,0 @@
-#+title: vertico.el - VERTical Interactive COmpletion
-#+author: Daniel Mendler
-#+language: en
-#+export_file_name: vertico.texi
-#+texinfo_dir_category: Emacs
-#+texinfo_dir_title: Vertico: (vertico).
-#+texinfo_dir_desc: VERTical Interactive COmpletion.
-
-#+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/vertico.html"><img alt="GNU ELPA" src="https://elpa.gnu.org/packages/vertico.svg"/></a>
-#+html: <a href="http://elpa.gnu.org/devel/vertico.html"><img alt="GNU-devel ELPA" src="https://elpa.gnu.org/devel/vertico.svg"/></a>
-#+html: <img src="https://upload.wikimedia.org/wikipedia/commons/thumb/7/75/Vertigomovie_restoration.jpg/800px-Vertigomovie_restoration.jpg" align="right" width="30%">
-
-* Introduction
-
- Vertico provides a performant and minimalistic vertical completion UI based on
- the default completion system. The main focus of Vertico is to provide a UI
- which behaves /correctly/ under all circumstances. By reusing the built-in
- facilities system, Vertico achieves /full compatibility/ with built-in Emacs
- completion commands and completion tables. Vertico only provides the
- completion UI but aims to be flexible and extensible. Additional enhancements
- are available as [[#extensions][extensions]] or [[#complementary-packages][complementary packages]]. The code base is small
- and maintainable (~vertico.el~ is only about 600 lines of code without white
- space and comments).
-
-* Features
-
- - Vertical display with arrow key navigation
- - Prompt shows the current candidate index and the total number of candidates
- - The current candidate is inserted with =TAB= and selected with =RET=
- - Non-existing candidates can be entered by moving the point to the prompt line
- - Configurable sorting by history position, length and alphabetically
- - Long candidates with newlines are formatted to take up less space
- - Deferred completion style highlighting for performance
- - Support for annotations (~annotation-function~ and ~affixation-function~)
- - Support for grouping and group cycling commands (~group-function~)
-
- [[https://github.com/minad/vertico/blob/main/screenshot.svg?raw=true]]
-
-* Key bindings
-
- Vertico defines its own local keymap in the minibuffer which is derived from
- ~minibuffer-local-map~. The keymap keeps most of the ~fundamental-mode~
- keybindings intact and remaps and binds only a handful of commands. Note in
- particular the binding of =TAB= to ~vertico-insert~ and the bindings of
- ~vertico-exit/exit-input~.
-
- - ~beginning-of-buffer~, ~minibuffer-beginning-of-buffer~ -> ~vertico-first~
- - ~end-of-buffer~ -> ~vertico-last~
- - ~scroll-down-command~ -> ~vertico-scroll-down~
- - ~scroll-up-command~ -> ~vertico-scroll-up~
- - ~next-line~, ~next-line-or-history-element~ -> ~vertico-next~
- - ~previous-line~, ~previous-line-or-history-element~ -> ~vertico-previous~
- - ~forward-paragraph~ -> ~vertico-next-group~
- - ~backward-paragraph~ -> ~vertico-previous-group~
- - ~exit-minibuffer~ -> ~vertico-exit~
- - ~kill-ring-save~ -> ~vertico-save~
- - =C-<return>= -> ~vertico-exit-input~
- - =TAB= -> ~vertico-insert~
-
-* Configuration
-
- Vertico is available from [[http://elpa.gnu.org/packages/vertico.html][GNU ELPA]]. You can install it directly via
- ~package-install~. After installation, you can activate the global minor mode
- with =M-x vertico-mode=. In order to configure Vertico and other packages in
- your init.el, you may want to take advantage of ~use-package~. I recommend to
- give Orderless completion a try, which is different from the prefix TAB
- completion used by the basic default completion system or in shells. Here is
- an example configuration:
-
- #+begin_src emacs-lisp
- ;; Enable vertico
- (use-package vertico
- :init
- (vertico-mode)
-
- ;; Different scroll margin
- ;; (setq vertico-scroll-margin 0)
-
- ;; Show more candidates
- ;; (setq vertico-count 20)
-
- ;; Grow and shrink the Vertico minibuffer
- ;; (setq vertico-resize t)
-
- ;; Optionally enable cycling for `vertico-next' and `vertico-previous'.
- ;; (setq vertico-cycle t)
- )
-
- ;; Optionally use the `orderless' completion style. See
- ;; `+orderless-dispatch' in the Consult wiki for an advanced Orderless style
- ;; dispatcher. Additionally enable `partial-completion' for file path
- ;; expansion. `partial-completion' is important for wildcard support.
- ;; Multiple files can be opened at once with `find-file' if you enter a
- ;; wildcard. You may also give the `initials' completion style a try.
- (use-package orderless
- :init
- ;; Configure a custom style dispatcher (see the Consult wiki)
- ;; (setq orderless-style-dispatchers '(+orderless-dispatch)
- ;; orderless-component-separator #'orderless-escapable-split-on-space)
- (setq completion-styles '(orderless)
- completion-category-defaults nil
- completion-category-overrides '((file (styles partial-completion)))))
-
- ;; Persist history over Emacs restarts. Vertico sorts by history position.
- (use-package savehist
- :init
- (savehist-mode))
-
- ;; A few more useful configurations...
- (use-package emacs
- :init
- ;; Add prompt indicator to `completing-read-multiple'.
- ;; Alternatively try `consult-completing-read-multiple'.
- (defun crm-indicator (args)
- (cons (concat "[CRM] " (car args)) (cdr args)))
- (advice-add #'completing-read-multiple :filter-args #'crm-indicator)
-
- ;; Do not allow the cursor in the minibuffer prompt
- (setq minibuffer-prompt-properties
- '(read-only t cursor-intangible t face minibuffer-prompt))
- (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
-
- ;; Emacs 28: Hide commands in M-x which do not work in the current mode.
- ;; Vertico commands are hidden in normal buffers.
- ;; (setq read-extended-command-predicate
- ;; #'command-completion-default-include-p)
-
- ;; Enable recursive minibuffers
- (setq enable-recursive-minibuffers t))
- #+end_src
-
- See also the [[https://github.com/minad/vertico/wiki][Vertico Wiki]] for additional configuration tips.
-
-** Completion styles and TAB completion
-
- The bindings of the ~minibuffer-local-completion-map~ are not available in
- Vertico by default. This means that TAB works differently from what you may
- expect from the default Emacs completion system.
-
- If you prefer to have the default completion commands a key press away you can
- add new bindings or even replace the Vertico bindings. Then the default
- completion commands behave as usual. For example you can use =M-TAB= to cycle
- between candidates if you have set ~completion-cycle-threshold~.
-
- #+begin_src emacs-lisp
- (define-key vertico-map "?" #'minibuffer-completion-help)
- (define-key vertico-map (kbd "M-RET") #'minibuffer-force-complete-and-exit)
- (define-key vertico-map (kbd "M-TAB") #'minibuffer-complete)
- #+end_src
-
- The ~orderless~ completion style does not support completion of a common prefix
- substring, as you may be familiar with from shells or the basic default
- completion system. The reason is that the Orderless input string is usually
- not a prefix. In order to support completing prefixes you may want to combine
- ~orderless~ with ~substring~ in your =completion-styles= configuration.
-
- #+begin_src emacs-lisp
- (setq completion-styles '(substring orderless))
- #+end_src
-
- Alternatively you can experiment with the built-in completion-styles, e.g.,
- adding =partial-completion= or =flex=. The =partial-completion= style is important
- to add if you want to open multiple files at once with ~find-file~ using
- wildcards. In order to open multiple files at once, you have to move to the
- prompt and then press =RET=.
-
- #+begin_src emacs-lisp
- (setq completion-styles '(basic substring partial-completion flex))
- #+end_src
-
- Because Vertico is fully compatible with Emacs default completion
- system, further customization of completion behavior can be achieved
- by setting the designated Emacs variables. For example, one may wish
- to disable case-sensitivity for file and buffer matching when built-in
- completion styles are used instead of ~orderless~:
-
- #+begin_src emacs-lisp
- (setq read-file-name-completion-ignore-case t
- read-buffer-completion-ignore-case t
- completion-ignore-case t)
- #+end_src
-
-** Completion-at-point and completion-in-region
-
- The =completion-at-point= command is usually bound to =M-TAB= or =TAB=. In case you
- want to use Vertico for completion-at-point/completion-in-region, you can use
- the function ~consult-completion-in-region~ provided by the Consult package.
-
- #+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
-
- The =completion-in-region-function= setting also affects TAB completion in the
- minibuffer when =M-:= (~eval-expression~) is used.
-
- You may also want to look into my [[https://github.com/minad/corfu][Corfu]] package, which provides a minimal
- completion system for =completion-in-region= in a child frame popup. Corfu is
- also a narrowly focused package and developed in the same spirit as Vertico.
-
-** Completing-read-multiple (CRM)
-
- Consult offers an enhanced =completing-read-multiple= implementation which you
- can use with Vertico.
-
- #+begin_src emacs-lisp
- (advice-add #'completing-read-multiple
- :override #'consult-completing-read-multiple)
- #+end_src
-
-* Extensions
- :properties:
- :custom_id: extensions
- :end:
-
- We maintain small extension packages to Vertico in this repository in the
- subdirectory [[https://github.com/minad/vertico/tree/main/extensions][extensions/]]. The extensions are installed together with Vertico
- if you pull the package from ELPA. The extensions are of course inactive by
- default and can be enabled manually if desired. Furthermore it is possible to
- install all of the files separately, both ~vertico.el~ and the ~vertico-*.el~
- extensions. Currently the following extensions come with the Vertico ELPA
- package:
-
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-buffer.el][vertico-buffer]]: =vertico-buffer-mode= to display Vertico in a separate buffer
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-directory.el][vertico-directory]]: Commands for Ido-like directory navigation
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-flat.el][vertico-flat]]: =vertico-flat-mode= to enable a flat, horizontal display
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-grid.el][vertico-grid]]: =vertico-grid-mode= to enable a grid display
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-indexed.el][vertico-indexed]]: =vertico-indexed-mode= to select indexed candidates with prefix arguments
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-mouse.el][vertico-mouse]]: =vertico-mouse-mode= to support for scrolling and candidate selection
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-quick.el][vertico-quick]]: Commands to select using Avy-style quick keys
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-repeat.el][vertico-repeat]]: The command =vertico-repeat= repeats the last completion session
- - [[https://github.com/minad/vertico/blob/main/extensions/vertico-reverse.el][vertico-reverse]]: =vertico-reverse-mode= to reverse the display
-
- With these extensions it is possible to adapt Vertico such that it matches
- your preference or behaves similar to other familiar UIs. For example, the
- combination =vertico-flat= plus =vertico-directory= resembles Ido in look and
- feel. For an interface similar to Helm, the extension =vertico-buffer= allows
- you to configure more freely where the completion buffer opens, instead of
- growing the minibuffer.
-
- Configuration example for =vertico-directory=:
-
- #+begin_src emacs-lisp
- ;; Configure directory extension.
- (use-package vertico-directory
- :ensure nil
- ;; More convenient directory navigation commands
- :bind (:map vertico-map
- ("RET" . vertico-directory-enter)
- ("DEL" . vertico-directory-delete-char)
- ("M-DEL" . vertico-directory-delete-word))
- ;; Tidy shadowed file names
- :hook (rfn-eshadow-update-overlay . vertico-directory-tidy))
- #+end_src
-
-* Complementary packages
- :properties:
- :custom_id: complementary-packages
- :end:
-
- Vertico integrates well with complementary packages, which enrich the
- completion UI. These packages are fully supported:
-
- - [[https://github.com/minad/marginalia][Marginalia]]: Rich annotations in the minibuffer
- - [[https://github.com/minad/consult][Consult]]: Useful search and navigation commands
- - [[https://github.com/oantolin/embark][Embark]]: Minibuffer actions and context menu
- - [[https://github.com/oantolin/orderless][Orderless]]: Advanced completion style
-
- In order to get accustomed with the package ecosystem, I recommed the
- following approach:
-
- 1. Start with plain Emacs.
- 2. Install and enable Vertico to get incremental minibuffer completion.
- 3. Install Orderless and/or configure the built-in completion styles
- for more flexible minibuffer filtering.
- 4. Install Marginalia if you like rich minibuffer annotations.
- 5. Install Embark and add two keybindings for ~embark-dwim~ and ~embark-act~.
- I am using =M-.= and =C-.=. These commands allow you to act on the object
- at point or in the minibuffer.
- 6. Install Consult if you want additional featureful completion commands,
- e.g, the buffer switcher ~consult-buffer~ with preview or the line-based
- search ~consult-line~.
- 7. Install Embark-Consult and Wgrep for export from =consult-line= to =occur-mode=
- buffers and from =consult-grep= to editable =grep-mode= buffers.
-
- You don't have to use all of these components. Use only the ones you like and
- the ones which fit well into your setup. The steps 1. to 4. introduce no new
- commands over plain Emacs. Step 5. introduces the new commands ~embark-act~ and
- ~embark-dwim~. In step 6. you get the Consult commands, some offer new
- functionality not present in Emacs already (e.g., ~consult-line~) and some are
- substitutes (e.g., ~consult-buffer~ for ~switch-to-buffer~).
-
-* Child frames and Popups
-
-An often requested feature is the ability to display the completions in a child
-frame popup. I do not recommend this, since from my experience it introduces
-more problems than it solves. Child frames can feel slow and sometimes flicker.
-On the other hand the completion display appears right in your focus at the
-center of the screen, leading to a modern look and feel. Please give these
-packages a try and judge for yourself.
-
-- [[https://github.com/muffinmad/emacs-mini-frame][mini-frame]]: Display the entire minibuffer in a child frame.
-- [[https://github.com/minad/mini-popup][mini-popup]]: Slightly simpler alternative to mini-frame.
-- [[https://github.com/tumashu/vertico-posframe][vertico-posframe]]: Display only the Vertico minibuffer in a child frame using
- the posframe library.
-
-* Alternatives
-
- There are many alternative completion UIs, each UI with its own advantages and
- disadvantages.
-
- Vertico aims to be 100% compliant with all Emacs commands and achieves that
- with a minimal code base, relying purely on ~completing-read~ while avoiding to
- invent its own APIs. Inventing a custom API as Helm or Ivy is explicitly
- avoided in order to increase flexibility and package reuse. Due to its small
- code base and reuse of the Emacs built-in facilities, bugs and compatibility
- issues are less likely to occur in comparison to completion UIs or full
- completion systems, which reimplement a lot of functionality.
-
- Since Vertico only provides the UI, you may want to combine it with some of
- the complementary packages, to give a full-featured completion experience
- similar to Helm or Ivy. Overall the packages in the spirit of Vertico have a
- different style than Helm or Ivy. The idea is to have smaller independent
- components, which one can add and understand step by step. Each component
- focuses on its niche and tries to be as non-intrusive as possible. Vertico
- targets users interested in crafting their Emacs precisely to their liking -
- completion plays an integral part in how the users interacts with Emacs.
-
- There are other interactive completion UIs, which follow a similar philosophy:
-
- - [[https://github.com/raxod502/selectrum][Selectrum]]: Selectrum has a similar UI as Vertico, since it directly inspired
- Vertico. The Selectrum code base is more complex. Unfortunately Selectrum is
- not fully compatible with every Emacs completion command ([[https://github.com/raxod502/selectrum/issues/481][Issue #481]]), since
- it uses its own filtering infrastructure, which deviates from the standard
- Emacs completion facilities. Vertico additionally has the ability to cycle
- over candidates, offers commands for grouping support and comes with a rich
- set of [[#extensions][extensions]].
- - [[https://github.com/oantolin/icomplete-vertical][Icomplete-vertical]]: This package enhances the Emacs builtin Icomplete with a
- vertical display. In contrast to Vertico, Icomplete rotates the candidates
- such that the current candidate always appears at the top. From my
- perspective, candidate rotation feels a bit less intuitive than the UI of
- Vertico or Selectrum. Note that Emacs 28 offers a built-in
- ~icomplete-vertical-mode~.
- - [[https://gitlab.com/protesilaos/mct][Mct]]: Minibuffer and Completions in Tandem. Mct reuses the default ~*Completions*~
- buffer and enhances it with automatic updates and additional keybindings, to
- select a candidate and move between minibuffer and completions buffer. Mct
- is great if you prefer an unobtrusive UI since it can be configured to open
- only when requested. Furthermore since Mct uses a fully functional buffer
- you can reuse all your familar buffer commands inside the completions
- buffer. The main distinction to an approach like Vertico's is that
- ~*Completions*~ buffer displays all matching candidates. On the one hand this
- is good since it allows you to interact with all the candidates and jump
- around with Isearch or Avy. On the other hand it necessarily causes a small
- slowdown in comparison to Vertico, which only displays a small subset of
- candidates.
-
-* Problematic completion commands
-
- Vertico is robust in most scenarios. However some completion commands make
- certain assumptions about the completion styles and the completion UI. Some of
- these assumptions may not hold in Vertico or other UIs and require minor
- workarounds.
-
-** ~org-refile~
-
- ~org-refile~ uses ~org-olpath-completing-read~ to complete the outline path
- in steps, when ~org-refile-use-outline-path~ is non-nil.
-
- Unfortunately the implementation of this Org completion table assumes that
- the default completion UI is used. In order to fix the issue at the root, the
- completion table should make use of completion boundaries similar to the
- built-in file completion table.
-
- In order to workaround the issues with the current implementation I recommend
- to disable the outline path completion in steps. The completion on the full
- path is also faster since the input string matches directly against the full
- path, which is particularily useful with Orderless.
-
- #+begin_src emacs-lisp
- (setq org-refile-use-outline-path 'file
- org-outline-path-complete-in-steps nil)
- #+end_src
-
-** ~tmm-menubar~
-
- The text menu bar works well with Vertico but always shows a =*Completions*=
- buffer, which is unwanted if you use the Vertico UI. This completion buffer
- can be disabled as follows.
-
- #+begin_src emacs-lisp
- (advice-add #'tmm-add-prompt :after #'minibuffer-hide-completions)
- #+end_src
-
-** ~ffap-menu~
-
- The command ~ffap-menu~ shows the ==*Completions*= buffer by default like
- ~tmm-menubar~, which is unnecessary with Vertico. This completion buffer can be
- disabled as follows.
-
- #+begin_src emacs-lisp
- (advice-add #'ffap-menu-ask :around (lambda (&rest args)
- (cl-letf (((symbol-function #'minibuffer-completion-help)
- #'ignore))
- (apply args))))
- #+end_src
-
-** Tramp hostname completion
-
- In combination with Orderless, hostnames are not made available for
- completion after entering =/ssh:=. In order to avoid this problem, the =basic=
- completion style should be specified for the file completion category.
-
- #+begin_src emacs-lisp
- (setq completion-styles '(orderless)
- completion-category-overrides '((file (styles basic partial-completion))))
- #+end_src
-
- For users who are familiar with the =completion-style= machinery: You may also
- define a custom completion style which sets in only for remote files!
-
- #+begin_src emacs-lisp
- (defun basic-remote-try-completion (string table pred point)
- (and (vertico--remote-p string)
- (completion-basic-try-completion string table pred point)))
- (defun basic-remote-all-completions (string table pred point)
- (and (vertico--remote-p string)
- (completion-basic-all-completions string table pred point)))
- (add-to-list
- 'completion-styles-alist
- '(basic-remote basic-remote-try-completion basic-remote-all-completions nil))
- (setq completion-styles '(orderless)
- completion-category-overrides '((file (styles basic-remote partial-completion))))
- #+end_src
-
-* Contributions
-
- Since this package is part of [[http://elpa.gnu.org/packages/vertico.html][GNU ELPA]] contributions require a copyright
- assignment to the FSF.
diff --git a/elpa/vertico-0.17/dir b/elpa/vertico-0.17/dir
@@ -1,18 +0,0 @@
-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
-* Vertico: (vertico). VERTical Interactive COmpletion.
diff --git a/elpa/vertico-0.17/vertico-autoloads.el b/elpa/vertico-0.17/vertico-autoloads.el
@@ -1,265 +0,0 @@
-;;; vertico-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-
-;;;### (autoloads nil "vertico" "vertico.el" (0 0 0 0))
-;;; Generated autoloads from vertico.el
-
-(defvar vertico-mode nil "\
-Non-nil if Vertico mode is enabled.
-See the `vertico-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `vertico-mode'.")
-
-(custom-autoload 'vertico-mode "vertico" nil)
-
-(autoload 'vertico-mode "vertico" "\
-VERTical Interactive COmpletion.
-
-If called interactively, enable Vertico mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp,
-also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico" '("vertico-")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-buffer" "vertico-buffer.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from vertico-buffer.el
-
-(defvar vertico-buffer-mode nil "\
-Non-nil if Vertico-Buffer mode is enabled.
-See the `vertico-buffer-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `vertico-buffer-mode'.")
-
-(custom-autoload 'vertico-buffer-mode "vertico-buffer" nil)
-
-(autoload 'vertico-buffer-mode "vertico-buffer" "\
-Display Vertico in a buffer instead of the minibuffer.
-
-If called interactively, enable Vertico-Buffer mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-buffer" '("vertico-buffer-")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-directory" "vertico-directory.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from vertico-directory.el
-
-(autoload 'vertico-directory-enter "vertico-directory" "\
-Enter directory or exit completion with current candidate." t nil)
-
-(autoload 'vertico-directory-up "vertico-directory" "\
-Delete directory before point." t nil)
-
-(autoload 'vertico-directory-delete-char "vertico-directory" "\
-Delete directory or char before point." t nil)
-
-(autoload 'vertico-directory-delete-word "vertico-directory" "\
-Delete directory or word before point." t nil)
-
-(autoload 'vertico-directory-tidy "vertico-directory" "\
-Tidy shadowed file name, see `rfn-eshadow-overlay'." nil nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-directory" '("vertico-directory--completing-file-p")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-flat" "vertico-flat.el" (0 0 0 0))
-;;; Generated autoloads from vertico-flat.el
-
-(defvar vertico-flat-mode nil "\
-Non-nil if Vertico-Flat mode is enabled.
-See the `vertico-flat-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `vertico-flat-mode'.")
-
-(custom-autoload 'vertico-flat-mode "vertico-flat" nil)
-
-(autoload 'vertico-flat-mode "vertico-flat" "\
-Flat, horizontal display for Vertico.
-
-If called interactively, enable Vertico-Flat mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-flat" '("vertico-flat-")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-grid" "vertico-grid.el" (0 0 0 0))
-;;; Generated autoloads from vertico-grid.el
-
-(defvar vertico-grid-mode nil "\
-Non-nil if Vertico-Grid mode is enabled.
-See the `vertico-grid-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `vertico-grid-mode'.")
-
-(custom-autoload 'vertico-grid-mode "vertico-grid" nil)
-
-(autoload 'vertico-grid-mode "vertico-grid" "\
-Grid display for Vertico.
-
-If called interactively, enable Vertico-Grid mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-grid" '("vertico-grid-")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-indexed" "vertico-indexed.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from vertico-indexed.el
-
-(defvar vertico-indexed-mode nil "\
-Non-nil if Vertico-Indexed mode is enabled.
-See the `vertico-indexed-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `vertico-indexed-mode'.")
-
-(custom-autoload 'vertico-indexed-mode "vertico-indexed" nil)
-
-(autoload 'vertico-indexed-mode "vertico-indexed" "\
-Prefix candidates with indices.
-
-If called interactively, enable Vertico-Indexed mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-indexed" '("vertico-indexed--")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-mouse" "vertico-mouse.el" (0 0 0 0))
-;;; Generated autoloads from vertico-mouse.el
-
-(defvar vertico-mouse-mode nil "\
-Non-nil if Vertico-Mouse mode is enabled.
-See the `vertico-mouse-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `vertico-mouse-mode'.")
-
-(custom-autoload 'vertico-mouse-mode "vertico-mouse" nil)
-
-(autoload 'vertico-mouse-mode "vertico-mouse" "\
-Mouse support for Vertico.
-
-If called interactively, enable Vertico-Mouse mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-mouse" '("vertico-")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-quick" "vertico-quick.el" (0 0 0 0))
-;;; Generated autoloads from vertico-quick.el
-
-(autoload 'vertico-quick-jump "vertico-quick" "\
-Jump to candidate using quick keys." t nil)
-
-(autoload 'vertico-quick-exit "vertico-quick" "\
-Exit with candidate using quick keys." t nil)
-
-(autoload 'vertico-quick-insert "vertico-quick" "\
-Insert candidate using quick keys." t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-quick" '("vertico-quick")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-repeat" "vertico-repeat.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from vertico-repeat.el
-
-(autoload 'vertico-repeat "vertico-repeat" "\
-Repeat last Vertico completion session." t nil)
-
-(autoload 'vertico-repeat-save "vertico-repeat" "\
-Save Vertico status for `vertico-repeat'.
-This function must be registered as `minibuffer-setup-hook'." nil nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-repeat" '("vertico-repeat--")))
-
-;;;***
-
-;;;### (autoloads nil "vertico-reverse" "vertico-reverse.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from vertico-reverse.el
-
-(defvar vertico-reverse-mode nil "\
-Non-nil if Vertico-Reverse mode is enabled.
-See the `vertico-reverse-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `vertico-reverse-mode'.")
-
-(custom-autoload 'vertico-reverse-mode "vertico-reverse" nil)
-
-(autoload 'vertico-reverse-mode "vertico-reverse" "\
-Reverse the Vertico display.
-
-If called interactively, enable Vertico-Reverse mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-reverse" '("vertico-reverse-")))
-
-;;;***
-
-;;;### (autoloads nil nil ("vertico-pkg.el") (0 0 0 0))
-
-;;;***
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; vertico-autoloads.el ends here
diff --git a/elpa/vertico-0.17/vertico-buffer.el b/elpa/vertico-0.17/vertico-buffer.el
@@ -1,141 +0,0 @@
-;;; vertico-buffer.el --- Display Vertico in a buffer instead of the minibuffer -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension, which allows to display Vertico
-;; in a buffer instead of the minibuffer. The buffer display can be enabled
-;; by the `vertico-buffer-mode'.
-
-;;; Code:
-
-(require 'vertico)
-
-(defvar-local vertico-buffer--overlay nil)
-(defvar-local vertico-buffer--buffer nil)
-
-(defcustom vertico-buffer-display-action
- `(display-buffer-in-side-window
- (window-height . ,(+ 3 vertico-count))
- (side . top))
- "Display action for the Vertico buffer."
- :type `(choice
- (const :tag "Reuse some window"
- (display-buffer-reuse-window))
- (const :tag "Below target buffer"
- (display-buffer-below-selected
- (window-height . ,(+ 3 vertico-count))))
- (const :tag "Bottom of frame"
- (display-buffer-at-bottom
- (window-height . ,(+ 3 vertico-count))))
- (const :tag "Side window on the right"
- (display-buffer-in-side-window
- (side . right)
- (window-width . 0.3)))
- (const :tag "Side window on the left"
- (display-buffer-in-side-window
- (side . left)
- (window-width . 0.3)))
- (const :tag "Side window at the top"
- (display-buffer-in-side-window
- (window-height . ,(+ 3 vertico-count))
- (side . top)))
- (const :tag "Side window at the bottom"
- (display-buffer-in-side-window
- (window-height . ,(+ 3 vertico-count))
- (side . bottom)))
- (sexp :tag "Other")))
-
-(defun vertico-buffer--display (lines)
- "Display LINES in buffer."
- (set-window-vscroll nil 100)
- (let ((count (vertico--format-count))
- (prompt (minibuffer-prompt))
- (content (minibuffer-contents)))
- (with-current-buffer vertico-buffer--buffer
- (with-silent-modifications
- (erase-buffer)
- (insert (propertize (concat count prompt) 'face 'minibuffer-prompt)
- content "\n" (string-join lines))))
- (let ((win (or (get-buffer-window vertico-buffer--buffer)
- (display-buffer vertico-buffer--buffer vertico-buffer-display-action))))
- (overlay-put vertico--candidates-ov 'window win)
- (when vertico--count-ov
- (overlay-put vertico--count-ov 'window win))
- (set-window-point win (max (+ 1 (length prompt) (length count))
- (+ (point) (length count))))
- (with-current-buffer vertico-buffer--buffer
- (setq-local truncate-lines (< (window-point win) (* 0.8 (window-width win))))))))
-
-(defun vertico-buffer--select (_)
- "Ensure that cursor is only shown if minibuffer is selected."
- (with-current-buffer (buffer-local-value 'vertico-buffer--buffer
- (window-buffer (active-minibuffer-window)))
- (if (eq (selected-window) (active-minibuffer-window))
- (setq-local cursor-in-non-selected-windows 'box)
- (setq-local cursor-in-non-selected-windows nil)
- (goto-char (point-min)))))
-
-(defun vertico-buffer--destroy ()
- "Destroy Vertico buffer."
- (set-window-vscroll nil 0)
- (kill-buffer vertico-buffer--buffer))
-
-(defun vertico-buffer--setup ()
- "Setup minibuffer overlay, which pushes the minibuffer content down."
- (add-hook 'window-selection-change-functions 'vertico-buffer--select nil 'local)
- (add-hook 'minibuffer-exit-hook 'vertico-buffer--destroy nil 'local)
- (setq-local cursor-type '(bar . 0))
- (setq vertico-buffer--overlay (make-overlay (point-max) (point-max) nil t t))
- (overlay-put vertico-buffer--overlay 'window (selected-window))
- (overlay-put vertico-buffer--overlay 'priority 1000)
- (overlay-put vertico-buffer--overlay 'before-string "\n\n")
- (setq vertico-buffer--buffer (get-buffer-create
- (if (= 1 (recursion-depth))
- " *Vertico*"
- (format " *Vertico-%s*" (1- (recursion-depth))))))
- (with-current-buffer vertico-buffer--buffer
- (add-hook 'window-selection-change-functions 'vertico-buffer--select nil 'local)
- (setq-local display-line-numbers nil
- truncate-lines t
- show-trailing-whitespace nil
- buffer-read-only t
- cursor-in-non-selected-windows 'box)))
-
-;;;###autoload
-(define-minor-mode vertico-buffer-mode
- "Display Vertico in a buffer instead of the minibuffer."
- :global t :group 'vertico
- (cond
- (vertico-buffer-mode
- (advice-add #'vertico--display-candidates :override #'vertico-buffer--display)
- (advice-add #'vertico--setup :after #'vertico-buffer--setup))
- (t
- (advice-remove #'vertico--display-candidates #'vertico-buffer--display)
- (advice-remove #'vertico--setup #'vertico-buffer--setup))))
-
-(provide 'vertico-buffer)
-;;; vertico-buffer.el ends here
diff --git a/elpa/vertico-0.17/vertico-buffer.elc b/elpa/vertico-0.17/vertico-buffer.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico-directory.el b/elpa/vertico-0.17/vertico-directory.el
@@ -1,113 +0,0 @@
-;;; vertico-directory.el --- Ido-like direction navigation for Vertico -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension, which provides Ido-like
-;; directory navigation commands. The commands can be bound in the
-;; `vertico-map'. Furthermore a cleanup function for shadowed file paths
-;; is provided.
-;;
-;; (define-key vertico-map "\r" #'vertico-directory-enter)
-;; (define-key vertico-map "\d" #'vertico-directory-delete-char)
-;; (define-key vertico-map "\M-\d" #'vertico-directory-delete-word)
-;; (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)
-
-;;; Code:
-
-(require 'vertico)
-
-(defun vertico-directory--completing-file-p ()
- "Return non-nil when completing file names."
- (eq 'file
- (completion-metadata-get
- (completion-metadata
- (buffer-substring (minibuffer-prompt-end)
- (max (minibuffer-prompt-end) (point)))
- minibuffer-completion-table
- minibuffer-completion-predicate)
- 'category)))
-
-;;;###autoload
-(defun vertico-directory-enter ()
- "Enter directory or exit completion with current candidate."
- (interactive)
- (if (and (>= vertico--index 0)
- (let ((cand (vertico--candidate)))
- (or (string-suffix-p "/" cand)
- (and (vertico--remote-p cand)
- (string-suffix-p ":" cand))))
- (vertico-directory--completing-file-p))
- (vertico-insert)
- (vertico-exit)))
-
-;;;###autoload
-(defun vertico-directory-up ()
- "Delete directory before point."
- (interactive)
- (when (and (> (point) (minibuffer-prompt-end))
- (eq (char-before) ?/)
- (vertico-directory--completing-file-p))
- (save-excursion
- (goto-char (1- (point)))
- (when (search-backward "/" (minibuffer-prompt-end) t)
- (delete-region (1+ (point)) (point-max))
- t))))
-
-;;;###autoload
-(defun vertico-directory-delete-char ()
- "Delete directory or char before point."
- (interactive)
- (unless (vertico-directory-up)
- (call-interactively #'backward-delete-char)))
-
-;;;###autoload
-(defun vertico-directory-delete-word ()
- "Delete directory or word before point."
- (interactive)
- (unless (vertico-directory-up)
- (let ((pt (point)))
- (forward-word -1)
- (delete-region pt (point)))))
-
-;;;###autoload
-(defun vertico-directory-tidy ()
- "Tidy shadowed file name, see `rfn-eshadow-overlay'."
- (when (and (eq this-command #'self-insert-command)
- (bound-and-true-p rfn-eshadow-overlay)
- (overlay-buffer rfn-eshadow-overlay)
- (= (point) (point-max))
- (or (>= (- (point) (overlay-end rfn-eshadow-overlay)) 2)
- (eq ?/ (char-before (- (point) 2)))))
- (delete-region (overlay-start rfn-eshadow-overlay) (overlay-end rfn-eshadow-overlay))))
-
-;; Emacs 28: Do not show Vertico commands in M-X
-(dolist (sym '(vertico-directory-up vertico-directory-enter
- vertico-directory-delete-char vertico-directory-delete-word))
- (put sym 'completion-predicate #'vertico--command-p))
-
-(provide 'vertico-directory)
-;;; vertico-directory.el ends here
diff --git a/elpa/vertico-0.17/vertico-directory.elc b/elpa/vertico-0.17/vertico-directory.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico-flat.el b/elpa/vertico-0.17/vertico-flat.el
@@ -1,122 +0,0 @@
-;;; vertico-flat.el --- Flat, horizontal display for Vertico -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension providing a horizontal display.
-;;
-;; The mode can be bound to a key to toggle to the horizontal display.
-;; (define-key vertico-map "\M-F" #'vertico-flat-mode)
-
-;;; Code:
-
-(require 'vertico)
-
-(defcustom vertico-flat-max-lines 1
- "Maximal number of lines to use."
- :type 'integer
- :group 'vertico)
-
-(defcustom vertico-flat-format
- '(:left #("{" 0 1 (face minibuffer-prompt))
- :separator #(" | " 0 3 (face minibuffer-prompt))
- :right #("}" 0 1 (face minibuffer-prompt))
- :ellipsis #("…" 0 1 (face minibuffer-prompt))
- :no-match "[No match]")
- "Formatting strings."
- :type 'plist
- :group 'vertico)
-
-(defun vertico-flat--display (candidates)
- "Display CANDIDATES horizontally."
- (setq-local truncate-lines nil)
- (move-overlay vertico--candidates-ov (point-max) (point-max))
- (overlay-put
- vertico--candidates-ov 'after-string
- (concat #(" " 0 1 (cursor t))
- (if candidates
- (concat (plist-get vertico-flat-format :left)
- (string-join candidates (plist-get vertico-flat-format :separator))
- (plist-get vertico-flat-format :right))
- (plist-get vertico-flat-format :no-match)))))
-
-(defun vertico-flat--arrange-candidates ()
- "Arrange candidates."
- (let* ((index (max 0 vertico--index)) (count vertico-count)
- (candidates (nthcdr vertico--index vertico--candidates))
- (width (- (* vertico-flat-max-lines (- (window-width) 4))
- (length (plist-get vertico-flat-format :left))
- (length (plist-get vertico-flat-format :separator))
- (length (plist-get vertico-flat-format :right))
- (length (plist-get vertico-flat-format :ellipsis))
- (car (posn-col-row (posn-at-point (1- (point-max)))))))
- (result) (wrapped))
- (while (and candidates (not (eq wrapped (car candidates)))
- (> width 0) (> count 0))
- (let ((cand (car candidates)))
- (setq cand (car (funcall vertico--highlight-function (list cand))))
- (when (string-match-p "\n" cand)
- (setq cand (vertico--truncate-multiline cand width)))
- (setq cand (string-trim
- (replace-regexp-in-string
- "[ \t]+"
- (lambda (x) (apply #'propertize " " (text-properties-at 0 x)))
- (vertico--format-candidate cand "" "" index vertico--index))))
- (setq index (1+ index)
- count (1- count)
- width (- width (string-width cand) (length (plist-get vertico-flat-format :separator))))
- (when (or (not result) (> width 0))
- (push cand result))
- (pop candidates)
- (when (and vertico-cycle (not candidates))
- (setq candidates vertico--candidates index 0
- wrapped (nth vertico--index vertico--candidates)))))
- (when (if wrapped
- (> vertico--total (- vertico-count count))
- (and (/= vertico--total 0) (/= index vertico--total)))
- (push (plist-get vertico-flat-format :ellipsis) result))
- (nreverse result)))
-
-;;;###autoload
-(define-minor-mode vertico-flat-mode
- "Flat, horizontal display for Vertico."
- :global t :group 'vertico
- (cond
- (vertico-flat-mode
- ;; Allow toggling between flat and grid modes
- (when (and (bound-and-true-p vertico-grid-mode) (fboundp #'vertico-grid-mode))
- (vertico-grid-mode -1))
- ;; Shrink current minibuffer window
- (when-let (win (active-minibuffer-window))
- (window-resize win (- (window-pixel-height)) nil nil 'pixelwise))
- (advice-add #'vertico--arrange-candidates :override #'vertico-flat--arrange-candidates)
- (advice-add #'vertico--display-candidates :override #'vertico-flat--display))
- (t
- (advice-remove #'vertico--arrange-candidates #'vertico-flat--arrange-candidates)
- (advice-remove #'vertico--display-candidates #'vertico-flat--display))))
-
-(provide 'vertico-flat)
-;;; vertico-flat.el ends here
diff --git a/elpa/vertico-0.17/vertico-flat.elc b/elpa/vertico-0.17/vertico-flat.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico-grid.el b/elpa/vertico-0.17/vertico-grid.el
@@ -1,158 +0,0 @@
-;;; vertico-grid.el --- Grid display for Vertico -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension providing a grid display.
-;;
-;; The mode can be bound to a key to toggle to the grid display.
-;; (define-key vertico-map "\M-G" #'vertico-grid-mode)
-
-;;; Code:
-
-(require 'vertico)
-(eval-when-compile
- (require 'cl-lib))
-
-(defcustom vertico-grid-max-columns 8
- "Maximal number of grid columns."
- :type 'integer
- :group 'vertico)
-
-(defcustom vertico-grid-separator
- #(" | " 2 3 (display (space :width (1)) face (:inverse-video t)))
- "Separator between columns."
- :type 'string
- :group 'vertico)
-
-(defcustom vertico-grid-rows 6
- "Number of grid rows."
- :type 'integer
- :group 'vertico)
-
-(defcustom vertico-grid-lookahead 200
- "Number of candidates to lookahead for column number computation.
-When scrolling beyond this limit, candidates may be truncated."
- :type 'integer
- :group 'vertico)
-
-(defvar-local vertico-grid--columns 1
- "Current number of grid columns.")
-
-(defun vertico-grid--arrange-candidates ()
- "Arrange candidates."
- (when (<= vertico--index 0)
- (let ((cand vertico--candidates) (w 1) (n 0))
- (while (and cand (< n vertico-grid-lookahead))
- (setq w (max w (length (car cand))) n (1+ n))
- (pop cand))
- (setq vertico-grid--columns
- (max 1 (min vertico-grid-max-columns
- (floor (window-width) (+ w (length vertico-grid-separator))))))))
- (let* ((sep (length vertico-grid-separator))
- (count (* vertico-grid-rows vertico-grid--columns))
- (start (* count (floor (max 0 vertico--index) count)))
- (width (- (/ (window-width) vertico-grid--columns) sep))
- (cands
- (seq-map-indexed (lambda (cand index)
- (cl-incf index start)
- (when (string-match-p "\n" cand)
- (setq cand (vertico--truncate-multiline cand width)))
- (truncate-string-to-width
- (string-trim
- (replace-regexp-in-string
- "[ \t]+"
- (lambda (x) (apply #'propertize " " (text-properties-at 0 x)))
- (vertico--format-candidate cand "" "" index start)))
- width))
- (funcall vertico--highlight-function
- (seq-subseq vertico--candidates start
- (min (+ start count)
- vertico--total)))))
- (width (make-vector vertico-grid--columns 0)))
- (dotimes (col vertico-grid--columns)
- (dotimes (row vertico-grid-rows)
- (aset width col (max
- (aref width col)
- (string-width (or (nth (+ row (* col vertico-grid-rows)) cands) ""))))))
- (dotimes (col (1- vertico-grid--columns))
- (cl-incf (aref width (1+ col)) (+ (aref width col) sep)))
- (cl-loop for row from 0 to (1- vertico-grid-rows) collect
- (let ((line (list "\n")))
- (cl-loop for col from (1- vertico-grid--columns) downto 0 do
- (when-let (cand (nth (+ row (* col vertico-grid-rows)) cands))
- (push cand line)
- (when (> col 0)
- (push vertico-grid-separator line)
- (push (propertize " " 'display
- `(space :align-to (+ left ,(aref width (1- col))))) line))))
- (string-join line)))))
-
-(defun vertico-grid-left (&optional n)
- "Move N columns to the left in the grid."
- (interactive "p")
- (vertico-grid-right (- (or n 1))))
-
-(defun vertico-grid-right (&optional n)
- "Move N columns to the right in the grid."
- (interactive "p")
- (let* ((page (* vertico-grid-rows vertico-grid--columns))
- (p (/ vertico--index page))
- (q (mod vertico--index page))
- (x (/ q vertico-grid-rows))
- (y (mod q vertico-grid-rows))
- (z (+ (* p page) (* vertico-grid--columns y) x (or n 1))))
- (setq x (mod z vertico-grid--columns)
- y (/ z vertico-grid--columns))
- (vertico--goto (+ (* x vertico-grid-rows) (mod y vertico-grid-rows)
- (* (/ y vertico-grid-rows) page)))))
-
-;;;###autoload
-(define-minor-mode vertico-grid-mode
- "Grid display for Vertico."
- :global t :group 'vertico
- (cond
- (vertico-grid-mode
- ;; Allow toggling between flat and grid modes
- (when (and (bound-and-true-p vertico-flat-mode) (fboundp #'vertico-flat-mode))
- (vertico-flat-mode -1))
- ;; Shrink current minibuffer window
- (when-let (win (active-minibuffer-window))
- (window-resize win (- (window-pixel-height)) nil nil 'pixelwise))
- (define-key vertico-map [remap left-char] #'vertico-grid-left)
- (define-key vertico-map [remap right-char] #'vertico-grid-right)
- (advice-add #'vertico--arrange-candidates :override #'vertico-grid--arrange-candidates))
- (t
- (assq-delete-all 'left-char (assq 'remap vertico-map))
- (assq-delete-all 'right-char (assq 'remap vertico-map))
- (advice-remove #'vertico--arrange-candidates #'vertico-grid--arrange-candidates))))
-
-;; Emacs 28: Do not show Vertico commands in M-X
-(dolist (sym '(vertico-grid-left vertico-grid-right))
- (put sym 'completion-predicate #'vertico--command-p))
-
-(provide 'vertico-grid)
-;;; vertico-grid.el ends here
diff --git a/elpa/vertico-0.17/vertico-grid.elc b/elpa/vertico-0.17/vertico-grid.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico-indexed.el b/elpa/vertico-0.17/vertico-indexed.el
@@ -1,83 +0,0 @@
-;;; vertico-indexed.el --- Select indexed candidates -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension, which prefixes candidates with
-;; indices and allows selection using prefix arguments.
-
-;;; Code:
-
-(require 'vertico)
-
-(defface vertico-indexed
- '((t :height 0.75 :inherit font-lock-comment-face))
- "Face used for the candidate index prefix."
- :group 'vertico-faces)
-
-(defvar vertico-indexed--commands
- '(vertico-insert vertico-exit vertico-directory-enter))
-(defvar-local vertico-indexed--min 0)
-(defvar-local vertico-indexed--max 0)
-
-(defun vertico-indexed--format-candidate (orig cand prefix suffix index start)
- "Format candidate, see `vertico--format-candidate' for arguments."
- (setq vertico-indexed--min start vertico-indexed--max index)
- (funcall orig cand
- (concat (propertize (format
- (format "%%%ds " (if (> vertico-count 10) 2 1))
- (- index start))
- 'face 'vertico-indexed)
- prefix)
- suffix index start))
-
-(defun vertico-indexed--handle-prefix (orig &rest args)
- "Handle prefix argument before calling ORIG function with ARGS."
- (if (and current-prefix-arg (called-interactively-p t))
- (let ((vertico--index (+ vertico-indexed--min (prefix-numeric-value current-prefix-arg))))
- (if (or (< vertico--index vertico-indexed--min)
- (> vertico--index vertico-indexed--max)
- (= vertico--total 0))
- (minibuffer-message "Out of range")
- (funcall orig)))
- (apply orig args)))
-
-;;;###autoload
-(define-minor-mode vertico-indexed-mode
- "Prefix candidates with indices."
- :global t :group 'vertico
- (cond
- (vertico-indexed-mode
- (advice-add #'vertico--format-candidate :around #'vertico-indexed--format-candidate)
- (dolist (cmd vertico-indexed--commands)
- (advice-add cmd :around #'vertico-indexed--handle-prefix)))
- (t
- (advice-remove #'vertico--format-candidate #'vertico-indexed--format-candidate)
- (dolist (cmd vertico-indexed--commands)
- (advice-remove cmd #'vertico-indexed--handle-prefix)))))
-
-(provide 'vertico-indexed)
-;;; vertico-indexed.el ends here
diff --git a/elpa/vertico-0.17/vertico-indexed.elc b/elpa/vertico-0.17/vertico-indexed.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico-mouse.el b/elpa/vertico-0.17/vertico-mouse.el
@@ -1,95 +0,0 @@
-;;; vertico-mouse.el --- Mouse support for Vertico -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension, which adds mouse support.
-
-;;; Code:
-
-(require 'vertico)
-
-(defface vertico-mouse
- '((t :inherit highlight))
- "Face used for mouse highlighting."
- :group 'vertico-faces)
-
-(defun vertico--mouse-candidate-map (index)
- "Return keymap for candidate with INDEX."
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] (lambda ()
- (interactive)
- (with-selected-window (active-minibuffer-window)
- (let ((vertico--index index))
- (vertico-exit)))))
- (define-key map [mouse-3] (lambda ()
- (interactive)
- (with-selected-window (active-minibuffer-window)
- (let ((vertico--index index))
- (vertico-insert)))))
- map))
-
-(defun vertico-mouse--format-candidate (orig cand prefix suffix index start)
- "Format candidate, see `vertico--format-candidate' for arguments."
- (setq cand (funcall orig cand prefix suffix index start))
- (when (equal suffix "")
- (setq cand (concat (substring cand 0 -1)
- (propertize " " 'display '(space :align-to right))
- "\n"))
- (when (= index vertico--index)
- (add-face-text-property 0 (length cand) 'vertico-current 'append cand)))
- (add-text-properties 0 (1- (length cand))
- `(mouse-face vertico-mouse keymap ,(vertico--mouse-candidate-map index))
- cand)
- cand)
-
-(defun vertico-mouse--scroll-up (n)
- "Scroll up by N lines."
- (vertico--goto (max 0 (+ vertico--index n))))
-
-(defun vertico-mouse--scroll-down (n)
- "Scroll down by N lines."
- (vertico-mouse--scroll-up (- n)))
-
-(defun vertico-mouse--setup ()
- "Setup mouse scrolling."
- (setq-local mwheel-scroll-up-function #'vertico-mouse--scroll-up
- mwheel-scroll-down-function #'vertico-mouse--scroll-down))
-
-;;;###autoload
-(define-minor-mode vertico-mouse-mode
- "Mouse support for Vertico."
- :global t :group 'vertico
- (cond
- (vertico-mouse-mode
- (advice-add #'vertico--format-candidate :around #'vertico-mouse--format-candidate)
- (advice-add #'vertico--setup :after #'vertico-mouse--setup))
- (t
- (advice-remove #'vertico--format-candidate #'vertico-mouse--format-candidate)
- (advice-remove #'vertico--setup #'vertico-reverse--setup))))
-
-(provide 'vertico-mouse)
-;;; vertico-mouse.el ends here
diff --git a/elpa/vertico-0.17/vertico-mouse.elc b/elpa/vertico-0.17/vertico-mouse.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico-pkg.el b/elpa/vertico-0.17/vertico-pkg.el
@@ -1,2 +0,0 @@
-;; Generated package description from vertico.el -*- no-byte-compile: t -*-
-(define-package "vertico" "0.17" "VERTical Interactive COmpletion" '((emacs "27.1")) :authors '(("Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '("Daniel Mendler" . "mail@daniel-mendler.de") :url "https://github.com/minad/vertico")
diff --git a/elpa/vertico-0.17/vertico-quick.el b/elpa/vertico-0.17/vertico-quick.el
@@ -1,140 +0,0 @@
-;;; vertico-quick.el --- Quick keys for Vertico -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension, which provides quick keys.
-;; (define-key vertico-map "\M-q" #'vertico-quick-insert)
-;; (define-key vertico-map "\C-q" #'vertico-quick-exit)
-
-;;; Code:
-
-(require 'vertico)
-(eval-when-compile
- (require 'cl-lib)
- (require 'subr-x))
-
-(defface vertico-quick1
- '((((class color) (min-colors 88) (background dark))
- :background "#7042a2" :weight bold :foreground "white")
- (((class color) (min-colors 88) (background light))
- :weight bold :background "#d5baff" :foreground "black")
- (t :background "magenta" :foreground "white"))
- "Face used for the first quick key."
- :group 'vertico-faces)
-
-(defface vertico-quick2
- '((((class color) (min-colors 88) (background dark))
- :background "#004065" :weight bold :foreground "white")
- (((class color) (min-colors 88) (background light))
- :weight bold :background "#8ae4f2" :foreground "black")
- (t :background "blue" :foreground "white"))
- "Face used for the second quick key."
- :group 'vertico-faces)
-
-(defcustom vertico-quick1 "asdfgh"
- "Single level quick keys."
- :type 'string
- :group 'vertico)
-
-(defcustom vertico-quick2 "jkl"
- "Two level quick keys."
- :type 'string
- :group 'vertico)
-
-(defvar-local vertico-quick--list nil)
-(defvar-local vertico-quick--first nil)
-
-(defun vertico-quick--format-candidate (orig cand prefix suffix index start)
- "Format candidate, see `vertico--format-candidate' for arguments."
- (let* ((fst (length vertico-quick1))
- (snd (length vertico-quick2))
- (len (+ fst snd))
- (idx (- index start))
- (keys (if (>= idx fst)
- (let ((first (elt vertico-quick2 (mod (/ (- idx fst) len) snd)))
- (second (elt (concat vertico-quick1 vertico-quick2) (mod (- idx fst) len))))
- (cond
- ((eq first vertico-quick--first)
- (push (cons second index) vertico-quick--list)
- (concat " " (propertize (char-to-string second) 'face 'vertico-quick1)))
- (vertico-quick--first " ")
- (t
- (push (cons first (list first)) vertico-quick--list)
- (concat (propertize (char-to-string first) 'face 'vertico-quick1)
- (propertize (char-to-string second) 'face 'vertico-quick2)))))
- (let ((first (elt vertico-quick1 (mod idx fst))))
- (if vertico-quick--first
- " "
- (push (cons first index) vertico-quick--list)
- (concat (propertize (char-to-string first) 'face 'vertico-quick1) " "))))))
- (if (bound-and-true-p vertico-flat-mode)
- (setq keys (replace-regexp-in-string " " "" keys)
- cand (string-trim cand)
- cand (substring cand (min (length cand) (length keys))))
- (setq keys (concat keys (make-string (max 1 (- (length prefix) 2)) ?\s))))
- (funcall orig cand keys suffix index start)))
-
-(defun vertico-quick--read (&optional first)
- "Read quick key given FIRST pressed key."
- (cl-letf (((symbol-function #'vertico--format-candidate)
- (apply-partially #'vertico-quick--format-candidate
- (symbol-function #'vertico--format-candidate)))
- (vertico-quick--first first)
- (vertico-quick--list))
- (vertico--exhibit)
- (alist-get (read-key) vertico-quick--list)))
-
-;;;###autoload
-(defun vertico-quick-jump ()
- "Jump to candidate using quick keys."
- (interactive)
- (if (= vertico--total 0)
- (and (minibuffer-message "No match") nil)
- (let ((idx (vertico-quick--read)))
- (when (consp idx) (setq idx (vertico-quick--read (car idx))))
- (when idx (setq vertico--index idx)))))
-
-;;;###autoload
-(defun vertico-quick-exit ()
- "Exit with candidate using quick keys."
- (interactive)
- (when (vertico-quick-jump)
- (vertico-exit)))
-
-;;;###autoload
-(defun vertico-quick-insert ()
- "Insert candidate using quick keys."
- (interactive)
- (when (vertico-quick-jump)
- (vertico-insert)))
-
-;; Emacs 28: Do not show Vertico commands in M-X
-(dolist (sym '(vertico-quick-jump vertico-quick-exit vertico-quick-insert))
- (put sym 'completion-predicate #'vertico--command-p))
-
-(provide 'vertico-quick)
-;;; vertico-quick.el ends here
diff --git a/elpa/vertico-0.17/vertico-quick.elc b/elpa/vertico-0.17/vertico-quick.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico-repeat.el b/elpa/vertico-0.17/vertico-repeat.el
@@ -1,96 +0,0 @@
-;;; vertico-repeat.el --- Repeat the last Vertico session -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension, which allows to repeat the last
-;; Vertico session via the `vertico-repeat' command.
-;;
-;; (global-set-key "\M-r" #'vertico-repeat)
-;;
-;; It is necessary to register a minibuffer setup hook, which saves the
-;; Vertico state for repetition.
-;;
-;; (add-hook 'minibuffer-setup-hook #'vertico-repeat-save)
-
-;;; Code:
-
-(require 'vertico)
-
-(defvar-local vertico-repeat--restore nil)
-(defvar vertico-repeat--input nil)
-(defvar vertico-repeat--command nil)
-(defvar vertico-repeat--candidate nil)
-
-(defun vertico-repeat--save-input ()
- "Save current minibuffer content for `vertico-repeat'."
- (setq vertico-repeat--input (minibuffer-contents)))
-
-(defun vertico-repeat--save-candidate ()
- "Save currently selected candidate for `vertico-repeat'."
- (setq vertico-repeat--candidate
- (and vertico--lock-candidate
- (>= vertico--index 0)
- (nth vertico--index vertico--candidates))))
-
-(defun vertico-repeat--restore ()
- "Restore Vertico status for `vertico-repeat'."
- (setq vertico-repeat--restore t)
- (delete-minibuffer-contents)
- (insert vertico-repeat--input)
- (when vertico-repeat--candidate
- (run-at-time 0 nil
- (lambda ()
- (when-let (idx (seq-position vertico--candidates vertico-repeat--candidate))
- (setq vertico--index idx
- vertico--lock-candidate t)
- (vertico--exhibit))))))
-
-;;;###autoload
-(defun vertico-repeat ()
- "Repeat last Vertico completion session."
- (interactive)
- (unless vertico-repeat--command
- (user-error "No repeatable Vertico session"))
- (minibuffer-with-setup-hook
- #'vertico-repeat--restore
- (command-execute (setq this-command vertico-repeat--command))))
-
-;;;###autoload
-(defun vertico-repeat-save ()
- "Save Vertico status for `vertico-repeat'.
-This function must be registered as `minibuffer-setup-hook'."
- (when vertico--input
- (unless vertico-repeat--restore
- (setq vertico-repeat--command this-command
- vertico-repeat--input ""
- vertico-repeat--candidate nil
- vertico-repeat--restore nil))
- (add-hook 'post-command-hook #'vertico-repeat--save-input nil 'local)
- (add-hook 'minibuffer-exit-hook #'vertico-repeat--save-candidate nil 'local)))
-
-(provide 'vertico-repeat)
-;;; vertico-repeat.el ends here
diff --git a/elpa/vertico-0.17/vertico-repeat.elc b/elpa/vertico-0.17/vertico-repeat.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico-reverse.el b/elpa/vertico-0.17/vertico-reverse.el
@@ -1,79 +0,0 @@
-;;; vertico-reverse.el --- Reverse the Vertico display -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.1
-;; Package-Requires: ((emacs "27.1") (vertico "0.17"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; This package is a Vertico extension, which reverses the list of candidates.
-
-;;; Code:
-
-(require 'vertico)
-
-(defvar vertico-reverse-map
- (let ((map (make-composed-keymap nil vertico-map)))
- (define-key map [remap beginning-of-buffer] #'vertico-last)
- (define-key map [remap minibuffer-beginning-of-buffer] #'vertico-last)
- (define-key map [remap end-of-buffer] #'vertico-first)
- (define-key map [remap scroll-down-command] #'vertico-scroll-up)
- (define-key map [remap scroll-up-command] #'vertico-scroll-down)
- (define-key map [remap next-line] #'vertico-previous)
- (define-key map [remap previous-line] #'vertico-next)
- (define-key map [remap next-line-or-history-element] #'vertico-previous)
- (define-key map [remap previous-line-or-history-element] #'vertico-next)
- (define-key map [remap backward-paragraph] #'vertico-next-group)
- (define-key map [remap forward-paragraph] #'vertico-previous-group)
- map)
- "Vertico keymap adapted to reversed candidate order.")
-
-(defun vertico-reverse--display (lines)
- "Display LINES in reverse."
- (move-overlay vertico--candidates-ov (point-min) (point-min))
- (setq lines (nreverse lines))
- (unless (eq vertico-resize t)
- (setq lines (nconc (make-list (max 0 (- vertico-count (length lines))) "\n") lines)))
- (let ((string (apply #'concat lines)))
- (add-face-text-property 0 (length string) 'default 'append string)
- (overlay-put vertico--candidates-ov 'before-string string))
- (vertico--resize-window (length lines)))
-
-(defun vertico-reverse--setup ()
- "Setup reverse keymap."
- (use-local-map vertico-reverse-map))
-
-;;;###autoload
-(define-minor-mode vertico-reverse-mode
- "Reverse the Vertico display."
- :global t :group 'vertico
- (cond
- (vertico-reverse-mode
- (advice-add #'vertico--display-candidates :override #'vertico-reverse--display)
- (advice-add #'vertico--setup :after #'vertico-reverse--setup))
- (t
- (advice-remove #'vertico--display-candidates #'vertico-reverse--display)
- (advice-remove #'vertico--setup #'vertico-reverse--setup))))
-
-(provide 'vertico-reverse)
-;;; vertico-reverse.el ends here
diff --git a/elpa/vertico-0.17/vertico-reverse.elc b/elpa/vertico-0.17/vertico-reverse.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico.el b/elpa/vertico-0.17/vertico.el
@@ -1,790 +0,0 @@
-;;; vertico.el --- VERTical Interactive COmpletion -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Daniel Mendler <mail@daniel-mendler.de>
-;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
-;; Created: 2021
-;; Version: 0.17
-;; Package-Requires: ((emacs "27.1"))
-;; Homepage: https://github.com/minad/vertico
-
-;; 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:
-
-;; Vertico provides a performant and minimalistic vertical completion UI
-;; based on the default completion system. By reusing the built-in
-;; facilities, Vertico achieves full compatibility with built-in Emacs
-;; completion commands and completion tables.
-
-;;; Code:
-
-(require 'seq)
-(eval-when-compile
- (require 'cl-lib)
- (require 'subr-x))
-
-(defgroup vertico nil
- "VERTical Interactive COmpletion."
- :group 'convenience
- :group 'minibuffer
- :prefix "vertico-")
-
-(defcustom vertico-count-format (cons "%-6s " "%s/%s")
- "Format string used for the candidate count."
- :type '(choice (const :tag "No candidate count" nil) (cons string string)))
-
-(defcustom vertico-group-format
- (concat #(" " 0 4 (face vertico-group-separator))
- #(" %s " 0 4 (face vertico-group-title))
- #(" " 0 1 (face vertico-group-separator display (space :align-to right))))
- "Format string used for the group title."
- :type '(choice (const :tag "No group titles" nil) string))
-
-(defcustom vertico-count 10
- "Maximal number of candidates to show."
- :type 'integer)
-
-(defcustom vertico-scroll-margin 2
- "Number of lines at the top and bottom when scrolling.
-The value should lie between 0 and vertico-count/2."
- :type 'integer)
-
-(defcustom vertico-resize resize-mini-windows
- "How to resize the Vertico minibuffer window.
-See `resize-mini-windows' for documentation."
- :type '(choice (const :tag "Fixed" nil)
- (const :tag "Shrink and grow" t)
- (const :tag "Grow-only" grow-only)))
-
-(defcustom vertico-cycle nil
- "Enable cycling for `vertico-next' and `vertico-previous'."
- :type 'boolean)
-
-(defcustom vertico-multiline
- (cons #("⤶" 0 1 (face vertico-multiline)) #("…" 0 1 (face vertico-multiline)))
- "Replacements for multiline strings."
- :type '(cons (string :tag "Newline") (string :tag "Truncation")))
-
-(defcustom vertico-sort-function #'vertico-sort-history-length-alpha
- "Default sorting function, used if no `display-sort-function' is specified."
- :type `(choice
- (const :tag "No sorting" nil)
- (const :tag "By history, length and alpha" ,#'vertico-sort-history-length-alpha)
- (const :tag "By history and alpha" ,#'vertico-sort-history-alpha)
- (const :tag "By length and alpha" ,#'vertico-sort-length-alpha)
- (const :tag "Alphabetically" ,#'vertico-sort-alpha)
- (function :tag "Custom function")))
-
-(defgroup vertico-faces nil
- "Faces used by Vertico."
- :group 'vertico
- :group 'faces)
-
-(defface vertico-multiline '((t :inherit shadow))
- "Face used to highlight multiline replacement characters.")
-
-(defface vertico-group-title '((t :inherit shadow :slant italic))
- "Face used for the title text of the candidate group headlines.")
-
-(defface vertico-group-separator '((t :inherit shadow :strike-through t))
- "Face used for the separator lines of the candidate groups.")
-
-(defface vertico-current '((t :inherit highlight :extend t))
- "Face used to highlight the currently selected candidate.")
-
-(defvar vertico-map
- (let ((map (make-composed-keymap nil minibuffer-local-map)))
- (define-key map [remap beginning-of-buffer] #'vertico-first)
- (define-key map [remap minibuffer-beginning-of-buffer] #'vertico-first)
- (define-key map [remap end-of-buffer] #'vertico-last)
- (define-key map [remap scroll-down-command] #'vertico-scroll-down)
- (define-key map [remap scroll-up-command] #'vertico-scroll-up)
- (define-key map [remap next-line] #'vertico-next)
- (define-key map [remap previous-line] #'vertico-previous)
- (define-key map [remap next-line-or-history-element] #'vertico-next)
- (define-key map [remap previous-line-or-history-element] #'vertico-previous)
- (define-key map [remap backward-paragraph] #'vertico-previous-group)
- (define-key map [remap forward-paragraph] #'vertico-next-group)
- (define-key map [remap exit-minibuffer] #'vertico-exit)
- (define-key map [remap kill-ring-save] #'vertico-save)
- (define-key map [C-return] #'vertico-exit-input)
- (define-key map "\t" #'vertico-insert)
- map)
- "Vertico minibuffer keymap derived from `minibuffer-local-map'.")
-
-(defvar-local vertico--highlight-function #'identity
- "Deferred candidate highlighting function.")
-
-(defvar-local vertico--history-hash nil
- "History hash table.")
-
-(defvar-local vertico--history-base nil
- "Base prefix of `vertico--history-hash'.")
-
-(defvar-local vertico--candidates-ov nil
- "Overlay showing the candidates.")
-
-(defvar-local vertico--count-ov nil
- "Overlay showing the number of candidates.")
-
-(defvar-local vertico--index -1
- "Index of current candidate or negative for prompt selection.")
-
-(defvar-local vertico--scroll 0
- "Scroll position.")
-
-(defvar-local vertico--input nil
- "Cons of last minibuffer contents and point or t.")
-
-(defvar-local vertico--candidates nil
- "List of candidates.")
-
-(defvar-local vertico--metadata nil
- "Completion metadata.")
-
-(defvar-local vertico--base 0
- "Size of the base string, which is concatenated with the candidate.")
-
-(defvar-local vertico--total 0
- "Length of the candidate list `vertico--candidates'.")
-
-(defvar-local vertico--lock-candidate nil
- "Lock-in current candidate.")
-
-(defvar-local vertico--lock-groups nil
- "Lock-in current group order.")
-
-(defvar-local vertico--all-groups nil
- "List of all group titles.")
-
-(defvar-local vertico--groups nil
- "List of current group titles.")
-
-(defvar-local vertico--default-missing nil
- "Default candidate is missing from candidates list.")
-
-(defun vertico--history-hash ()
- "Recompute history hash table and return it."
- (or vertico--history-hash
- (let* ((base vertico--history-base)
- (base-size (length base))
- ;; History disabled if `minibuffer-history-variable' eq `t'.
- (hist (and (not (eq minibuffer-history-variable t))
- (symbol-value minibuffer-history-variable)))
- (hash (make-hash-table :test #'equal :size (length hist))))
- (if (= base-size 0)
- ;; Put history elements into the hash
- (cl-loop for elem in hist for index from 0 do
- (unless (gethash elem hash)
- (puthash elem index hash)))
- ;; Drop base string from history elements, before putting them into the hash
- (cl-loop for elem in hist for index from 0 do
- (when (and (>= (length elem) base-size)
- (eq t (compare-strings base 0 base-size elem 0 base-size)))
- (setq elem (substring elem base-size))
- (unless (gethash elem hash)
- (puthash elem index hash)))))
- (setq vertico--history-hash hash))))
-
-(defun vertico--length-string< (x y)
- "Sorting predicate which compares X and Y first by length then by `string<'."
- (or (< (length x) (length y)) (and (= (length x) (length y)) (string< x y))))
-
-(defun vertico--sort-decorated (list)
- "Sort decorated LIST and remove decorations."
- (setq list (sort list #'car-less-than-car))
- (cl-loop for item on list do (setcar item (cdar item)))
- list)
-
-(defmacro vertico--define-sort (by bsize bindex bpred pred)
- "Generate optimized sorting function.
-The function is configured by BY, BSIZE, BINDEX, BPRED and PRED."
- `(defun ,(intern (mapconcat #'symbol-name `(vertico sort ,@by) "-")) (candidates)
- ,(concat "Sort candidates by " (mapconcat #'symbol-name by ", ") ".")
- (let* ((buckets (make-vector ,bsize nil))
- ,@(and (eq (car by) 'history) '((hhash (vertico--history-hash)) (hcands))))
- (dolist (% candidates)
- ,(if (eq (car by) 'history)
- ;; Find recent candidates or fill buckets
- `(if-let (idx (gethash % hhash))
- (push (cons idx %) hcands)
- (let ((idx (min ,(1- bsize) ,bindex)))
- (aset buckets idx (cons % (aref buckets idx)))))
- ;; Fill buckets
- `(let ((idx (min ,(1- bsize) ,bindex)))
- (aset buckets idx (cons % (aref buckets idx))))))
- (nconc ,@(and (eq (car by) 'history) '((vertico--sort-decorated hcands)))
- (mapcan (lambda (bucket) (sort bucket #',bpred))
- (nbutlast (append buckets nil)))
- ;; Last bucket needs special treatment
- (sort (aref buckets ,(1- bsize)) #',pred)))))
-
-(vertico--define-sort (history length alpha) 32 (length %) string< vertico--length-string<)
-(vertico--define-sort (history alpha) 32 (if (eq % "") 0 (/ (aref % 0) 4)) string< string<)
-(vertico--define-sort (length alpha) 32 (length %) string< vertico--length-string<)
-(vertico--define-sort (alpha) 32 (if (eq % "") 0 (/ (aref % 0) 4)) string< string<)
-
-(defun vertico--affixate (cands)
- "Annotate CANDS with annotation function."
- (if-let (aff (or (vertico--metadata-get 'affixation-function)
- (plist-get completion-extra-properties :affixation-function)))
- (funcall aff cands)
- (if-let (ann (or (vertico--metadata-get 'annotation-function)
- (plist-get completion-extra-properties :annotation-function)))
- (cl-loop for cand in cands collect
- (let ((suffix (or (funcall ann cand) "")))
- (list cand ""
- ;; The default completion UI adds the `completions-annotations' face
- ;; if no other faces are present.
- (if (text-property-not-all 0 (length suffix) 'face nil suffix)
- suffix
- (propertize suffix 'face 'completions-annotations)))))
- (cl-loop for cand in cands collect (list cand "" "")))))
-
-(defun vertico--move-to-front (elem list)
- "Move ELEM to front of LIST."
- (if-let (found (member elem list))
- (let ((head (list (car found))))
- (nconc head (delq (setcar found nil) list)))
- list))
-
-;; bug#47711: Deferred highlighting for `completion-all-completions'
-;; XXX There is one complication: `completion--twq-all' already adds `completions-common-part'.
-;; See below `vertico--candidate'.
-(defun vertico--all-completions (&rest args)
- "Compute all completions for ARGS with deferred highlighting."
- (cl-letf* ((orig-pcm (symbol-function #'completion-pcm--hilit-commonality))
- (orig-flex (symbol-function #'completion-flex-all-completions))
- ((symbol-function #'completion-flex-all-completions)
- (lambda (&rest args)
- ;; Unfortunately for flex we have to undo the deferred highlighting, since flex uses
- ;; the completion-score for sorting, which is applied during highlighting.
- (cl-letf (((symbol-function #'completion-pcm--hilit-commonality) orig-pcm))
- (apply orig-flex args))))
- ;; Defer the following highlighting functions
- (hl #'identity)
- ((symbol-function #'completion-hilit-commonality)
- (lambda (cands prefix &optional base)
- (setq hl (lambda (x) (nconc (completion-hilit-commonality x prefix base) nil)))
- (and cands (nconc cands base))))
- ((symbol-function #'completion-pcm--hilit-commonality)
- (lambda (pattern cands)
- (setq hl (lambda (x)
- ;; `completion-pcm--hilit-commonality' sometimes throws an internal error
- ;; for example when entering "/sudo:://u".
- (condition-case nil
- (completion-pcm--hilit-commonality pattern x)
- (t x))))
- cands)))
- ;; Only advise orderless after it has been loaded to avoid load order issues
- (if (and (fboundp 'orderless-highlight-matches) (fboundp 'orderless-pattern-compiler))
- (cl-letf (((symbol-function 'orderless-highlight-matches)
- (lambda (pattern cands)
- (let ((regexps (orderless-pattern-compiler pattern)))
- (setq hl (lambda (x) (orderless-highlight-matches regexps x))))
- cands)))
- (cons (apply #'completion-all-completions args) hl))
- (cons (apply #'completion-all-completions args) hl))))
-
-(defun vertico--metadata-get (prop)
- "Return PROP from completion metadata."
- (completion-metadata-get vertico--metadata prop))
-
-(defun vertico--sort-function ()
- "Return the sorting function."
- (or (vertico--metadata-get 'display-sort-function) vertico-sort-function))
-
-(defun vertico--filter-files (files)
- "Filter FILES by `completion-ignored-extensions'."
- (let ((re (concat "\\(?:\\(?:\\`\\|/\\)\\.\\.?/\\|"
- (regexp-opt completion-ignored-extensions)
- "\\)\\'")))
- (or (seq-remove (lambda (x) (string-match-p re x)) files) files)))
-
-(defun vertico--recompute-candidates (pt content)
- "Recompute candidates given PT and CONTENT."
- (pcase-let* ((before (substring content 0 pt))
- (after (substring content pt))
- ;; bug#47678: `completion-boundaries` fails for `partial-completion`
- ;; if the cursor is moved between the slashes of "~//".
- ;; See also marginalia.el which has the same issue.
- (bounds (or (condition-case nil
- (completion-boundaries before
- minibuffer-completion-table
- minibuffer-completion-predicate
- after)
- (t (cons 0 (length after))))))
- (field (substring content (car bounds) (+ pt (cdr bounds))))
- ;; `minibuffer-completing-file-name' has been obsoleted by the completion category
- (completing-file (eq 'file (vertico--metadata-get 'category)))
- (`(,all . ,hl) (vertico--all-completions content
- minibuffer-completion-table
- minibuffer-completion-predicate
- pt vertico--metadata))
- (base (or (when-let (z (last all)) (prog1 (cdr z) (setcdr z nil))) 0))
- (base-str (substring content 0 base))
- (def (or (car-safe minibuffer-default) minibuffer-default))
- (groups))
- ;; Reset the history hash table
- (unless (equal base-str vertico--history-base)
- (setq vertico--history-base base-str vertico--history-hash nil))
- ;; Filter the ignored file extensions. We cannot use modified predicate for this filtering,
- ;; since this breaks the special casing in the `completion-file-name-table' for `file-exists-p'
- ;; and `file-directory-p'.
- (when completing-file
- (setq all (vertico--filter-files all)))
- ;; Sort using the `display-sort-function' or the Vertico sort functions
- (setq all (delete-consecutive-dups (funcall (or (vertico--sort-function) #'identity) all)))
- ;; Move special candidates: "field" appears at the top, before "field/", before default value
- (when (stringp def)
- (setq all (vertico--move-to-front def all)))
- (when (and completing-file (not (string-suffix-p "/" field)))
- (setq all (vertico--move-to-front (concat field "/") all)))
- (setq all (vertico--move-to-front field all))
- (when-let (group-fun (and all (vertico--metadata-get 'group-function)))
- (setq groups (vertico--group-by group-fun all) all (car groups)))
- (list base (length all)
- ;; Default value is missing from collection
- (and def (equal content "") (not (member def all)))
- ;; Find position of old candidate in the new list.
- (when vertico--lock-candidate
- (if (< vertico--index 0)
- vertico--index
- (seq-position all (nth vertico--index vertico--candidates))))
- all (cadr groups) (or (caddr groups) vertico--all-groups) hl)))
-
-(defun vertico--cycle (list n)
- "Rotate LIST to position N."
- (nconc (copy-sequence (nthcdr n list)) (seq-take list n)))
-
-(defun vertico--group-by (fun elems)
- "Group ELEMS by FUN."
- (let ((ht (make-hash-table :test #'equal)) titles groups)
- ;; Build hash table of groups
- (while elems
- (let* ((title (funcall fun (car elems) nil))
- (group (gethash title ht)))
- (if group
- (setcdr group (setcdr (cdr group) elems)) ;; Append to tail of group
- (puthash title (cons elems elems) ht) ;; New group element (head . tail)
- (push title titles))
- (pop elems)))
- (setq titles (nreverse titles))
- ;; Cycle groups if `vertico--lock-groups' is set
- (when-let (group (and vertico--lock-groups
- (seq-find (lambda (group) (gethash group ht))
- vertico--all-groups)))
- (setq titles (vertico--cycle titles (seq-position titles group))))
- ;; Build group list
- (dolist (title titles)
- (push (gethash title ht) groups))
- ;; Unlink last tail
- (setcdr (cdar groups) nil)
- (setq groups (nreverse groups))
- ;; Link groups
- (let ((link groups))
- (while (cdr link)
- (setcdr (cdar link) (caadr link))
- (pop link)))
- ;; Check if new groups are found
- (dolist (group vertico--all-groups)
- (remhash group ht))
- (list (caar groups) titles
- (if (hash-table-empty-p ht) vertico--all-groups titles))))
-
-(defun vertico--remote-p (path)
- "Return t if PATH is a remote path."
- (string-match-p "\\`/[^/|:]+:" (substitute-in-file-name path)))
-
-(defun vertico--update-candidates (pt content)
- "Preprocess candidates given PT and CONTENT."
- ;; Redisplay the minibuffer such that the input becomes immediately
- ;; visible before the expensive candidate recomputation is performed (Issue #89).
- ;; Do not redisplay during initialization, since this leads to flicker.
- (when (consp vertico--input) (redisplay))
- (let ((metadata (completion-metadata (substring content 0 pt)
- minibuffer-completion-table
- minibuffer-completion-predicate)))
- (pcase
- (let ((vertico--metadata metadata))
- ;; If Tramp is used, do not compute the candidates in an interruptible fashion,
- ;; since this will break the Tramp password and user name prompts (See #23).
- (if (and (eq 'file (vertico--metadata-get 'category))
- (or (vertico--remote-p content) (vertico--remote-p default-directory)))
- (vertico--recompute-candidates pt content)
- (let ((non-essential t))
- (while-no-input (vertico--recompute-candidates pt content)))))
- ('nil (abort-recursive-edit))
- (`(,base ,total ,def-missing ,index ,candidates ,groups ,all-groups ,hl)
- (setq vertico--input (cons content pt)
- vertico--index index
- vertico--base base
- vertico--total total
- vertico--highlight-function hl
- vertico--groups groups
- vertico--all-groups all-groups
- vertico--candidates candidates
- vertico--default-missing def-missing
- vertico--metadata metadata)
- ;; If the current index is nil, compute new index. Select the prompt:
- ;; * If there are no candidates
- ;; * If the default is missing from the candidate list.
- ;; * For matching content, as long as the full content after the boundary is empty,
- ;; including content after point.
- (unless vertico--index
- (setq vertico--lock-candidate nil
- vertico--index
- (if (or vertico--default-missing
- (= 0 vertico--total)
- (and (= base (length content))
- (test-completion content minibuffer-completion-table
- minibuffer-completion-predicate)))
- -1 0)))))))
-
-(defun vertico--flatten-string (prop str)
- "Flatten STR with display or invisible PROP."
- (let ((end (length str)) (pos 0) (chunks))
- (while (< pos end)
- (let ((next (next-single-property-change pos prop str end))
- (val (get-text-property pos prop str)))
- (cond
- ((and val (eq prop 'display) (stringp val))
- (push val chunks))
- ((not (and val (eq prop 'invisible)))
- (push (substring str pos next) chunks)))
- (setq pos next)))
- (apply #'concat (nreverse chunks))))
-
-(defun vertico--truncate-multiline (cand max-width)
- "Truncate multiline CAND to MAX-WIDTH."
- (truncate-string-to-width
- (thread-last cand
- (replace-regexp-in-string "[\t ]+" " ")
- (replace-regexp-in-string "[\t\n ]*\n[\t\n ]*" (car vertico-multiline))
- (replace-regexp-in-string "\\`[\t\n ]+\\|[\t\n ]+\\'" ""))
- max-width 0 nil (cdr vertico-multiline)))
-
-(defun vertico--format-candidate (cand prefix suffix index _start)
- "Format CAND given PREFIX, SUFFIX and INDEX."
- (setq cand (concat prefix cand suffix "\n")
- cand (vertico--flatten-string 'invisible (vertico--flatten-string 'display cand)))
- (when (= index vertico--index)
- (add-face-text-property 0 (length cand) 'vertico-current 'append cand))
- cand)
-
-(defun vertico--update-scroll ()
- "Update scroll position."
- (let ((off (max (min vertico-scroll-margin (/ vertico-count 2)) 0))
- (corr (if (= vertico-scroll-margin (/ vertico-count 2)) (1- (mod vertico-count 2)) 0)))
- (setq vertico--scroll (min (max 0 (- vertico--total vertico-count))
- (max 0 (+ vertico--index off 1 (- vertico-count))
- (min (- vertico--index off corr) vertico--scroll))))))
-
-(defun vertico--arrange-candidates ()
- "Arrange candidates."
- (vertico--update-scroll)
- (let ((curr-line 0) (lines))
- ;; Compute group titles
- (let* ((index vertico--scroll)
- (title)
- (group-fun (vertico--metadata-get 'group-function))
- (group-format (and group-fun vertico-group-format (concat vertico-group-format "\n")))
- (candidates
- (thread-last (seq-subseq vertico--candidates index
- (min (+ index vertico-count) vertico--total))
- (funcall vertico--highlight-function)
- (vertico--affixate))))
- (dolist (cand candidates)
- (let ((str (car cand)))
- (when-let (new-title (and group-format (funcall group-fun str nil)))
- (unless (equal title new-title)
- (setq title new-title)
- ;; Restore group title highlighting for prefix titles
- (when (string-prefix-p title str)
- (setq title (substring
- (car (funcall
- vertico--highlight-function
- ;; Remove all properties from the title
- (list (propertize str 'face 'vertico-group-title))))
- 0 (length title)))
- (vertico--remove-face 0 (length title) 'completions-first-difference title))
- (push (format group-format title) lines))
- (setcar cand (funcall group-fun str 'transform))))
- (when (= index vertico--index)
- (setq curr-line (length lines)))
- (push (cons index cand) lines)
- (setq index (1+ index))))
- ;; Drop excess lines
- (setq lines (nreverse lines))
- (cl-loop for count from (length lines) above vertico-count do
- (if (< curr-line (/ count 2))
- (nbutlast lines)
- (setq curr-line (1- curr-line) lines (cdr lines))))
- ;; Format candidates
- (let ((max-width (- (window-width) 4)) start)
- (cl-loop for line on lines do
- (pcase (car line)
- (`(,index ,cand ,prefix ,suffix)
- (setq start (or start index))
- (when (string-match-p "\n" cand)
- (setq cand (vertico--truncate-multiline cand max-width)))
- (setcar line (vertico--format-candidate cand prefix suffix index start))))))
- lines))
-
-(defun vertico--display-candidates (lines)
- "Update candidates overlay `vertico--candidates-ov' with LINES."
- (move-overlay vertico--candidates-ov (point-max) (point-max))
- (overlay-put vertico--candidates-ov 'after-string
- (apply #'concat #(" " 0 1 (cursor t)) (and lines "\n") lines))
- (vertico--resize-window (length lines)))
-
-(defun vertico--resize-window (height)
- "Resize active minibuffer window to HEIGHT."
- (setq-local truncate-lines (< (point) (* 0.8 (window-width))))
- (unless (frame-root-window-p (active-minibuffer-window))
- (unless vertico-resize
- (setq height (max height vertico-count)))
- (let* ((window-resize-pixelwise t)
- (dp (- (max (cdr (window-text-pixel-size))
- (* (default-line-height) (1+ height)))
- (window-pixel-height))))
- (when (or (and (> dp 0) (/= height 0))
- (and (< dp 0) (eq vertico-resize t)))
- (window-resize nil dp nil nil 'pixelwise)))))
-
-(defun vertico--format-count ()
- "Format the count string."
- (format (car vertico-count-format)
- (format (cdr vertico-count-format)
- (cond ((>= vertico--index 0) (1+ vertico--index))
- ((vertico--allow-prompt-selection-p) "*")
- (t "!"))
- vertico--total)))
-
-(defun vertico--display-count ()
- "Update count overlay `vertico--count-ov'."
- (when vertico--count-ov
- (move-overlay vertico--count-ov (point-min) (point-min))
- ;; Set priority for compatibility with `minibuffer-depth-indicate-mode'
- (overlay-put vertico--count-ov 'priority 1)
- (overlay-put vertico--count-ov 'before-string (vertico--format-count))))
-
-(defun vertico--prompt-selection ()
- "Highlight the prompt if selected."
- (let ((inhibit-modification-hooks t))
- (if (and (< vertico--index 0) (vertico--allow-prompt-selection-p))
- (add-face-text-property (minibuffer-prompt-end) (point-max) 'vertico-current 'append)
- (vertico--remove-face (minibuffer-prompt-end) (point-max) 'vertico-current))))
-
-(defun vertico--remove-face (beg end face &optional obj)
- "Remove FACE between BEG and END from OBJ."
- (while (< beg end)
- (let ((next (next-single-property-change beg 'face obj end)))
- (when-let (val (get-text-property beg 'face obj))
- (put-text-property beg next 'face (remq face (if (listp val) val (list val))) obj))
- (setq beg next))))
-
-(defun vertico--exhibit ()
- "Exhibit completion UI."
- (let* ((buffer-undo-list t) ;; Overlays affect point position and undo list!
- (pt (max 0 (- (point) (minibuffer-prompt-end))))
- (content (minibuffer-contents)))
- (unless (or (input-pending-p) (equal vertico--input (cons content pt)))
- (vertico--update-candidates pt content))
- (vertico--prompt-selection)
- (vertico--display-count)
- (vertico--display-candidates (vertico--arrange-candidates))))
-
-(defun vertico--allow-prompt-selection-p ()
- "Return t if prompt can be selected."
- (or vertico--default-missing
- (memq minibuffer--require-match '(nil confirm confirm-after-completion))))
-
-(defun vertico--goto (index)
- "Go to candidate with INDEX."
- (let ((prompt (vertico--allow-prompt-selection-p)))
- (setq vertico--index
- (max (if (or prompt (= 0 vertico--total)) -1 0)
- (min index (1- vertico--total)))
- vertico--lock-candidate (or (>= vertico--index 0) prompt))))
-
-(defun vertico-first ()
- "Go to first candidate, or to the prompt when the first candidate is selected."
- (interactive)
- (vertico--goto (if (> vertico--index 0) 0 -1)))
-
-(defun vertico-last ()
- "Go to last candidate."
- (interactive)
- (vertico--goto (1- vertico--total)))
-
-(defun vertico-scroll-down (&optional n)
- "Go back by N pages."
- (interactive "p")
- (vertico--goto (max 0 (- vertico--index (* (or n 1) vertico-count)))))
-
-(defun vertico-scroll-up (&optional n)
- "Go forward by N pages."
- (interactive "p")
- (vertico-scroll-down (- (or n 1))))
-
-(defun vertico-next (&optional n)
- "Go forward N candidates."
- (interactive "p")
- (let ((index (+ vertico--index (or n 1))))
- (vertico--goto
- (cond
- ((not vertico-cycle) index)
- ((= vertico--total 0) -1)
- ((vertico--allow-prompt-selection-p) (1- (mod (1+ index) (1+ vertico--total))))
- (t (mod index vertico--total))))))
-
-(defun vertico-previous (&optional n)
- "Go backward N candidates."
- (interactive "p")
- (vertico-next (- (or n 1))))
-
-(defun vertico--match-p (input)
- "Return t if INPUT is a valid match."
- (or (memq minibuffer--require-match '(nil confirm-after-completion))
- (equal "" input) ;; The questionable null completion
- (test-completion input
- minibuffer-completion-table
- minibuffer-completion-predicate)
- (if (eq minibuffer--require-match 'confirm)
- (eq (ignore-errors (read-char "Confirm")) 13)
- (and (message "Match required") nil))))
-
-(defun vertico-exit (&optional arg)
- "Exit minibuffer with current candidate or input if prefix ARG is given."
- (interactive "P")
- (unless arg (vertico-insert))
- (when (vertico--match-p (minibuffer-contents-no-properties))
- (exit-minibuffer)))
-
-(defun vertico-next-group (&optional n)
- "Cycle N groups forward.
-When the prefix argument is 0, the group order is reset."
- (interactive "p")
- (when (cdr vertico--groups)
- (if (eq n 0)
- (setq vertico--groups nil
- vertico--all-groups nil
- vertico--lock-groups nil)
- (setq vertico--groups
- (vertico--cycle vertico--groups
- (let ((len (length vertico--groups)))
- (- len (mod (- (or n 1)) len))))
- vertico--all-groups
- (vertico--cycle vertico--all-groups
- (seq-position vertico--all-groups
- (car vertico--groups)))
- vertico--lock-groups t))
- (setq vertico--lock-candidate nil
- vertico--input nil)))
-
-(defun vertico-previous-group (&optional n)
- "Cycle N groups backward.
-When the prefix argument is 0, the group order is reset."
- (interactive "p")
- (vertico-next-group (- (or n 1))))
-
-(defun vertico-exit-input ()
- "Exit minibuffer with input."
- (interactive)
- (vertico-exit t))
-
-(defun vertico-save ()
- "Save current candidate to kill ring."
- (interactive)
- (if (or (use-region-p) (not transient-mark-mode))
- (call-interactively #'kill-ring-save)
- (kill-new (vertico--candidate))))
-
-(defun vertico-insert ()
- "Insert current candidate in minibuffer."
- (interactive)
- ;; XXX There is a small bug here, depending on interpretation. When
- ;; completing "~/emacs/master/li|/calc" where "|" is the cursor,
- ;; then the returned candidate only includes the prefix
- ;; "~/emacs/master/lisp/", but not the suffix "/calc". Default
- ;; completion has the same problem when selecting in the
- ;; *Completions* buffer. See bug#48356.
- (when-let (cand (and (>= vertico--index 0) (vertico--candidate)))
- (delete-minibuffer-contents)
- (insert cand)))
-
-(defun vertico--candidate (&optional hl)
- "Return current candidate string with optional highlighting if HL is non-nil."
- (let ((content (substring (or (car-safe vertico--input) (minibuffer-contents)))))
- (if (>= vertico--index 0)
- (let ((cand (substring (nth vertico--index vertico--candidates))))
- ;;; XXX Drop the completions-common-part face which is added by `completion--twq-all'.
- ;; This is a hack in Emacs and should better be fixed in Emacs itself, the corresponding
- ;; code is already marked with a FIXME. Should this be reported as a bug?
- (vertico--remove-face 0 (length cand) 'completions-common-part cand)
- (concat (substring content 0 vertico--base)
- (if hl (car (funcall vertico--highlight-function (list cand))) cand)))
- ;; Remove prompt face
- (vertico--remove-face 0 (length content) 'vertico-current content)
- content)))
-
-(defun vertico--setup ()
- "Setup completion UI."
- (setq vertico--input t
- vertico--candidates-ov (make-overlay (point-max) (point-max) nil t t)
- vertico--count-ov (and vertico-count-format
- (make-overlay (point-min) (point-min) nil t t)))
- (setq-local resize-mini-windows 'grow-only
- max-mini-window-height 1.0
- truncate-lines t
- completion-auto-help nil
- completion-show-inline-help nil)
- (use-local-map vertico-map)
- ;; Use -90 to ensure that the exhibit hook runs early such that the
- ;; candidates are available for Consult preview. It works, but besides
- ;; that I'dont have a specific reason for this particular value.
- (add-hook 'post-command-hook #'vertico--exhibit -90 'local))
-
-(defun vertico--advice (&rest args)
- "Advice for completion function, receiving ARGS."
- (minibuffer-with-setup-hook #'vertico--setup (apply args)))
-
-;;;###autoload
-(define-minor-mode vertico-mode
- "VERTical Interactive COmpletion."
- :global t :group 'vertico
- (if vertico-mode
- (progn
- (advice-add #'completing-read-default :around #'vertico--advice)
- (advice-add #'completing-read-multiple :around #'vertico--advice))
- (advice-remove #'completing-read-default #'vertico--advice)
- (advice-remove #'completing-read-multiple #'vertico--advice)))
-
-;; Emacs 28: Do not show Vertico commands in M-X
-(dolist (sym '(vertico-next vertico-next-group vertico-previous vertico-previous-group
- vertico-scroll-down vertico-scroll-up vertico-exit vertico-insert
- vertico-exit-input vertico-save vertico-first vertico-last))
- (put sym 'completion-predicate #'vertico--command-p))
-
-(defun vertico--command-p (_sym buffer)
- "Return non-nil if Vertico is active in BUFFER."
- (buffer-local-value 'vertico--input buffer))
-
-(provide 'vertico)
-;;; vertico.el ends here
diff --git a/elpa/vertico-0.17/vertico.elc b/elpa/vertico-0.17/vertico.elc
Binary files differ.
diff --git a/elpa/vertico-0.17/vertico.info b/elpa/vertico-0.17/vertico.info
@@ -1,612 +0,0 @@
-This is vertico.info, produced by makeinfo version 6.7 from
-vertico.texi.
-
-INFO-DIR-SECTION Emacs
-START-INFO-DIR-ENTRY
-* Vertico: (vertico). VERTical Interactive COmpletion.
-END-INFO-DIR-ENTRY
-
-
-File: vertico.info, Node: Top, Next: Introduction, Up: (dir)
-
-vertico.el - VERTical Interactive COmpletion
-********************************************
-
-* Menu:
-
-* Introduction::
-* Features::
-* Key bindings::
-* Configuration::
-* Extensions::
-* Complementary packages::
-* Child frames and Popups::
-* Alternatives::
-* Problematic completion commands::
-* Contributions::
-
-— The Detailed Node Listing —
-
-Configuration
-
-* Completion styles and TAB completion::
-* Completion-at-point and completion-in-region::
-* Completing-read-multiple (CRM)::
-
-Problematic completion commands
-
-* org-refile::
-* tmm-menubar::
-* ffap-menu::
-* Tramp hostname completion::
-
-
-
-File: vertico.info, Node: Introduction, Next: Features, Prev: Top, Up: Top
-
-1 Introduction
-**************
-
-Vertico provides a performant and minimalistic vertical completion UI
-based on the default completion system. The main focus of Vertico is to
-provide a UI which behaves _correctly_ under all circumstances. By
-reusing the built-in facilities system, Vertico achieves _full
-compatibility_ with built-in Emacs completion commands and completion
-tables. Vertico only provides the completion UI but aims to be flexible
-and extensible. Additional enhancements are available as *note
-extensions: Extensions. or *note complementary packages: Complementary
-packages. The code base is small and maintainable (‘vertico.el’ is only
-about 600 lines of code without white space and comments).
-
-
-File: vertico.info, Node: Features, Next: Key bindings, Prev: Introduction, Up: Top
-
-2 Features
-**********
-
- • Vertical display with arrow key navigation
- • Prompt shows the current candidate index and the total number of
- candidates
- • The current candidate is inserted with ‘TAB’ and selected with
- ‘RET’
- • Non-existing candidates can be entered by moving the point to the
- prompt line
- • Configurable sorting by history position, length and alphabetically
- • Long candidates with newlines are formatted to take up less space
- • Deferred completion style highlighting for performance
- • Support for annotations (‘annotation-function’ and
- ‘affixation-function’)
- • Support for grouping and group cycling commands (‘group-function’)
-
- <https://github.com/minad/vertico/blob/main/screenshot.svg?raw=true>
-
-
-File: vertico.info, Node: Key bindings, Next: Configuration, Prev: Features, Up: Top
-
-3 Key bindings
-**************
-
-Vertico defines its own local keymap in the minibuffer which is derived
-from ‘minibuffer-local-map’. The keymap keeps most of the
-‘fundamental-mode’ keybindings intact and remaps and binds only a
-handful of commands. Note in particular the binding of ‘TAB’ to
-‘vertico-insert’ and the bindings of ‘vertico-exit/exit-input’.
-
- • ‘beginning-of-buffer’, ‘minibuffer-beginning-of-buffer’ ->
- ‘vertico-first’
- • ‘end-of-buffer’ -> ‘vertico-last’
- • ‘scroll-down-command’ -> ‘vertico-scroll-down’
- • ‘scroll-up-command’ -> ‘vertico-scroll-up’
- • ‘next-line’, ‘next-line-or-history-element’ -> ‘vertico-next’
- • ‘previous-line’, ‘previous-line-or-history-element’ ->
- ‘vertico-previous’
- • ‘forward-paragraph’ -> ‘vertico-next-group’
- • ‘backward-paragraph’ -> ‘vertico-previous-group’
- • ‘exit-minibuffer’ -> ‘vertico-exit’
- • ‘kill-ring-save’ -> ‘vertico-save’
- • ‘C-<return>’ -> ‘vertico-exit-input’
- • ‘TAB’ -> ‘vertico-insert’
-
-
-File: vertico.info, Node: Configuration, Next: Extensions, Prev: Key bindings, Up: Top
-
-4 Configuration
-***************
-
-Vertico is available from GNU ELPA
-(http://elpa.gnu.org/packages/vertico.html). You can install it
-directly via ‘package-install’. After installation, you can activate
-the global minor mode with ‘M-x vertico-mode’. In order to configure
-Vertico and other packages in your init.el, you may want to take
-advantage of ‘use-package’. I recommend to give Orderless completion a
-try, which is different from the prefix TAB completion used by the basic
-default completion system or in shells. Here is an example
-configuration:
-
- ;; Enable vertico
- (use-package vertico
- :init
- (vertico-mode)
-
- ;; Different scroll margin
- ;; (setq vertico-scroll-margin 0)
-
- ;; Show more candidates
- ;; (setq vertico-count 20)
-
- ;; Grow and shrink the Vertico minibuffer
- ;; (setq vertico-resize t)
-
- ;; Optionally enable cycling for `vertico-next' and `vertico-previous'.
- ;; (setq vertico-cycle t)
- )
-
- ;; Optionally use the `orderless' completion style. See
- ;; `+orderless-dispatch' in the Consult wiki for an advanced Orderless style
- ;; dispatcher. Additionally enable `partial-completion' for file path
- ;; expansion. `partial-completion' is important for wildcard support.
- ;; Multiple files can be opened at once with `find-file' if you enter a
- ;; wildcard. You may also give the `initials' completion style a try.
- (use-package orderless
- :init
- ;; Configure a custom style dispatcher (see the Consult wiki)
- ;; (setq orderless-style-dispatchers '(+orderless-dispatch)
- ;; orderless-component-separator #'orderless-escapable-split-on-space)
- (setq completion-styles '(orderless)
- completion-category-defaults nil
- completion-category-overrides '((file (styles partial-completion)))))
-
- ;; Persist history over Emacs restarts. Vertico sorts by history position.
- (use-package savehist
- :init
- (savehist-mode))
-
- ;; A few more useful configurations...
- (use-package emacs
- :init
- ;; Add prompt indicator to `completing-read-multiple'.
- ;; Alternatively try `consult-completing-read-multiple'.
- (defun crm-indicator (args)
- (cons (concat "[CRM] " (car args)) (cdr args)))
- (advice-add #'completing-read-multiple :filter-args #'crm-indicator)
-
- ;; Do not allow the cursor in the minibuffer prompt
- (setq minibuffer-prompt-properties
- '(read-only t cursor-intangible t face minibuffer-prompt))
- (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
-
- ;; Emacs 28: Hide commands in M-x which do not work in the current mode.
- ;; Vertico commands are hidden in normal buffers.
- ;; (setq read-extended-command-predicate
- ;; #'command-completion-default-include-p)
-
- ;; Enable recursive minibuffers
- (setq enable-recursive-minibuffers t))
-
- See also the Vertico Wiki (https://github.com/minad/vertico/wiki) for
-additional configuration tips.
-
-* Menu:
-
-* Completion styles and TAB completion::
-* Completion-at-point and completion-in-region::
-* Completing-read-multiple (CRM)::
-
-
-File: vertico.info, Node: Completion styles and TAB completion, Next: Completion-at-point and completion-in-region, Up: Configuration
-
-4.1 Completion styles and TAB completion
-========================================
-
-The bindings of the ‘minibuffer-local-completion-map’ are not available
-in Vertico by default. This means that TAB works differently from what
-you may expect from the default Emacs completion system.
-
- If you prefer to have the default completion commands a key press
-away you can add new bindings or even replace the Vertico bindings.
-Then the default completion commands behave as usual. For example you
-can use ‘M-TAB’ to cycle between candidates if you have set
-‘completion-cycle-threshold’.
-
- (define-key vertico-map "?" #'minibuffer-completion-help)
- (define-key vertico-map (kbd "M-RET") #'minibuffer-force-complete-and-exit)
- (define-key vertico-map (kbd "M-TAB") #'minibuffer-complete)
-
- The ‘orderless’ completion style does not support completion of a
-common prefix substring, as you may be familiar with from shells or the
-basic default completion system. The reason is that the Orderless input
-string is usually not a prefix. In order to support completing prefixes
-you may want to combine ‘orderless’ with ‘substring’ in your
-‘completion-styles’ configuration.
-
- (setq completion-styles '(substring orderless))
-
- Alternatively you can experiment with the built-in completion-styles,
-e.g., adding ‘partial-completion’ or ‘flex’. The ‘partial-completion’
-style is important to add if you want to open multiple files at once
-with ‘find-file’ using wildcards. In order to open multiple files at
-once, you have to move to the prompt and then press ‘RET’.
-
- (setq completion-styles '(basic substring partial-completion flex))
-
- Because Vertico is fully compatible with Emacs default completion
-system, further customization of completion behavior can be achieved by
-setting the designated Emacs variables. For example, one may wish to
-disable case-sensitivity for file and buffer matching when built-in
-completion styles are used instead of ‘orderless’:
-
- (setq read-file-name-completion-ignore-case t
- read-buffer-completion-ignore-case t
- completion-ignore-case t)
-
-
-File: vertico.info, Node: Completion-at-point and completion-in-region, Next: Completing-read-multiple (CRM), Prev: Completion styles and TAB completion, Up: Configuration
-
-4.2 Completion-at-point and completion-in-region
-================================================
-
-The ‘completion-at-point’ command is usually bound to ‘M-TAB’ or ‘TAB’.
-In case you want to use Vertico for
-completion-at-point/completion-in-region, you can use the function
-‘consult-completion-in-region’ provided by the Consult package.
-
- ;; 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)))
-
- The ‘completion-in-region-function’ setting also affects TAB
-completion in the minibuffer when ‘M-:’ (‘eval-expression’) is used.
-
- You may also want to look into my Corfu
-(https://github.com/minad/corfu) package, which provides a minimal
-completion system for ‘completion-in-region’ in a child frame popup.
-Corfu is also a narrowly focused package and developed in the same
-spirit as Vertico.
-
-
-File: vertico.info, Node: Completing-read-multiple (CRM), Prev: Completion-at-point and completion-in-region, Up: Configuration
-
-4.3 Completing-read-multiple (CRM)
-==================================
-
-Consult offers an enhanced ‘completing-read-multiple’ implementation
-which you can use with Vertico.
-
- (advice-add #'completing-read-multiple
- :override #'consult-completing-read-multiple)
-
-
-File: vertico.info, Node: Extensions, Next: Complementary packages, Prev: Configuration, Up: Top
-
-5 Extensions
-************
-
-We maintain small extension packages to Vertico in this repository in
-the subdirectory extensions/
-(https://github.com/minad/vertico/tree/main/extensions). The extensions
-are installed together with Vertico if you pull the package from ELPA.
-The extensions are of course inactive by default and can be enabled
-manually if desired. Furthermore it is possible to install all of the
-files separately, both ‘vertico.el’ and the ‘vertico-*.el’ extensions.
-Currently the following extensions come with the Vertico ELPA package:
-
- • vertico-buffer
- (https://github.com/minad/vertico/blob/main/extensions/vertico-buffer.el):
- ‘vertico-buffer-mode’ to display Vertico in a separate buffer
- • vertico-directory
- (https://github.com/minad/vertico/blob/main/extensions/vertico-directory.el):
- Commands for Ido-like directory navigation
- • vertico-flat
- (https://github.com/minad/vertico/blob/main/extensions/vertico-flat.el):
- ‘vertico-flat-mode’ to enable a flat, horizontal display
- • vertico-grid
- (https://github.com/minad/vertico/blob/main/extensions/vertico-grid.el):
- ‘vertico-grid-mode’ to enable a grid display
- • vertico-indexed
- (https://github.com/minad/vertico/blob/main/extensions/vertico-indexed.el):
- ‘vertico-indexed-mode’ to select indexed candidates with prefix
- arguments
- • vertico-mouse
- (https://github.com/minad/vertico/blob/main/extensions/vertico-mouse.el):
- ‘vertico-mouse-mode’ to support for scrolling and candidate
- selection
- • vertico-quick
- (https://github.com/minad/vertico/blob/main/extensions/vertico-quick.el):
- Commands to select using Avy-style quick keys
- • vertico-repeat
- (https://github.com/minad/vertico/blob/main/extensions/vertico-repeat.el):
- The command ‘vertico-repeat’ repeats the last completion session
- • vertico-reverse
- (https://github.com/minad/vertico/blob/main/extensions/vertico-reverse.el):
- ‘vertico-reverse-mode’ to reverse the display
-
- With these extensions it is possible to adapt Vertico such that it
-matches your preference or behaves similar to other familiar UIs. For
-example, the combination ‘vertico-flat’ plus ‘vertico-directory’
-resembles Ido in look and feel. For an interface similar to Helm, the
-extension ‘vertico-buffer’ allows you to configure more freely where the
-completion buffer opens, instead of growing the minibuffer.
-
- Configuration example for ‘vertico-directory’:
-
- ;; Configure directory extension.
- (use-package vertico-directory
- :ensure nil
- ;; More convenient directory navigation commands
- :bind (:map vertico-map
- ("RET" . vertico-directory-enter)
- ("DEL" . vertico-directory-delete-char)
- ("M-DEL" . vertico-directory-delete-word))
- ;; Tidy shadowed file names
- :hook (rfn-eshadow-update-overlay . vertico-directory-tidy))
-
-
-File: vertico.info, Node: Complementary packages, Next: Child frames and Popups, Prev: Extensions, Up: Top
-
-6 Complementary packages
-************************
-
-Vertico integrates well with complementary packages, which enrich the
-completion UI. These packages are fully supported:
-
- • Marginalia (https://github.com/minad/marginalia): Rich annotations
- in the minibuffer
- • Consult (https://github.com/minad/consult): Useful search and
- navigation commands
- • Embark (https://github.com/oantolin/embark): Minibuffer actions and
- context menu
- • Orderless (https://github.com/oantolin/orderless): Advanced
- completion style
-
- In order to get accustomed with the package ecosystem, I recommed the
-following approach:
-
- 1. Start with plain Emacs.
- 2. Install and enable Vertico to get incremental minibuffer
- completion.
- 3. Install Orderless and/or configure the built-in completion styles
- for more flexible minibuffer filtering.
- 4. Install Marginalia if you like rich minibuffer annotations.
- 5. Install Embark and add two keybindings for ‘embark-dwim’ and
- ‘embark-act’. I am using ‘M-.’ and ‘C-.’. These commands allow
- you to act on the object at point or in the minibuffer.
- 6. Install Consult if you want additional featureful completion
- commands, e.g, the buffer switcher ‘consult-buffer’ with preview or
- the line-based search ‘consult-line’.
- 7. Install Embark-Consult and Wgrep for export from ‘consult-line’ to
- ‘occur-mode’ buffers and from ‘consult-grep’ to editable
- ‘grep-mode’ buffers.
-
- You don’t have to use all of these components. Use only the ones you
-like and the ones which fit well into your setup. The steps 1. to 4.
-introduce no new commands over plain Emacs. Step 5. introduces the new
-commands ‘embark-act’ and ‘embark-dwim’. In step 6. you get the
-Consult commands, some offer new functionality not present in Emacs
-already (e.g., ‘consult-line’) and some are substitutes (e.g.,
-‘consult-buffer’ for ‘switch-to-buffer’).
-
-
-File: vertico.info, Node: Child frames and Popups, Next: Alternatives, Prev: Complementary packages, Up: Top
-
-7 Child frames and Popups
-*************************
-
-An often requested feature is the ability to display the completions in
-a child frame popup. I do not recommend this, since from my experience
-it introduces more problems than it solves. Child frames can feel slow
-and sometimes flicker. On the other hand the completion display appears
-right in your focus at the center of the screen, leading to a modern
-look and feel. Please give these packages a try and judge for yourself.
-
- • mini-frame (https://github.com/muffinmad/emacs-mini-frame): Display
- the entire minibuffer in a child frame.
- • mini-popup (https://github.com/minad/mini-popup): Slightly simpler
- alternative to mini-frame.
- • vertico-posframe (https://github.com/tumashu/vertico-posframe):
- Display only the Vertico minibuffer in a child frame using the
- posframe library.
-
-
-File: vertico.info, Node: Alternatives, Next: Problematic completion commands, Prev: Child frames and Popups, Up: Top
-
-8 Alternatives
-**************
-
-There are many alternative completion UIs, each UI with its own
-advantages and disadvantages.
-
- Vertico aims to be 100% compliant with all Emacs commands and
-achieves that with a minimal code base, relying purely on
-‘completing-read’ while avoiding to invent its own APIs. Inventing a
-custom API as Helm or Ivy is explicitly avoided in order to increase
-flexibility and package reuse. Due to its small code base and reuse of
-the Emacs built-in facilities, bugs and compatibility issues are less
-likely to occur in comparison to completion UIs or full completion
-systems, which reimplement a lot of functionality.
-
- Since Vertico only provides the UI, you may want to combine it with
-some of the complementary packages, to give a full-featured completion
-experience similar to Helm or Ivy. Overall the packages in the spirit
-of Vertico have a different style than Helm or Ivy. The idea is to have
-smaller independent components, which one can add and understand step by
-step. Each component focuses on its niche and tries to be as
-non-intrusive as possible. Vertico targets users interested in crafting
-their Emacs precisely to their liking - completion plays an integral
-part in how the users interacts with Emacs.
-
- There are other interactive completion UIs, which follow a similar
-philosophy:
-
- • Selectrum (https://github.com/raxod502/selectrum): Selectrum has a
- similar UI as Vertico, since it directly inspired Vertico. The
- Selectrum code base is more complex. Unfortunately Selectrum is
- not fully compatible with every Emacs completion command (Issue
- #481 (https://github.com/raxod502/selectrum/issues/481)), since it
- uses its own filtering infrastructure, which deviates from the
- standard Emacs completion facilities. Vertico additionally has the
- ability to cycle over candidates, offers commands for grouping
- support and comes with a rich set of *note extensions: Extensions.
- • Icomplete-vertical
- (https://github.com/oantolin/icomplete-vertical): This package
- enhances the Emacs builtin Icomplete with a vertical display. In
- contrast to Vertico, Icomplete rotates the candidates such that the
- current candidate always appears at the top. From my perspective,
- candidate rotation feels a bit less intuitive than the UI of
- Vertico or Selectrum. Note that Emacs 28 offers a built-in
- ‘icomplete-vertical-mode’.
- • Mct (https://gitlab.com/protesilaos/mct): Minibuffer and
- Completions in Tandem. Mct reuses the default ‘*Completions*’
- buffer and enhances it with automatic updates and additional
- keybindings, to select a candidate and move between minibuffer and
- completions buffer. Mct is great if you prefer an unobtrusive UI
- since it can be configured to open only when requested.
- Furthermore since Mct uses a fully functional buffer you can reuse
- all your familar buffer commands inside the completions buffer.
- The main distinction to an approach like Vertico’s is that
- ‘*Completions*’ buffer displays all matching candidates. On the
- one hand this is good since it allows you to interact with all the
- candidates and jump around with Isearch or Avy. On the other hand
- it necessarily causes a small slowdown in comparison to Vertico,
- which only displays a small subset of candidates.
-
-
-File: vertico.info, Node: Problematic completion commands, Next: Contributions, Prev: Alternatives, Up: Top
-
-9 Problematic completion commands
-*********************************
-
-Vertico is robust in most scenarios. However some completion commands
-make certain assumptions about the completion styles and the completion
-UI. Some of these assumptions may not hold in Vertico or other UIs and
-require minor workarounds.
-
-* Menu:
-
-* org-refile::
-* tmm-menubar::
-* ffap-menu::
-* Tramp hostname completion::
-
-
-File: vertico.info, Node: org-refile, Next: tmm-menubar, Up: Problematic completion commands
-
-9.1 ‘org-refile’
-================
-
-‘org-refile’ uses ‘org-olpath-completing-read’ to complete the outline
-path in steps, when ‘org-refile-use-outline-path’ is non-nil.
-
- Unfortunately the implementation of this Org completion table assumes
-that the default completion UI is used. In order to fix the issue at
-the root, the completion table should make use of completion boundaries
-similar to the built-in file completion table.
-
- In order to workaround the issues with the current implementation I
-recommend to disable the outline path completion in steps. The
-completion on the full path is also faster since the input string
-matches directly against the full path, which is particularily useful
-with Orderless.
-
- (setq org-refile-use-outline-path 'file
- org-outline-path-complete-in-steps nil)
-
-
-File: vertico.info, Node: tmm-menubar, Next: ffap-menu, Prev: org-refile, Up: Problematic completion commands
-
-9.2 ‘tmm-menubar’
-=================
-
-The text menu bar works well with Vertico but always shows a
-‘*Completions*’ buffer, which is unwanted if you use the Vertico UI.
-This completion buffer can be disabled as follows.
-
- (advice-add #'tmm-add-prompt :after #'minibuffer-hide-completions)
-
-
-File: vertico.info, Node: ffap-menu, Next: Tramp hostname completion, Prev: tmm-menubar, Up: Problematic completion commands
-
-9.3 ‘ffap-menu’
-===============
-
-The command ‘ffap-menu’ shows the ‘=*Completions*’ buffer by default
-like ‘tmm-menubar’, which is unnecessary with Vertico. This completion
-buffer can be disabled as follows.
-
- (advice-add #'ffap-menu-ask :around (lambda (&rest args)
- (cl-letf (((symbol-function #'minibuffer-completion-help)
- #'ignore))
- (apply args))))
-
-
-File: vertico.info, Node: Tramp hostname completion, Prev: ffap-menu, Up: Problematic completion commands
-
-9.4 Tramp hostname completion
-=============================
-
-In combination with Orderless, hostnames are not made available for
-completion after entering ‘/ssh:’. In order to avoid this problem, the
-‘basic’ completion style should be specified for the file completion
-category.
-
- (setq completion-styles '(orderless)
- completion-category-overrides '((file (styles basic partial-completion))))
-
- For users who are familiar with the ‘completion-style’ machinery: You
-may also define a custom completion style which sets in only for remote
-files!
-
- (defun basic-remote-try-completion (string table pred point)
- (and (vertico--remote-p string)
- (completion-basic-try-completion string table pred point)))
- (defun basic-remote-all-completions (string table pred point)
- (and (vertico--remote-p string)
- (completion-basic-all-completions string table pred point)))
- (add-to-list
- 'completion-styles-alist
- '(basic-remote basic-remote-try-completion basic-remote-all-completions nil))
- (setq completion-styles '(orderless)
- completion-category-overrides '((file (styles basic-remote partial-completion))))
-
-
-File: vertico.info, Node: Contributions, Prev: Problematic completion commands, Up: Top
-
-10 Contributions
-****************
-
-Since this package is part of GNU ELPA
-(http://elpa.gnu.org/packages/vertico.html) contributions require a
-copyright assignment to the FSF.
-
-
-
-Tag Table:
-Node: Top196
-Node: Introduction856
-Node: Features1658
-Node: Key bindings2545
-Node: Configuration3780
-Node: Completion styles and TAB completion7087
-Node: Completion-at-point and completion-in-region9397
-Node: Completing-read-multiple (CRM)10722
-Node: Extensions11141
-Node: Complementary packages14250
-Node: Child frames and Popups16354
-Node: Alternatives17344
-Node: Problematic completion commands20882
-Node: org-refile21394
-Node: tmm-menubar22326
-Node: ffap-menu22743
-Node: Tramp hostname completion23376
-Node: Contributions24688
-
-End Tag Table
-
-
-Local Variables:
-coding: utf-8
-End:
diff --git a/elpa/vertico-posframe-0.4.2.signed b/elpa/vertico-posframe-0.4.2.signed
@@ -1 +0,0 @@
-Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2021-12-02T11:10:02+0100 using RSA
-\ No newline at end of file
diff --git a/elpa/vertico-posframe-0.4.2/LICENSE b/elpa/vertico-posframe-0.4.2/LICENSE
@@ -1,674 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <https://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 <https://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
-<https://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
-<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/elpa/vertico-posframe-0.4.2/README.org b/elpa/vertico-posframe-0.4.2/README.org
@@ -1,26 +0,0 @@
-#+TITLE: README of vertico-posframe
-
-** What is vertico-posframe
-
-vertico-posframe is an vertico extension, which lets vertico use
-posframe to show its candidate menu.
-
-NOTE: vertico-posframe requires Emacs 26 and do not support mouse
-click.
-
-** How to enable vertico-posframe
-#+BEGIN_EXAMPLE
-(require 'vertico-posframe)
-(vertico-posframe-mode 1)
-#+END_EXAMPLE
-
-** Tips
-*** How to show fringe to vertico-posframe
-#+BEGIN_EXAMPLE
-(setq vertico-posframe-parameters
- '((left-fringe . 8)
- (right-fringe . 8)))
-#+END_EXAMPLE
-
-By the way, User can set *any* parameters of vertico-posframe with
-the help of `vertico-posframe-parameters'.
diff --git a/elpa/vertico-posframe-0.4.2/vertico-posframe-autoloads.el b/elpa/vertico-posframe-0.4.2/vertico-posframe-autoloads.el
@@ -1,47 +0,0 @@
-;;; vertico-posframe-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-
-;;;### (autoloads nil "vertico-posframe" "vertico-posframe.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from vertico-posframe.el
-
-(defvar vertico-posframe-mode nil "\
-Non-nil if Vertico-Posframe mode is enabled.
-See the `vertico-posframe-mode' command
-for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `vertico-posframe-mode'.")
-
-(custom-autoload 'vertico-posframe-mode "vertico-posframe" nil)
-
-(autoload 'vertico-posframe-mode "vertico-posframe" "\
-Display Vertico in posframe instead of the minibuffer.
-
-If called interactively, enable Vertico-Posframe mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
-
-\(fn &optional ARG)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vertico-posframe" '("vertico-posframe-")))
-
-;;;***
-
-;;;### (autoloads nil nil ("vertico-posframe-pkg.el") (0 0 0 0))
-
-;;;***
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; vertico-posframe-autoloads.el ends here
diff --git a/elpa/vertico-posframe-0.4.2/vertico-posframe-pkg.el b/elpa/vertico-posframe-0.4.2/vertico-posframe-pkg.el
@@ -1,2 +0,0 @@
-;; Generated package description from vertico-posframe.el -*- no-byte-compile: t -*-
-(define-package "vertico-posframe" "0.4.2" "Using posframe to show Vertico" '((emacs "26.0") (posframe "1.0.0") (vertico "0.13.0")) :authors '(("Feng Shu" . "tumashu@163.com")) :maintainer '("Feng Shu" . "tumashu@163.com") :keywords '("abbrev" "convenience" "matching" "vertico") :url "https://github.com/tumashu/vertico-posframe")
diff --git a/elpa/vertico-posframe-0.4.2/vertico-posframe.el b/elpa/vertico-posframe-0.4.2/vertico-posframe.el
@@ -1,328 +0,0 @@
-;;; vertico-posframe.el --- Using posframe to show Vertico -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 Free Software Foundation, Inc.
-
-;; Author: Feng Shu <tumashu@163.com>
-;; Maintainer: Feng Shu <tumashu@163.com>
-;; URL: https://github.com/tumashu/vertico-posframe
-;; Version: 0.4.2
-;; Keywords: abbrev, convenience, matching, vertico
-;; Package-Requires: ((emacs "26.0") (posframe "1.0.0") (vertico "0.13.0"))
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-
-;;; Commentary:
-;; * vertico-posframe README :README:
-
-;; ** What is vertico-posframe
-
-;; vertico-posframe is an vertico extension, which lets vertico use posframe to show
-;; its candidate menu.
-
-;; NOTE: vertico-posframe requires Emacs 26 and do not support mouse
-;; click.
-
-;; ** How to enable vertico-posframe
-;; #+BEGIN_EXAMPLE
-;; (require 'vertico-posframe)
-;; (vertico-posframe-mode 1)
-;; #+END_EXAMPLE
-
-;; ** Tips
-
-;; *** How to show fringe to vertico-posframe
-;; #+BEGIN_EXAMPLE
-;; (setq vertico-posframe-parameters
-;; '((left-fringe . 8)
-;; (right-fringe . 8)))
-;; #+END_EXAMPLE
-
-;; By the way, User can set *any* parameters of vertico-posframe with
-;; the help of `vertico-posframe-parameters'.
-
-;;; Code:
-;; * vertico-posframe's code
-(require 'posframe)
-(require 'vertico)
-
-(defgroup vertico-posframe nil
- "Using posframe to show vertico."
- :group 'vertico-posframe)
-
-(defcustom vertico-posframe-font nil
- "The font used by vertico-posframe.
-When nil, Using current frame's font as fallback."
- :type 'string)
-
-(defcustom vertico-posframe-width nil
- "The width of vertico-posframe."
- :type 'number)
-
-(defcustom vertico-posframe-height nil
- "The height of vertico-posframe."
- :type 'number)
-
-(defcustom vertico-posframe-min-width nil
- "The min width of vertico-posframe."
- :type 'number)
-
-(defcustom vertico-posframe-min-height nil
- "The min height of vertico-posframe."
- :type 'number)
-
-(defcustom vertico-posframe-poshandler #'posframe-poshandler-frame-center
- "The posframe poshandler used by vertico-posframe."
- :type 'function)
-
-(defcustom vertico-posframe-refposhandler #'vertico-posframe-refposhandler-default
- "The refposhandler used by vertico-posframe.
-
-NOTE: This variable is very useful to EXWM users."
- :type 'function)
-
-(defcustom vertico-posframe-size-function #'vertico-posframe-get-size
- "The function which is used to deal with posframe's size."
- :type 'function)
-
-(defcustom vertico-posframe-border-width 2
- "The border width used by vertico-posframe.
-When 0, no border is showed."
- :type 'number)
-
-(defcustom vertico-posframe-parameters nil
- "The frame parameters used by vertico-posframe."
- :type 'string)
-
-(defcustom vertico-posframe-show-minibuffer-rules
- (list "^eval-*")
- "A list of rule showed minibuffer.
-
-a rule can be a regexp or a function.
-
-1. when rule is a regexp and it match `this-command'.
-2. when rule is a function and it return t.
-3. when rule is a symbol, its value is t.
-
-minibuffer will not be hided by minibuffer-cover."
- :type '(repeat (choice string function)))
-
-(defface vertico-posframe
- '((t (:inherit default)))
- "Face used by the vertico-posframe."
- :group 'vertico-posframe)
-
-(defface vertico-posframe-border
- '((t (:inherit default :background "gray50")))
- "Face used by the vertico-posframe's border."
- :group 'vertico-posframe)
-
-(defface vertico-posframe-cursor
- '((t (:inherit cursor)))
- "Face used by the vertico-posframe's fake cursor."
- :group 'vertico-posframe)
-
-(defvar vertico-posframe--buffer " *vertico-posframe--buffer*")
-(defvar vertico-posframe--minibuffer-cover " *vertico-posframe--minibuffer-cover*")
-
-;; Fix warn
-(defvar exwm--connection)
-(defvar exwm-workspace--workareas)
-(defvar exwm-workspace-current-index)
-
-(defun vertico-posframe-refposhandler-default (&optional frame)
- "The default posframe refposhandler used by vertico-posframe.
-Optional argument FRAME ."
- (cond
- ;; EXWM environment
- ((bound-and-true-p exwm--connection)
- (or (ignore-errors
- (let ((info (elt exwm-workspace--workareas
- exwm-workspace-current-index)))
- (cons (elt info 0)
- (elt info 1))))
- ;; Need user install xwininfo.
- (ignore-errors
- (posframe-refposhandler-xwininfo frame))
- ;; Fallback, this value will incorrect sometime, for example: user
- ;; have panel.
- (cons 0 0)))
- (t nil)))
-
-(defun vertico-posframe-hidehandler (_)
- "Hidehandler used by vertico-posframe."
- (not (minibufferp)))
-
-(defun vertico-posframe-get-size ()
- "The default functon used by `vertico-posframe-size-function'."
- (list
- :height vertico-posframe-height
- :width vertico-posframe-width
- :min-height (or vertico-posframe-min-height
- (let ((height (+ vertico-count 1)))
- (min height (or vertico-posframe-height height))))
- :min-width (or vertico-posframe-min-width
- (let ((width (round (* (frame-width) 0.62))))
- (min width (or vertico-posframe-width width))))))
-
-(defun vertico-posframe--display (lines)
- "Display LINES in posframe."
- (let* ((show-minibuffer-p (vertico-posframe--show-minibuffer-p))
- (count (vertico-posframe--format-count))
- (prompt (propertize (minibuffer-prompt) 'face 'minibuffer-prompt))
- ;; NOTE: Vertico count in minibuffer is before-string of an
- ;; overlay, so minibuffer contents will not include it.
- (contents (minibuffer-contents))
- (n (+ (length count)
- (max (point) (+ (length prompt) 1))))
- ;; FIXME: make sure background and foreground do
- ;; not have similar color. ivy-posframe have not
- ;; this problem, I can not find the reason.
- (cursor-face
- (list :foreground (face-attribute 'default :background)
- :inherit 'vertico-posframe-cursor)))
- (with-current-buffer (get-buffer-create vertico-posframe--buffer)
- (setq-local inhibit-read-only nil
- inhibit-modification-hooks t
- cursor-in-non-selected-windows 'box)
- (erase-buffer)
- (insert count prompt contents "\n" (string-join lines))
- (add-text-properties n (+ n 1) `(face ,cursor-face)))
- (with-selected-window (vertico-posframe-last-window)
- ;; Create a posframe to cover minibuffer.
- (if show-minibuffer-p
- (vertico-posframe--hide-minibuffer-cover)
- (vertico-posframe--create-minibuffer-cover))
- (vertico-posframe--show))))
-
-(defun vertico-posframe--format-count ()
- "Format vertico count."
- (propertize (or (vertico--format-count) "") 'face 'minibuffer-prompt))
-
-(defun vertico-posframe--show (&optional string)
- "`posframe-show' of vertico-posframe.
-Show STRING when it is a string."
- (apply #'posframe-show
- vertico-posframe--buffer
- :string string
- :font vertico-posframe-font
- :poshandler vertico-posframe-poshandler
- :background-color (face-attribute 'vertico-posframe :background nil t)
- :foreground-color (face-attribute 'vertico-posframe :foreground nil t)
- :border-width vertico-posframe-border-width
- :border-color (face-attribute 'vertico-posframe-border :background nil t)
- :override-parameters vertico-posframe-parameters
- :refposhandler vertico-posframe-refposhandler
- :hidehandler #'vertico-posframe-hidehandler
- :lines-truncate t
- (funcall vertico-posframe-size-function)))
-
-(defun vertico-posframe--show-init ()
- "Create posframe in advance to limit flicker for `vertico-posframe--show'."
- (posframe-show vertico-posframe--buffer
- :string ""
- :font vertico-posframe-font
- :position (cons 0 0)
- :background-color (face-attribute 'vertico-posframe :background nil t)
- :foreground-color (face-attribute 'vertico-posframe :foreground nil t)
- :border-width vertico-posframe-border-width
- :border-color (face-attribute 'vertico-posframe-border :background nil t)
- :override-parameters vertico-posframe-parameters
- :timeout 0.1))
-
-(defun vertico-posframe--create-minibuffer-cover (&optional string)
- "Create minibuffer cover."
- (let ((color (face-background 'default nil))
- (win (active-minibuffer-window)))
- (posframe-show vertico-posframe--minibuffer-cover
- :string (or string (make-string (frame-width) ?\ ))
- :position (cons 0 (- (frame-pixel-height) (window-pixel-height win)))
- :height (+ (window-height win) 1)
- :background-color color
- :foreground-color color
- :lines-truncate t
- :timeout 3)))
-
-(defun vertico-posframe--hide-minibuffer-cover ()
- "Hide minibuffer cover."
- ;; FIXME: delay 0.1 second to remove minibuffer cover, which can
- ;; limit minibuffer flicker.
- (run-with-timer
- 0.1 nil
- (lambda ()
- (posframe-hide vertico-posframe--minibuffer-cover))))
-
-(defun vertico-posframe--show-minibuffer-p ()
- "Test show minibuffer or not."
- (or current-input-method
- (cl-some
- (lambda (rule)
- (cond ((functionp rule)
- (funcall rule))
- ((and rule (stringp rule))
- (string-match-p rule (symbol-name this-command)))
- ((symbolp rule)
- (symbol-value rule))
- (t nil)))
- vertico-posframe-show-minibuffer-rules)))
-
-(defun vertico-posframe-last-window ()
- "Get the last actived window before active minibuffer."
- (let ((window (minibuffer-selected-window)))
- (or (if (window-live-p window)
- window
- (next-window))
- (selected-window))))
-
-(defun vertico-posframe--hide ()
- "Hide vertico buffer."
- (when (posframe-workable-p)
- (posframe-hide vertico-posframe--buffer)
- (vertico-posframe--hide-minibuffer-cover)))
-
-(defun vertico-posframe--setup ()
- "Setup minibuffer overlay, which pushes the minibuffer content down."
- (add-hook 'minibuffer-exit-hook 'vertico-posframe--hide nil 'local)
- (setq-local cursor-type '(bar . 0)))
-
-(defun vertico-posframe--minibuffer-message (message &rest _args)
- "Advice function of `minibuffer-message'.
-Argument MESSAGE ."
- (let* ((count (vertico-posframe--format-count))
- (contents (buffer-string)))
- (vertico-posframe--show (concat count contents message))))
-
-;;;###autoload
-(define-minor-mode vertico-posframe-mode
- "Display Vertico in posframe instead of the minibuffer."
- :global t
- (cond
- (vertico-posframe-mode
- (advice-add #'minibuffer-message :before #'vertico-posframe--minibuffer-message)
- (advice-add #'vertico--display-candidates :override #'vertico-posframe--display)
- (advice-add #'vertico--setup :after #'vertico-posframe--setup)
- ;; Create posframe in advance to limit flicker.
- (vertico-posframe--show-init)
- (vertico-posframe--create-minibuffer-cover ""))
- (t
- (advice-remove #'minibuffer-message #'vertico-posframe--minibuffer-message)
- (advice-remove #'vertico--display-candidates #'vertico-posframe--display)
- (advice-remove #'vertico--setup #'vertico-posframe--setup)
- (posframe-delete vertico-posframe--buffer)
- (posframe-delete vertico-posframe--minibuffer-cover))))
-
-(provide 'vertico-posframe)
-;;; vertico-posframe.el ends here
diff --git a/elpa/vertico-posframe-0.4.2/vertico-posframe.elc b/elpa/vertico-posframe-0.4.2/vertico-posframe.elc
Binary files differ.
