diff options
Diffstat (limited to '.config/emacs/lisp/minadstack/vertico.el')
| -rw-r--r-- | .config/emacs/lisp/minadstack/vertico.el | 736 |
1 files changed, 0 insertions, 736 deletions
diff --git a/.config/emacs/lisp/minadstack/vertico.el b/.config/emacs/lisp/minadstack/vertico.el deleted file mode 100644 index c646f0b..0000000 --- a/.config/emacs/lisp/minadstack/vertico.el +++ /dev/null @@ -1,736 +0,0 @@ -;;; 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 |