diff options
| author | Jack Jamison <jackqjamison@gmail.com> | 2026-07-05 01:19:30 -0400 |
|---|---|---|
| committer | Jack Jamison <jackqjamison@gmail.com> | 2026-07-05 01:19:30 -0400 |
| commit | bdf9a71ab7baa2b1de9abcfd5df1a9107a55d141 (patch) | |
| tree | c4524e6c41aa5107211103401dabfaefc81aa882 /.config/emacs/lisp/minadstack/vertico.el | |
| parent | fe3984f541bd32bdfa418afb305b614176b55ca0 (diff) | |
add a bunch of emacs packages HELP
Diffstat (limited to '.config/emacs/lisp/minadstack/vertico.el')
| -rw-r--r-- | .config/emacs/lisp/minadstack/vertico.el | 736 |
1 files changed, 736 insertions, 0 deletions
diff --git a/.config/emacs/lisp/minadstack/vertico.el b/.config/emacs/lisp/minadstack/vertico.el new file mode 100644 index 0000000..c646f0b --- /dev/null +++ b/.config/emacs/lisp/minadstack/vertico.el @@ -0,0 +1,736 @@ +;;; vertico.el --- VERTical Interactive COmpletion -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2026 Free Software Foundation, Inc. + +;; Author: Daniel Mendler <mail@daniel-mendler.de> +;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> +;; Created: 2021 +;; Version: 2.8 +;; Package-Requires: ((emacs "29.1") (compat "30")) +;; URL: https://github.com/minad/vertico +;; Keywords: convenience, files, matching, completion + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; 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 'compat) +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) + +(defgroup vertico nil + "VERTical Interactive COmpletion." + :link '(info-link :tag "Info Manual" "(vertico)") + :link '(url-link :tag "Website" "https://github.com/minad/vertico") + :link '(url-link :tag "Wiki" "https://github.com/minad/vertico/wiki") + :link '(emacs-library-link :tag "Library Source" "vertico.el") + :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 1))))) + "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 'natnum) + +(defcustom vertico-preselect 'directory + "Configure if the prompt or first candidate is preselected. +- prompt: Always select the prompt. +- first: Select the first candidate, allow prompt selection. +- no-prompt: Like first, but forbid selection of the prompt entirely. +- directory: Like first, but select the prompt if it is a directory." + :type '(choice (const prompt) (const first) (const no-prompt) (const directory))) + +(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 'natnum) + +(defcustom vertico-resize resize-mini-windows + "How to resize the Vertico minibuffer window, see `resize-mini-windows'." + :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 + (and (fboundp 'vertico-sort-history-length-alpha) '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"))) + +(defcustom vertico-sort-override-function nil + "Override sort function which overrides the `display-sort-function'." + :type '(choice (const nil) 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 vertico-group-title :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-keymap vertico-map + :doc "Vertico minibuffer keymap derived from `minibuffer-local-map'." + :parent minibuffer-local-map + "<remap> <beginning-of-buffer>" #'vertico-first + "<remap> <minibuffer-beginning-of-buffer>" #'vertico-first + "<remap> <end-of-buffer>" #'vertico-last + "<remap> <scroll-down-command>" #'vertico-scroll-down + "<remap> <scroll-up-command>" #'vertico-scroll-up + "<remap> <next-line>" #'vertico-next + "<remap> <previous-line>" #'vertico-previous + "<remap> <next-line-or-history-element>" #'vertico-next + "<remap> <previous-line-or-history-element>" #'vertico-previous + "<remap> <backward-paragraph>" #'vertico-previous-group + "<remap> <forward-paragraph>" #'vertico-next-group + "<remap> <exit-minibuffer>" #'vertico-exit + "<remap> <kill-ring-save>" #'vertico-save + "M-RET" #'vertico-exit-input + "TAB" #'vertico-insert + "<touchscreen-begin>" #'ignore) + +(defvar vertico--locals + '((scroll-margin . 0) + (completion-auto-help . nil) + (pixel-scroll-precision-mode . nil)) + "Vertico minibuffer local variables.") + +(defvar-local vertico--hilit #'identity + "Lazy candidate highlighting function.") + +(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 "" + "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--groups nil + "List of current group titles.") + +(defvar-local vertico--allow-prompt nil + "Prompt selection is allowed.") + +(defun vertico--affixate (cands) + "Annotate CANDS with annotation function." + (if-let* ((aff (vertico--metadata-get 'affixation-function))) + (funcall aff cands) + (if-let* ((ann (vertico--metadata-get 'annotation-function))) + (cl-loop for cand in cands collect + (let ((suff (or (funcall ann cand) ""))) + ;; The default completion UI adds the `completions-annotations' + ;; face if no other faces are present. + (unless (text-property-not-all 0 (length suff) 'face nil suff) + (setq suff (propertize suff 'face 'completions-annotations))) + (list cand "" suff))) + (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))) ;; No duplicates, compare with Corfu. + (nconc (list (car found)) (delq (setcar found nil) list)) + list)) + +(defun vertico--filter-completions (&rest args) + "Compute all completions for ARGS with lazy highlighting." + (dlet ((completion-lazy-hilit t) (completion-lazy-hilit-fn nil)) + (static-if (>= emacs-major-version 30) + (cons (apply #'completion-all-completions args) completion-lazy-hilit-fn) + (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 lazy 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)))) + ((symbol-function #'completion-pcm--hilit-commonality) + (lambda (pattern cands) + (setq completion-lazy-hilit-fn + (lambda (x) + ;; `completion-pcm--hilit-commonality' sometimes throws an internal error + ;; for example when entering "/sudo:://u". + (condition-case nil + (car (completion-pcm--hilit-commonality pattern (list x))) + (t x)))) + cands)) + ((symbol-function #'completion-hilit-commonality) + (lambda (cands prefix &optional base) + (setq completion-lazy-hilit-fn + (lambda (x) (car (completion-hilit-commonality (list x) prefix base)))) + (and cands (nconc cands base))))) + (cons (apply #'completion-all-completions args) completion-lazy-hilit-fn))))) + +(defun vertico--metadata-get (prop) + "Return PROP from completion metadata." + (compat-call completion-metadata-get vertico--metadata prop)) + +(defun vertico--sort-function () + "Return the sorting function." + (or vertico-sort-override-function + (vertico--metadata-get 'display-sort-function) + vertico-sort-function)) + +(defun vertico--compute (input) + "Compute state given INPUT." + (pcase-let* ((`(,str . ,pt) input) + (table minibuffer-completion-table) + (pred minibuffer-completion-predicate) + (before (substring str 0 pt)) + (after (substring str pt)) + ;; bug#47678: `completion-boundaries' fails for `partial-completion' + ;; if the cursor is moved before the slashes of "~//". + ;; See also corfu.el which has the same issue. + (bounds (condition-case nil + (completion-boundaries before table pred after) + (t (cons 0 (length after))))) + (field (substring str (car bounds) (+ pt (cdr bounds)))) + ;; bug#75910: category instead of `minibuffer-completing-file-name' + (completing-file (eq 'file (vertico--metadata-get 'category))) + (`(,all . ,hl) (vertico--filter-completions str table pred pt vertico--metadata)) + (base (or (when-let* ((z (last all))) (prog1 (cdr z) (setcdr z nil))) 0)) + (vertico--base (substring str 0 base)) + (def (or (car-safe minibuffer-default) minibuffer-default)) + (groups) (def-missing) (lock)) + ;; 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 (completion-pcm--filename-try-filter 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* ((fun (and all (vertico--metadata-get 'group-function)))) + (setq groups (vertico--group-by fun all) all (car groups))) + (setq def-missing (and def (equal str "") (not (member def all))) + lock (and vertico--lock-candidate ;; Locked position of old candidate. + (if (< vertico--index 0) -1 + (seq-position all (nth vertico--index vertico--candidates))))) + `((vertico--input . ,input) + (vertico--base . ,vertico--base) + (vertico--metadata . ,vertico--metadata) + (vertico--candidates . ,all) + (vertico--total . ,(length all)) + (vertico--hilit . ,(or hl #'identity)) + (vertico--allow-prompt . ,(and (not (eq vertico-preselect 'no-prompt)) + (or def-missing (eq vertico-preselect 'prompt) + (memq minibuffer--require-match + '(nil confirm confirm-after-completion))))) + (vertico--lock-candidate . ,lock) + (vertico--groups . ,(cdr groups)) + (vertico--index . ,(or lock + (if (or def-missing (eq vertico-preselect 'prompt) (not all) + (and completing-file (eq vertico-preselect 'directory) + (= (length vertico--base) (length str)) + (test-completion str table pred))) + -1 0)))))) + +(defun vertico--hilit (cand) + "Highlight CAND string with lazy highlighting." + ;; bug#77754: Highlight unquoted string. + (funcall vertico--hilit (substring (or (get-text-property + 0 'completion--unquoted cand) cand)))) + +(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 + (cl-loop for elem on elems + for title = (funcall fun (car elem) nil) do + (if-let* ((group (gethash title ht))) + (setcdr group (setcdr (cdr group) elem)) ;; Append to tail of group + (puthash title (cons elem elem) ht) ;; New group element (head . tail) + (push title titles))) + (setq titles (nreverse titles)) + ;; Cycle groups if `vertico--lock-groups' is set + (when-let* ((group (seq-find (lambda (group) (gethash group ht)) + vertico--lock-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))) + (cons (caar 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 (&optional interruptible) + "Update state, optionally INTERRUPTIBLE." + (let* ((pt (max 0 (- (point) (minibuffer-prompt-end)))) + (str (minibuffer-contents-no-properties)) + (input (cons str pt))) + (unless (or (and interruptible (input-pending-p)) (equal vertico--input input)) + ;; Redisplay to make input immediately visible before expensive candidate + ;; recomputation (gh:minad/vertico#89). No redisplay during init because + ;; of flicker. + (when (and interruptible (consp vertico--input)) + ;; Prevent recursive exhibit from timer (`consult-vertico--refresh'). + (cl-letf (((symbol-function #'vertico--exhibit) #'ignore)) (redisplay))) + (pcase (let ((vertico--metadata (completion-metadata (substring str 0 pt) + minibuffer-completion-table + minibuffer-completion-predicate))) + ;; 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 gh:minad/vertico#23). + (if (or (not interruptible) + (and (eq 'file (vertico--metadata-get 'category)) + (or (vertico--remote-p str) (vertico--remote-p default-directory)))) + (vertico--compute input) + (let ((non-essential t)) + (while-no-input (vertico--compute input))))) + ('nil (abort-recursive-edit)) + ((and state (pred consp)) + (dolist (s state) (set (car s) (cdr s)))))))) + +(defun vertico--display-string (str) + "Return display STR without display and invisible properties." + (let ((end (length str)) (pos 0) chunks) + (while (< pos end) + (let ((nextd (next-single-property-change pos 'display str end)) + (disp (get-text-property pos 'display str))) + (if (stringp disp) + (let ((face (get-text-property pos 'face str))) + (when face + (add-face-text-property 0 (length disp) face t (setq disp (concat disp)))) + (setq pos nextd chunks (cons disp chunks))) + (while (< pos nextd) + (let ((nexti (next-single-property-change pos 'invisible str nextd))) + (unless (or (get-text-property pos 'invisible str) + (and (= pos 0) (= nexti end))) ;; full string -> no allocation + (push (substring str pos nexti) chunks)) + (setq pos nexti)))))) + (if chunks (apply #'concat (nreverse chunks)) str))) + +(defun vertico--window-width () + "Return minimum width of windows, which display the minibuffer." + (cl-loop for win in (get-buffer-window-list) minimize (window-width win))) + +(defun vertico--truncate-multiline (str max) + "Truncate multiline STR to MAX." + (let ((pos 0) (res "")) + (while (and (< (length res) (* 2 max)) (string-match "\\(\\S-+\\)\\|\\s-+" str pos)) + (setq res (concat res (if (match-end 1) (match-string 0 str) + (if (string-search "\n" (match-string 0 str)) + (car vertico-multiline) " "))) + pos (match-end 0))) + (truncate-string-to-width (string-trim res) max 0 nil (cdr vertico-multiline)))) + +(defun vertico--compute-scroll () + "Compute new 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--format-group-title (title cand) + "Format group TITLE given the current CAND." + ;; Copy candidate highlighting if title is a prefix of the candidate. + (when (string-prefix-p title cand) + (setq title (substring cand 0 (length title))) + (vertico--remove-face 0 (length title) 'completions-first-difference title)) + (setq title (substring title)) + (add-face-text-property 0 (length title) 'vertico-group-title t title) + (format (concat vertico-group-format "\n") title)) + +(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 "*") + (t "!")) + vertico--total))) + +(defun vertico--display-count () + "Update count overlay `vertico--count-ov'." + (move-overlay vertico--count-ov (point-min) (point-min)) + (overlay-put vertico--count-ov 'before-string + (if vertico-count-format (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) + (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 (ensure-list val)) obj)) + (setq beg next)))) + +(defun vertico--debug (&rest _) + "Debugger used by `vertico--protect'." + (let ((inhibit-message t)) + (require 'backtrace) + (declare-function backtrace-to-string "backtrace") + (message "Vertico detected an error:\n%s" (backtrace-to-string))) + (let (message-log-max) + (message "%s %s" + (propertize "Vertico detected an error:" 'face 'error) + (substitute-command-keys "Press \\[view-echo-area-messages] to see the stack trace"))) + nil) + +(defun vertico--protect (fun) + "Protect FUN such that errors are caught. +If an error occurs, the FUN is retried with `debug-on-error' enabled and +the stack trace is shown in the *Messages* buffer." + (static-if (fboundp 'handler-bind) ;; Available on Emacs 30 + (ignore-errors + (handler-bind ((error #'vertico--debug)) + (funcall fun))) + (when (or debug-on-error (condition-case nil + (progn (funcall fun) nil) + (error t))) + (let ((debug-on-error t) + (debugger #'vertico--debug)) + (condition-case nil + (funcall fun) + ((debug error) nil)))))) + +(defun vertico--exhibit () + "Exhibit completion UI." + (vertico--protect + (lambda () + (let ((buffer-undo-list t)) ;; Overlays affect point position and undo list! + (vertico--update 'interruptible) + (vertico--prompt-selection) + (vertico--display-count) + (vertico--display-candidates (vertico--arrange-candidates)))))) + +(defun vertico--goto (index) + "Go to candidate with INDEX." + (setq vertico--index + (max (if (or vertico--allow-prompt (= 0 vertico--total)) -1 0) + (min index (1- vertico--total))) + vertico--lock-candidate (or (>= vertico--index 0) vertico--allow-prompt))) + +(defun vertico--candidate (&optional hl) + "Return current candidate string with optional highlighting if HL is non-nil." + (let ((content (or (car-safe vertico--input) (minibuffer-contents-no-properties)))) + (cond + ((>= vertico--index 0) + (let ((cand (substring (nth vertico--index vertico--candidates)))) + ;; XXX Drop the completions-common-part face which is added by the + ;; `completion--twq-all' hack. This should better be fixed in Emacs + ;; itself, the corresponding code is already marked as fixme. + (vertico--remove-face 0 (length cand) 'completions-common-part cand) + (concat vertico--base (if hl (vertico--hilit cand) cand)))) + ((and (equal content "") (or (car-safe minibuffer-default) minibuffer-default))) + (t content)))) + +(defun vertico--match-p (input) + "Return t if INPUT is a valid match." + (let ((rm minibuffer--require-match)) + (or (memq rm '(nil confirm-after-completion)) + (equal "" input) ;; Null completion, returns default value + (if (functionp rm) (funcall rm input) ;; require-match can be a function + (test-completion input minibuffer-completion-table minibuffer-completion-predicate)) + (if (eq rm 'confirm) (eq (ignore-errors (read-char "Confirm")) 13) + (minibuffer-message "Match required") nil)))) + +(cl-defgeneric vertico--format-candidate (cand prefix suffix index _start) + "Format CAND given PREFIX, SUFFIX and INDEX." + (setq cand (vertico--display-string (concat prefix cand suffix "\n"))) + (when (= index vertico--index) + (add-face-text-property 0 (length cand) 'vertico-current 'append cand)) + cand) + +(cl-defgeneric vertico--arrange-candidates () + "Arrange candidates." + (vertico--compute-scroll) + (let ((curr-line 0) lines) + ;; Compute group titles + (let* (title (index vertico--scroll) + (group-fun (and vertico-group-format (vertico--metadata-get 'group-function))) + (candidates + (vertico--affixate + (cl-loop repeat vertico-count for c in (nthcdr index vertico--candidates) + collect (vertico--hilit c))))) + (pcase-dolist ((and cand `(,str . ,_)) candidates) + (when-let* ((new-title (and group-fun (funcall group-fun str nil)))) + (unless (equal title new-title) + (setq title new-title) + (push (vertico--format-group-title title str) lines)) + (setcar cand (funcall group-fun str 'transform))) + (when (= index vertico--index) + (setq curr-line (length lines))) + (push (cons index cand) lines) + (cl-incf 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 (- (vertico--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-search "\n" cand) + (setq cand (vertico--truncate-multiline cand max-width))) + (setcar line (vertico--format-candidate cand prefix suffix index start)))))) + lines)) + +(cl-defgeneric 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 'before-string + (apply #'concat #(" " 0 1 (cursor t)) (and lines "\n") lines)) + (vertico--resize-window (length lines))) + +(cl-defgeneric vertico--resize-window (height) + "Resize active minibuffer window to HEIGHT." + (setq-local truncate-lines (< (point) (* 0.8 (vertico--window-width))) + resize-mini-windows 'grow-only + max-mini-window-height 1.0) + (unless truncate-lines (set-window-hscroll nil 0)) + (unless (frame-root-window-p (active-minibuffer-window)) + (unless vertico-resize (setq height (max height vertico-count))) + (let ((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))))) + +(cl-defgeneric vertico--prepare () + "Ensure that the state is prepared before running the next command." + (when-let* ((cmd (and (symbolp this-command) (symbol-name this-command))) + ((string-prefix-p "vertico-" cmd)) + ((not (and vertico--metadata (string-prefix-p "vertico-directory-" cmd))))) + (vertico--update))) + +(cl-defgeneric vertico--setup () + "Setup completion UI." + (dolist (var vertico--locals) + (set (make-local-variable (car var)) (cdr var))) + (setq-local vertico--input t + vertico--candidates-ov (make-overlay (point-max) (point-max) nil t t) + vertico--count-ov (make-overlay (point-min) (point-min) nil t t)) + (overlay-put vertico--count-ov 'priority 1) ;; For `minibuffer-depth-indicate-mode' + (use-local-map vertico-map) + (add-hook 'pre-command-hook #'vertico--prepare nil 'local) + (add-hook 'post-command-hook #'vertico--exhibit nil 'local)) + +(cl-defgeneric vertico--advice (&rest app) + "Advice for completion function, apply APP." + (dlet ((completion-eager-display nil)) ;; Available on Emacs 31 + (minibuffer-with-setup-hook #'vertico--setup (apply app)))) + +(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 (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-exit (&optional arg) + "Exit minibuffer with current candidate or input if prefix ARG is given." + (interactive "P") + (when (and (not arg) (>= vertico--index 0)) + (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) + (setq vertico--groups (and (not (eq n 0)) + (vertico--cycle vertico--groups + (let ((len (length vertico--groups))) + (- len (mod (- (or n 1)) len))))) + vertico--lock-groups vertico--groups + 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 (substring-no-properties (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 (> vertico--total 0) + (let ((vertico--index (max 0 vertico--index))) + (insert (prog1 (vertico--candidate) (delete-minibuffer-contents)))))) + +;;;###autoload +(define-minor-mode vertico-mode + "VERTical Interactive COmpletion." + :global t :group 'vertico + (dolist (fun '(completing-read-default completing-read-multiple)) + (if vertico-mode + (advice-add fun :around #'vertico--advice) + (advice-remove fun #'vertico--advice)))) + +(defun vertico--command-p (_sym buffer) + "Return non-nil if Vertico is active in BUFFER." + (buffer-local-value 'vertico--input buffer)) + +;; 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 + vertico-repeat-next ;; autoloads in vertico-repeat.el + vertico-quick-jump vertico-quick-exit vertico-quick-insert ;; autoloads in vertico-quick.el + vertico-directory-up vertico-directory-enter ;; autoloads in vertico-directory.el + vertico-directory-delete-char vertico-directory-delete-word)) + (put sym 'completion-predicate #'vertico--command-p)) + +(provide 'vertico) +;;; vertico.el ends here |
