replace ivy->vertico emac
This commit is contained in:
@@ -15,8 +15,8 @@
|
||||
(require 'popup)
|
||||
|
||||
;; Completion framework
|
||||
(require 'ivy)
|
||||
(require 'counsel)
|
||||
(require 'vertico)
|
||||
(require 'orderless)
|
||||
|
||||
;; Language modes
|
||||
(require 'yaml-mode)
|
||||
@@ -52,31 +52,34 @@
|
||||
(add-to-list 'auto-mode-alist '("\\.[hc]\\(pp\\)?\\'" . simpc-mode))
|
||||
|
||||
;;; ============================================================================
|
||||
;;; IVY & COMPLETION FRAMEWORK
|
||||
;;; VERTICO & COMPLETION FRAMEWORK
|
||||
;;; ============================================================================
|
||||
|
||||
(ivy-mode 1)
|
||||
(setq ivy-use-virtual-buffers t)
|
||||
(setq ivy-count-format "(%d/%d) ")
|
||||
(setq ivy-wrap t)
|
||||
(vertico-mode 1)
|
||||
(setq vertico-cycle t)
|
||||
(setq vertico-count 15)
|
||||
|
||||
;; orderless completion style
|
||||
(setq completion-styles '(orderless basic))
|
||||
(setq completion-category-overrides '((file (styles basic partial-completion))))
|
||||
(setq orderless-matching-styles '(orderless-literal orderless-regexp))
|
||||
|
||||
;;; ============================================================================
|
||||
;;; XREF, CTAGS & NAVIGATION
|
||||
;;; XREF & NAVIGATION
|
||||
;;; ============================================================================
|
||||
|
||||
;; dumb-jump as fallback for xref
|
||||
;; dumb-jump as fallback for xref when LSP is not available
|
||||
(setq dumb-jump-force-searcher 'grep)
|
||||
(setq dumb-jump-selector 'ivy)
|
||||
(setq dumb-jump-selector 'completing-read)
|
||||
(setq xref-show-definitions-function #'xref-show-definitions-completing-read)
|
||||
(setq tags-revert-without-query t)
|
||||
(add-hook 'xref-backend-functions #'dumb-jump-xref-activate 100)
|
||||
|
||||
;;; ============================================================================
|
||||
;;; EGLOT (LSP) CONFIGURATION
|
||||
;;; ============================================================================
|
||||
|
||||
;; When eglot is active, xref commands (F12, M-f12) automatically use LSP
|
||||
;; instead of CTAGS. Eglot registers itself as a higher-priority xref backend.
|
||||
;; When eglot is active, xref commands (F12, M-f12) automatically use LSP.
|
||||
;; Eglot registers itself as a higher-priority xref backend, with dumb-jump as fallback.
|
||||
|
||||
(setq eglot-autoshutdown t) ; shutdown server when last buffer is closed
|
||||
(setq eglot-confirm-server-initiated-edits nil) ; don't ask for confirmation on renames
|
||||
@@ -99,15 +102,12 @@
|
||||
"Interactively search for symbols in workspace using LSP."
|
||||
(interactive)
|
||||
(if (eglot-managed-p)
|
||||
(let ((server (eglot-current-server))
|
||||
(root (project-root (project-current))))
|
||||
(ivy-read "Symbol: "
|
||||
(lambda (input)
|
||||
(when (and input (>= (length input) 1))
|
||||
(condition-case nil
|
||||
(let* ((resp (jsonrpc-request server :workspace/symbol
|
||||
`(:query ,input)))
|
||||
(items (append resp nil)))
|
||||
(let* ((server (eglot-current-server))
|
||||
(root (project-root (project-current)))
|
||||
(query (read-string "Symbol query: "))
|
||||
(resp (jsonrpc-request server :workspace/symbol `(:query ,query)))
|
||||
(items (append resp nil))
|
||||
(candidates
|
||||
(delq nil
|
||||
(mapcar (lambda (item)
|
||||
(condition-case nil
|
||||
@@ -124,14 +124,11 @@
|
||||
'line line))
|
||||
(error nil)))
|
||||
items)))
|
||||
(error nil))))
|
||||
:dynamic-collection t
|
||||
:require-match t
|
||||
:action (lambda (candidate)
|
||||
(candidate (completing-read "Symbol: " candidates nil t)))
|
||||
(when (and candidate (get-text-property 0 'file candidate))
|
||||
(find-file (get-text-property 0 'file candidate))
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- (get-text-property 0 'line candidate)))))))
|
||||
(forward-line (1- (get-text-property 0 'line candidate)))))
|
||||
(call-interactively 'xref-find-apropos)))
|
||||
|
||||
;;; ============================================================================
|
||||
@@ -297,7 +294,7 @@
|
||||
(setq compilation-scroll-output -1)
|
||||
(setq compilation-save-buffers-predicate 'ignore)
|
||||
|
||||
(defvar my-bottom-panel-buffers '("\\*compilation\\*" "\\*xref\\*" "\\*Flymake diagnostics.*\\*")
|
||||
(defvar my-bottom-panel-buffers '("\\*compilation\\*" "\\*xref\\*" "\\*Flymake diagnostics.*\\*" "\\*grep\\*")
|
||||
"List of buffer name patterns for bottom panel.")
|
||||
|
||||
(defun my-bottom-panel-buffer-p (buf)
|
||||
@@ -331,6 +328,8 @@
|
||||
'("\\*xref\\*" (my-display-in-bottom-panel) (window-height . 0.25)))
|
||||
(add-to-list 'display-buffer-alist
|
||||
'("\\*Flymake diagnostics.*\\*" (my-display-in-bottom-panel) (window-height . 0.25)))
|
||||
(add-to-list 'display-buffer-alist
|
||||
'("\\*grep\\*" (my-display-in-bottom-panel) (window-height . 0.25)))
|
||||
|
||||
(defun my-bottom-panel-toggle ()
|
||||
"Toggle the bottom panel. Close if visible, open if hidden."
|
||||
@@ -487,7 +486,7 @@
|
||||
|
||||
;; --- Project Management ---
|
||||
(global-set-key (kbd "<f7>") 'project-switch-project)
|
||||
(global-set-key (kbd "C-S-p") 'counsel-M-x)
|
||||
(global-set-key (kbd "C-S-p") 'execute-extended-command)
|
||||
|
||||
;; --- Bookmarks ---
|
||||
(global-set-key (kbd "<f9>") 'bookmark-jump)
|
||||
@@ -883,46 +882,6 @@ Does not copy to kill ring."
|
||||
(compile cmd)
|
||||
(my-compile-custom))))
|
||||
|
||||
;;; ============================================================================
|
||||
;;; CUSTOM FUNCTIONS - CTAGS
|
||||
;;; ============================================================================
|
||||
|
||||
(defun my-tags-get-saved ()
|
||||
"Get saved TAGS file path for current project."
|
||||
(when (project-current)
|
||||
(let ((file (my-project-data-file "tags-file")))
|
||||
(when (file-exists-p file)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(string-trim (buffer-string)))))))
|
||||
|
||||
(defun my-tags-save (tags-path)
|
||||
"Save TAGS file path for current project."
|
||||
(when (project-current)
|
||||
(let ((file (my-project-data-file "tags-file")))
|
||||
(with-temp-file file
|
||||
(insert tags-path)))))
|
||||
|
||||
(defun my-tags-load ()
|
||||
"Load saved TAGS file for current project."
|
||||
(let ((saved (my-tags-get-saved)))
|
||||
(when (and saved (file-exists-p saved))
|
||||
(visit-tags-table saved t))))
|
||||
|
||||
(add-hook 'find-file-hook #'my-tags-load)
|
||||
|
||||
(defun ctags-generate ()
|
||||
"Generate TAGS file using ctags in project root or current directory."
|
||||
(interactive)
|
||||
(let* ((default-directory (or (and (project-current)
|
||||
(project-root (project-current)))
|
||||
default-directory))
|
||||
(tags-path (expand-file-name "TAGS" default-directory)))
|
||||
(message "Generating TAGS in %s..." default-directory)
|
||||
(shell-command "ctags -e -R --exclude=.git --exclude=log *")
|
||||
(my-tags-save tags-path)
|
||||
(visit-tags-table tags-path)
|
||||
(message "TAGS generated and saved: %s" tags-path)))
|
||||
|
||||
;;; ============================================================================
|
||||
;;; CUSTOM FUNCTIONS - File Operations
|
||||
|
||||
@@ -1,130 +0,0 @@
|
||||
;;; colir.el --- Color blending library -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2015-2025 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; This file 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, 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.
|
||||
|
||||
;; For a full copy of the GNU General Public License
|
||||
;; see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package solves the problem of adding a face with a background
|
||||
;; to text which may already have a background. In all conflicting
|
||||
;; areas, instead of choosing either the original or the new
|
||||
;; background face, their blended sum is used.
|
||||
;;
|
||||
;; The blend mode functions are taken from URL
|
||||
;; `https://en.wikipedia.org/wiki/Blend_modes'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(eval-and-compile
|
||||
;; Autoloaded since Emacs 31.
|
||||
(unless (fboundp 'color-rgb-to-hex)
|
||||
(autoload 'color-rgb-to-hex "color")))
|
||||
|
||||
(defcustom colir-compose-method #'colir-compose-alpha
|
||||
"The method `colir-blend' uses to compose two color channels."
|
||||
:group 'ivy
|
||||
:type '(radio
|
||||
(function-item colir-compose-alpha)
|
||||
(function-item colir-compose-overlay)
|
||||
(function-item colir-compose-soft-light)))
|
||||
|
||||
(defun colir-compose-soft-light (a b)
|
||||
"Compose color channels A and B in Soft Light blend mode.
|
||||
See URL `https://en.wikipedia.org/wiki/Blend_modes#Soft_Light'."
|
||||
(if (< b 0.5)
|
||||
(+ (* 2 a b) (* a a (- 1 b b)))
|
||||
(+ (* 2 a (- 1 b)) (* (sqrt a) (+ b b -1)))))
|
||||
|
||||
(defun colir-compose-overlay (a b)
|
||||
"Compose color channels A and B in Overlay blend mode.
|
||||
See URL `https://en.wikipedia.org/wiki/Blend_modes#Overlay'."
|
||||
(if (< a 0.5)
|
||||
(* 2 a b)
|
||||
(- 1 (* 2 (- 1 a) (- 1 b)))))
|
||||
|
||||
;; Generalizes Emacs 31 `color-blend'.
|
||||
(defun colir-compose-alpha (a b &optional alpha gamma)
|
||||
"Compose color channels A and B using alpha blending.
|
||||
Optional argument ALPHA controls the influence of A on the result.
|
||||
It is a number between 0.0 and 1.0, inclusive (default 0.5).
|
||||
Optional argument GAMMA controls gamma correction (default 2.2)."
|
||||
(setq alpha (or alpha 0.5))
|
||||
(setq gamma (or gamma 2.2))
|
||||
(+ (* (expt a gamma) alpha) (* (expt b gamma) (- 1 alpha))))
|
||||
|
||||
(defun colir-blend (c1 c2)
|
||||
"Blend the two colors C1 and C2 using `colir-compose-method'.
|
||||
C1 and C2 are triples of floats in [0.0 1.0] range."
|
||||
(apply #'color-rgb-to-hex
|
||||
(cl-mapcar
|
||||
(if (eq (frame-parameter nil 'background-mode) 'dark)
|
||||
;; This method works nicely for dark themes.
|
||||
#'colir-compose-soft-light
|
||||
colir-compose-method)
|
||||
c1 c2)))
|
||||
|
||||
(defun colir-color-parse (color)
|
||||
"Convert string COLOR to triple of floats in [0.0 1.0]."
|
||||
(if (string-match "#\\([[:xdigit:]]\\{2\\}\\)\\([[:xdigit:]]\\{2\\}\\)\\([[:xdigit:]]\\{2\\}\\)" color)
|
||||
(mapcar (lambda (v) (/ (string-to-number v 16) 255.0))
|
||||
(list (match-string 1 color) (match-string 2 color) (match-string 3 color)))
|
||||
;; does not work properly in terminal (maps color to nearest color
|
||||
;; from available color palette).
|
||||
(color-name-to-rgb color)))
|
||||
|
||||
(defun colir--blend-background (start next prevn face object)
|
||||
(let ((background-prev (face-background prevn)))
|
||||
(put-text-property
|
||||
start next 'face
|
||||
(if background-prev
|
||||
(cons `(background-color
|
||||
. ,(colir-blend
|
||||
(colir-color-parse background-prev)
|
||||
(colir-color-parse (face-background face nil t))))
|
||||
prevn)
|
||||
(list face prevn))
|
||||
object)))
|
||||
|
||||
(defun colir-blend-face-background (start end face &optional object)
|
||||
"Append to the face property of the text from START to END the face FACE.
|
||||
When the text already has a face with a non-plain background,
|
||||
blend it with the background of FACE.
|
||||
Optional argument OBJECT is the string or buffer containing the text.
|
||||
See also `font-lock-append-text-property'."
|
||||
(let (next prev prevn)
|
||||
(while (/= start end)
|
||||
(setq next (next-single-property-change start 'face object end))
|
||||
(setq prev (get-text-property start 'face object))
|
||||
(setq prevn (if (listp prev)
|
||||
(cl-find-if #'atom prev)
|
||||
prev))
|
||||
(cond
|
||||
((or (keywordp (car-safe prev)) (consp (car-safe prev)))
|
||||
(put-text-property start next 'face (cons face prev) object))
|
||||
((facep prevn)
|
||||
(colir--blend-background start next prevn face object))
|
||||
(t
|
||||
(put-text-property start next 'face face object)))
|
||||
(setq start next))))
|
||||
|
||||
(provide 'colir)
|
||||
|
||||
;;; colir.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,145 +0,0 @@
|
||||
;;; ivy-faces.el --- Faces for Ivy -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2020-2025 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
|
||||
;; Keywords: convenience
|
||||
|
||||
;; 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:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup ivy-faces nil
|
||||
"Font-lock faces for `ivy'."
|
||||
:group 'ivy
|
||||
:group 'faces)
|
||||
|
||||
(defface ivy-cursor
|
||||
'((((class color) (background light))
|
||||
:background "black" :foreground "white")
|
||||
(((class color) (background dark))
|
||||
:background "white" :foreground "black"))
|
||||
"Cursor face for inline completion.")
|
||||
|
||||
(defface ivy-current-match
|
||||
'((((class color) (background light))
|
||||
:background "#1a4b77" :foreground "white" :extend t)
|
||||
(((class color) (background dark))
|
||||
:background "#65a7e2" :foreground "black" :extend t))
|
||||
"Face used by Ivy for highlighting the current match.")
|
||||
|
||||
(defface ivy-minibuffer-match-highlight
|
||||
'((t :inherit highlight))
|
||||
"Face used by Ivy for highlighting the match under the cursor.")
|
||||
|
||||
(defface ivy-minibuffer-match-face-1
|
||||
'((((class color) (background light))
|
||||
:background "#d3d3d3")
|
||||
(((class color) (background dark))
|
||||
:background "#555555"))
|
||||
"The background face for `ivy' minibuffer matches.")
|
||||
|
||||
(defface ivy-minibuffer-match-face-2
|
||||
'((((class color) (background light))
|
||||
:background "#e99ce8" :weight bold)
|
||||
(((class color) (background dark))
|
||||
:background "#777777" :weight bold))
|
||||
"Face for `ivy' minibuffer matches numbered 1 modulo 3.")
|
||||
|
||||
(defface ivy-minibuffer-match-face-3
|
||||
'((((class color) (background light))
|
||||
:background "#bbbbff" :weight bold)
|
||||
(((class color) (background dark))
|
||||
:background "#7777ff" :weight bold))
|
||||
"Face for `ivy' minibuffer matches numbered 2 modulo 3.")
|
||||
|
||||
(defface ivy-minibuffer-match-face-4
|
||||
'((((class color) (background light))
|
||||
:background "#ffbbff" :weight bold)
|
||||
(((class color) (background dark))
|
||||
:background "#8a498a" :weight bold))
|
||||
"Face for `ivy' minibuffer matches numbered 3 modulo 3.")
|
||||
|
||||
(defface ivy-confirm-face
|
||||
'((t :foreground "ForestGreen" :inherit minibuffer-prompt))
|
||||
"Face used by Ivy for a confirmation prompt.")
|
||||
|
||||
(defface ivy-match-required-face
|
||||
'((t :foreground "red" :inherit minibuffer-prompt))
|
||||
"Face used by Ivy for a match required prompt.")
|
||||
|
||||
(defface ivy-subdir
|
||||
'((t :inherit dired-directory))
|
||||
"Face used by Ivy for highlighting subdirs in the alternatives.")
|
||||
|
||||
(defface ivy-org
|
||||
'((t :inherit org-level-4))
|
||||
"Face used by Ivy for highlighting Org buffers in the alternatives.")
|
||||
|
||||
(defface ivy-modified-buffer
|
||||
'((t :inherit default))
|
||||
"Face used by Ivy for highlighting modified file visiting buffers.")
|
||||
|
||||
(defface ivy-modified-outside-buffer
|
||||
'((t :inherit default))
|
||||
"Face used by Ivy for highlighting file visiting buffers modified outside Emacs.")
|
||||
|
||||
(defface ivy-remote
|
||||
'((((class color) (background light))
|
||||
:foreground "#110099")
|
||||
(((class color) (background dark))
|
||||
:foreground "#7B6BFF"))
|
||||
"Face used by Ivy for highlighting remotes in the alternatives.")
|
||||
|
||||
(defface ivy-virtual
|
||||
'((t :inherit font-lock-builtin-face))
|
||||
"Face used by Ivy for matching virtual buffer names.")
|
||||
|
||||
(defface ivy-action
|
||||
'((t :inherit font-lock-builtin-face))
|
||||
"Face used by Ivy for displaying keys in `ivy-read-action'.")
|
||||
|
||||
(defface ivy-highlight-face
|
||||
'((t :inherit highlight))
|
||||
"Face used by Ivy to highlight certain candidates.")
|
||||
|
||||
(defface ivy-prompt-match
|
||||
'((t :inherit ivy-current-match))
|
||||
"Face used by Ivy for highlighting the selected prompt line.")
|
||||
|
||||
(defface ivy-separator
|
||||
'((t :inherit font-lock-doc-face))
|
||||
"Face for multiline source separator.")
|
||||
|
||||
(defface ivy-grep-info
|
||||
'((t :inherit compilation-info))
|
||||
"Face for highlighting grep information such as file names.")
|
||||
|
||||
(defface ivy-grep-line-number
|
||||
'((t :inherit compilation-line-number))
|
||||
"Face for displaying line numbers in grep messages.")
|
||||
|
||||
(defface ivy-completions-annotations
|
||||
'((t :inherit completions-annotations))
|
||||
"Face for displaying completion annotations.")
|
||||
|
||||
(defface ivy-yanked-word
|
||||
'((t :inherit highlight))
|
||||
"Face used to highlight yanked word.")
|
||||
|
||||
(provide 'ivy-faces)
|
||||
|
||||
;;; ivy-faces.el ends here
|
||||
@@ -1,176 +0,0 @@
|
||||
;;; ivy-overlay.el --- Overlay display functions for Ivy -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2025 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
|
||||
;; Keywords: convenience
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Normally, Ivy displays completion candidates and entered text in
|
||||
;; the minibuffer. This file enables in-buffer completion to be
|
||||
;; displayed at point instead.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl-lib)
|
||||
(require 'subr-x))
|
||||
|
||||
(defvar ivy--old-cursor-type t)
|
||||
|
||||
(defvar ivy-overlay-at nil
|
||||
"Overlay variable for `ivy-display-function-overlay'.")
|
||||
|
||||
(declare-function ivy--truncate-string "ivy")
|
||||
|
||||
(defun ivy-left-pad (str width)
|
||||
"Return STR, but with each line indented by WIDTH spaces.
|
||||
Lines are truncated to the window width."
|
||||
(let ((padding (make-string width ?\s)))
|
||||
(mapconcat (lambda (x)
|
||||
(ivy--truncate-string (concat padding x)
|
||||
(1- (+ (window-width)
|
||||
(window-hscroll)))))
|
||||
(split-string str "\n")
|
||||
"\n")))
|
||||
|
||||
(defun ivy-overlay-cleanup ()
|
||||
"Clean up after `ivy-display-function-overlay'."
|
||||
(when (overlayp ivy-overlay-at)
|
||||
(delete-overlay ivy-overlay-at)
|
||||
(setq ivy-overlay-at nil))
|
||||
(unless cursor-type
|
||||
(setq cursor-type ivy--old-cursor-type))
|
||||
(when (fboundp 'company-abort)
|
||||
(company-abort)))
|
||||
|
||||
(defvar ivy-height)
|
||||
|
||||
(defun ivy-overlay-show-after (str)
|
||||
"Display STR in an overlay at point.
|
||||
|
||||
First, fill each line of STR with spaces to the current column.
|
||||
Then attach the overlay to the character before point."
|
||||
(if ivy-overlay-at
|
||||
(progn
|
||||
(move-overlay ivy-overlay-at (1- (point)) (line-end-position))
|
||||
(overlay-put ivy-overlay-at 'invisible nil))
|
||||
(let ((available-height (- (window-height) (count-lines (window-start) (point)) 1)))
|
||||
(unless (>= available-height ivy-height)
|
||||
(recenter (- (window-height) ivy-height 2))))
|
||||
(setq ivy-overlay-at (make-overlay (1- (point)) (line-end-position)))
|
||||
;; Specify face to avoid clashing with other overlays.
|
||||
(overlay-put ivy-overlay-at 'face 'default)
|
||||
(overlay-put ivy-overlay-at 'priority 9999))
|
||||
(overlay-put ivy-overlay-at 'display str)
|
||||
(overlay-put ivy-overlay-at 'after-string ""))
|
||||
|
||||
(declare-function org-current-level "org")
|
||||
(declare-function org-at-heading-p "org")
|
||||
(defvar org-indent-indentation-per-level)
|
||||
(defvar ivy-last)
|
||||
(defvar ivy-text)
|
||||
(defvar ivy-completion-beg)
|
||||
(declare-function ivy--get-window "ivy")
|
||||
(declare-function ivy-state-window "ivy" t t)
|
||||
|
||||
(defun ivy-overlay--current-column ()
|
||||
"Return `current-column', ignoring `ivy-overlay-at'.
|
||||
Temporarily make `ivy-overlay-at' invisible so that the
|
||||
`string-width' of its `display' property is not included in the
|
||||
`current-column' calculation by Emacs >= 29.
|
||||
See URL `https://bugs.gnu.org/53795'."
|
||||
(if (overlayp ivy-overlay-at)
|
||||
(cl-letf (((overlay-get ivy-overlay-at 'invisible) t))
|
||||
(1+ (current-column)))
|
||||
(current-column)))
|
||||
|
||||
(defun ivy-overlay-impossible-p (_str)
|
||||
(or
|
||||
(and (eq major-mode 'org-mode)
|
||||
;; If this breaks, an alternative is to call the canonical function
|
||||
;; `org-in-src-block-p', which is slower. Neither approach works
|
||||
;; in Org versions that shipped with Emacs < 26, however.
|
||||
(get-text-property (point) 'src-block))
|
||||
(<= (window-height) (+ ivy-height 2))
|
||||
(bobp)
|
||||
(< (- (+ (window-width) (window-hscroll))
|
||||
(ivy-overlay--current-column))
|
||||
30)))
|
||||
|
||||
(defun ivy-overlay--org-indent ()
|
||||
"Return `ivy-overlay-at' indentation due to `org-indent-mode'.
|
||||
That is, the additional number of columns needed under the mode."
|
||||
;; Emacs 28 includes the following fix for `https://bugs.gnu.org/49695':
|
||||
;;
|
||||
;; "Fix display of line/wrap-prefix when there's a display property at BOL"
|
||||
;; 662f91a795 2021-07-22 21:23:48 +0300
|
||||
;; `https://git.sv.gnu.org/cgit/emacs.git/commit/?id=662f91a795'
|
||||
;;
|
||||
;; This increasingly misindents `ivy-overlay-at' with each additional Org
|
||||
;; level. See also `https://github.com/abo-abo/swiper/commit/ee7f7f8c79'.
|
||||
;; FIXME: Is there a better way to work around this?
|
||||
(if (and (eq major-mode 'org-mode)
|
||||
(bound-and-true-p org-indent-mode)
|
||||
(< emacs-major-version 28))
|
||||
(let ((level (org-current-level)))
|
||||
(if (org-at-heading-p)
|
||||
(1- level)
|
||||
(* org-indent-indentation-per-level (or level 1))))
|
||||
0))
|
||||
|
||||
(defun ivy-display-function-overlay (str)
|
||||
"Called from the minibuffer, display STR in an overlay in Ivy window.
|
||||
Hide the minibuffer contents and cursor."
|
||||
(if (save-selected-window
|
||||
(select-window (ivy-state-window ivy-last))
|
||||
(ivy-overlay-impossible-p str))
|
||||
(let ((buffer-undo-list t))
|
||||
(save-excursion
|
||||
(forward-line 1)
|
||||
(insert str)))
|
||||
(add-face-text-property (minibuffer-prompt-end) (point-max)
|
||||
'(:foreground "white"))
|
||||
(setq cursor-type nil)
|
||||
(with-selected-window (ivy--get-window ivy-last)
|
||||
(when cursor-type
|
||||
(setq ivy--old-cursor-type cursor-type))
|
||||
(setq cursor-type nil)
|
||||
(let ((overlay-str
|
||||
(apply
|
||||
#'concat
|
||||
(buffer-substring (max (point-min) (1- (point))) (point))
|
||||
ivy-text
|
||||
(and (eolp) " ")
|
||||
(buffer-substring (point) (line-end-position))
|
||||
(and (> (length str) 0)
|
||||
(list "\n"
|
||||
(ivy-left-pad
|
||||
(string-remove-prefix "\n" str)
|
||||
(+ (ivy-overlay--org-indent)
|
||||
(save-excursion
|
||||
(when ivy-completion-beg
|
||||
(goto-char ivy-completion-beg))
|
||||
(ivy-overlay--current-column)))))))))
|
||||
(let ((cursor-offset (1+ (length ivy-text))))
|
||||
(add-face-text-property cursor-offset (1+ cursor-offset)
|
||||
'ivy-cursor t overlay-str))
|
||||
(ivy-overlay-show-after overlay-str)))))
|
||||
|
||||
(provide 'ivy-overlay)
|
||||
|
||||
;;; ivy-overlay.el ends here
|
||||
5558
.emacs.d/lisp/ivy.el
5558
.emacs.d/lisp/ivy.el
File diff suppressed because it is too large
Load Diff
672
.emacs.d/lisp/orderless.el
Normal file
672
.emacs.d/lisp/orderless.el
Normal file
@@ -0,0 +1,672 @@
|
||||
;;; orderless.el --- Completion style for matching regexps in any order -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Omar Antolín Camarena <omar@matem.unam.mx>
|
||||
;; Maintainer: Omar Antolín Camarena <omar@matem.unam.mx>, Daniel Mendler <mail@daniel-mendler.de>
|
||||
;; Keywords: matching, completion
|
||||
;; Version: 1.5
|
||||
;; URL: https://github.com/oantolin/orderless
|
||||
;; Package-Requires: ((emacs "27.1") (compat "30"))
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This package provides an `orderless' completion style that divides
|
||||
;; the pattern into components (space-separated by default), and
|
||||
;; matches candidates that match all of the components in any order.
|
||||
|
||||
;; Completion styles are used as entries in the variables
|
||||
;; `completion-styles' and `completion-category-overrides', see their
|
||||
;; documentation.
|
||||
|
||||
;; To use this completion style you can use the following minimal
|
||||
;; configuration:
|
||||
|
||||
;; (setq completion-styles '(orderless basic))
|
||||
|
||||
;; You can customize the `orderless-component-separator' to decide how
|
||||
;; the input pattern is split into component regexps. The default
|
||||
;; splits on spaces. You might want to add hyphens and slashes, for
|
||||
;; example, to ease completion of symbols and file paths,
|
||||
;; respectively.
|
||||
|
||||
;; Each component can match in any one of several matching styles:
|
||||
;; literally, as a regexp, as an initialism, in the flex style, or as
|
||||
;; word prefixes. It is easy to add new styles: they are functions
|
||||
;; from strings to strings that map a component to a regexp to match
|
||||
;; against. The variable `orderless-matching-styles' lists the
|
||||
;; matching styles to be used for components, by default it allows
|
||||
;; literal and regexp matching.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'compat)
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(defgroup orderless nil
|
||||
"Completion method that matches space-separated regexps in any order."
|
||||
:link '(info-link :tag "Info Manual" "(orderless)")
|
||||
:link '(url-link :tag "Website" "https://github.com/oantolin/orderless")
|
||||
:link '(emacs-library-link :tag "Library Source" "orderless.el")
|
||||
:group 'minibuffer)
|
||||
|
||||
(defface orderless-match-face-0
|
||||
'((default :weight bold)
|
||||
(((class color) (min-colors 88) (background dark)) :foreground "#72a4ff")
|
||||
(((class color) (min-colors 88) (background light)) :foreground "#223fbf")
|
||||
(t :foreground "blue"))
|
||||
"Face for matches of components numbered 0 mod 4.")
|
||||
|
||||
(defface orderless-match-face-1
|
||||
'((default :weight bold)
|
||||
(((class color) (min-colors 88) (background dark)) :foreground "#ed92f8")
|
||||
(((class color) (min-colors 88) (background light)) :foreground "#8f0075")
|
||||
(t :foreground "magenta"))
|
||||
"Face for matches of components numbered 1 mod 4.")
|
||||
|
||||
(defface orderless-match-face-2
|
||||
'((default :weight bold)
|
||||
(((class color) (min-colors 88) (background dark)) :foreground "#90d800")
|
||||
(((class color) (min-colors 88) (background light)) :foreground "#145a00")
|
||||
(t :foreground "green"))
|
||||
"Face for matches of components numbered 2 mod 4.")
|
||||
|
||||
(defface orderless-match-face-3
|
||||
'((default :weight bold)
|
||||
(((class color) (min-colors 88) (background dark)) :foreground "#f0ce43")
|
||||
(((class color) (min-colors 88) (background light)) :foreground "#804000")
|
||||
(t :foreground "yellow"))
|
||||
"Face for matches of components numbered 3 mod 4.")
|
||||
|
||||
(defcustom orderless-component-separator #'orderless-escapable-split-on-space
|
||||
"Component separators for orderless completion.
|
||||
This can either be a string, which is passed to `split-string',
|
||||
or a function of a single string argument."
|
||||
:type `(choice (const :tag "Spaces" " +")
|
||||
(const :tag "Spaces, hyphen or slash" " +\\|[-/]")
|
||||
(const :tag "Escapable space"
|
||||
,#'orderless-escapable-split-on-space)
|
||||
(const :tag "Quotable spaces" ,#'split-string-and-unquote)
|
||||
(regexp :tag "Custom regexp")
|
||||
(function :tag "Custom function")))
|
||||
|
||||
(defcustom orderless-match-faces
|
||||
[orderless-match-face-0
|
||||
orderless-match-face-1
|
||||
orderless-match-face-2
|
||||
orderless-match-face-3]
|
||||
"Vector of faces used (cyclically) for component matches."
|
||||
:type '(vector face))
|
||||
|
||||
(defcustom orderless-matching-styles
|
||||
(list #'orderless-literal #'orderless-regexp)
|
||||
"List of component matching styles.
|
||||
If this variable is nil, regexp matching is assumed.
|
||||
|
||||
A matching style is simply a function from strings to regexps.
|
||||
The returned regexps can be either strings or s-expressions in
|
||||
`rx' syntax. If the resulting regexp has no capturing groups,
|
||||
the entire match is highlighted, otherwise just the captured
|
||||
groups are. Several are provided with this package: try
|
||||
customizing this variable to see a list of them."
|
||||
:type '(repeat function)
|
||||
:options (list #'orderless-regexp
|
||||
#'orderless-literal
|
||||
#'orderless-initialism
|
||||
#'orderless-prefixes
|
||||
#'orderless-flex))
|
||||
|
||||
(defcustom orderless-affix-dispatch-alist
|
||||
`((?% . ,#'char-fold-to-regexp)
|
||||
(?! . ,#'orderless-not)
|
||||
(?& . ,#'orderless-annotation)
|
||||
(?, . ,#'orderless-initialism)
|
||||
(?= . ,#'orderless-literal)
|
||||
(?^ . ,#'orderless-literal-prefix)
|
||||
(?~ . ,#'orderless-flex))
|
||||
"Alist associating characters to matching styles.
|
||||
The function `orderless-affix-dispatch' uses this list to
|
||||
determine how to match a pattern component: if the component
|
||||
either starts or ends with a character used as a key in this
|
||||
alist, the character is removed from the component and the rest is
|
||||
matched according the style associated to it."
|
||||
:type `(alist
|
||||
:key-type character
|
||||
:value-type (choice
|
||||
(const :tag "Annotation" ,#'orderless-annotation)
|
||||
(const :tag "Literal" ,#'orderless-literal)
|
||||
(const :tag "Without literal" ,#'orderless-without-literal)
|
||||
(const :tag "Literal prefix" ,#'orderless-literal-prefix)
|
||||
(const :tag "Regexp" ,#'orderless-regexp)
|
||||
(const :tag "Not" ,#'orderless-not)
|
||||
(const :tag "Flex" ,#'orderless-flex)
|
||||
(const :tag "Initialism" ,#'orderless-initialism)
|
||||
(const :tag "Prefixes" ,#'orderless-prefixes)
|
||||
(const :tag "Ignore diacritics" ,#'char-fold-to-regexp)
|
||||
(function :tag "Custom matching style"))))
|
||||
|
||||
(defun orderless-affix-dispatch (component _index _total)
|
||||
"Match COMPONENT according to the styles in `orderless-affix-dispatch-alist'.
|
||||
If the COMPONENT starts or ends with one of the characters used
|
||||
as a key in `orderless-affix-dispatch-alist', then that character
|
||||
is removed and the remainder of the COMPONENT is matched in the
|
||||
style associated to the character."
|
||||
(let ((len (length component))
|
||||
(alist orderless-affix-dispatch-alist))
|
||||
(when (> len 0)
|
||||
(cond
|
||||
;; Ignore single dispatcher character
|
||||
((and (= len 1) (alist-get (aref component 0) alist)) #'ignore)
|
||||
;; Prefix
|
||||
((when-let ((style (alist-get (aref component 0) alist)))
|
||||
(cons style (substring component 1))))
|
||||
;; Suffix
|
||||
((when-let ((style (alist-get (aref component (1- len)) alist)))
|
||||
(cons style (substring component 0 -1))))))))
|
||||
|
||||
(defcustom orderless-style-dispatchers (list #'orderless-affix-dispatch)
|
||||
"List of style dispatchers.
|
||||
Style dispatchers are used to override the matching styles
|
||||
based on the actual component and its place in the list of
|
||||
components. A style dispatcher is a function that takes a string
|
||||
and two integers as arguments, it gets called with a component,
|
||||
the 0-based index of the component and the total number of
|
||||
components. It can decide what matching styles to use for the
|
||||
component and optionally replace the component with a different
|
||||
string, or it can decline to handle the component leaving it for
|
||||
future dispatchers. For details see `orderless--dispatch'.
|
||||
|
||||
For example, a style dispatcher could arrange for the first
|
||||
component to match as an initialism and subsequent components to
|
||||
match as literals. As another example, a style dispatcher could
|
||||
arrange for a component starting with `~' to match the rest of
|
||||
the component in the `orderless-flex' style. See
|
||||
`orderless-affix-dispatch' and `orderless-affix-dispatch-alist'
|
||||
for such a configuration. For more information on how this
|
||||
variable is used, see `orderless-compile'."
|
||||
:type '(repeat function))
|
||||
|
||||
(defcustom orderless-smart-case t
|
||||
"Whether to use smart case.
|
||||
If this variable is t, then case-sensitivity is decided as
|
||||
follows: if any component contains upper case letters, the
|
||||
matches are case sensitive; otherwise case-insensitive. This
|
||||
is like the behavior of `isearch' when `search-upper-case' is
|
||||
non-nil.
|
||||
|
||||
On the other hand, if this variable is nil, then case-sensitivity
|
||||
is determined by the values of `completion-ignore-case',
|
||||
`read-file-name-completion-ignore-case' and
|
||||
`read-buffer-completion-ignore-case', as usual for completion."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom orderless-expand-substring 'prefix
|
||||
"Whether to perform literal substring expansion.
|
||||
This configuration option affects the behavior of some completion
|
||||
interfaces when pressing TAB. If enabled `orderless-try-completion'
|
||||
will first attempt literal substring expansion. If disabled,
|
||||
expansion is only performed for single unique matches. For
|
||||
performance reasons only `prefix' expansion is enabled by default.
|
||||
Set the variable to `substring' for full substring expansion."
|
||||
:type '(choice (const :tag "No expansion" nil)
|
||||
(const :tag "Substring" substring)
|
||||
(const :tag "Prefix (efficient)" prefix)))
|
||||
|
||||
;;; Matching styles
|
||||
|
||||
(defun orderless-regexp (component)
|
||||
"Match COMPONENT as a regexp."
|
||||
(condition-case nil
|
||||
(progn (string-match-p component "") component)
|
||||
(invalid-regexp nil)))
|
||||
|
||||
(defun orderless-literal (component)
|
||||
"Match COMPONENT as a literal string."
|
||||
;; Do not use (literal component) here, such that `delete-dups' in
|
||||
;; `orderless--compile-component' has a chance to delete duplicates for
|
||||
;; literal input. The default configuration of `orderless-matching-styles'
|
||||
;; with `orderless-regexp' and `orderless-literal' leads to duplicates.
|
||||
(regexp-quote component))
|
||||
|
||||
(defun orderless-literal-prefix (component)
|
||||
"Match COMPONENT as a literal prefix string."
|
||||
`(seq bos (literal ,component)))
|
||||
|
||||
(defun orderless--separated-by (sep rxs &optional before after)
|
||||
"Return a regexp to match the rx-regexps RXS with SEP in between.
|
||||
If BEFORE is specified, add it to the beginning of the rx
|
||||
sequence. If AFTER is specified, add it to the end of the rx
|
||||
sequence."
|
||||
(declare (indent 1))
|
||||
`(seq
|
||||
,(or before "")
|
||||
,@(cl-loop for (sexp . more) on rxs
|
||||
collect `(group ,sexp)
|
||||
when more collect sep)
|
||||
,(or after "")))
|
||||
|
||||
(defun orderless-flex (component)
|
||||
"Match a component in flex style.
|
||||
This means the characters in COMPONENT must occur in the
|
||||
candidate in that order, but not necessarily consecutively."
|
||||
`(seq
|
||||
,@(cdr (cl-loop for char across component
|
||||
append `((zero-or-more (not ,char)) (group ,char))))))
|
||||
|
||||
(defun orderless-initialism (component)
|
||||
"Match a component as an initialism.
|
||||
This means the characters in COMPONENT must occur in the
|
||||
candidate, in that order, at the beginning of words."
|
||||
(orderless--separated-by '(zero-or-more nonl)
|
||||
(cl-loop for char across component collect `(seq word-start ,char))))
|
||||
|
||||
(defun orderless-prefixes (component)
|
||||
"Match a component as multiple word prefixes.
|
||||
The COMPONENT is split at word endings, and each piece must match
|
||||
at a word boundary in the candidate. This is similar to the
|
||||
`partial-completion' completion style."
|
||||
(orderless--separated-by '(zero-or-more nonl)
|
||||
(cl-loop for prefix in (split-string component "\\>")
|
||||
collect `(seq word-boundary ,prefix))))
|
||||
|
||||
(defun orderless-without-literal (component)
|
||||
"Match strings that do *not* contain COMPONENT as a literal match.
|
||||
You may prefer to use the more general `orderless-not' instead
|
||||
which can invert any predicate or regexp."
|
||||
`(seq
|
||||
(group string-start) ; highlight nothing!
|
||||
(zero-or-more
|
||||
(or ,@(cl-loop for i below (length component)
|
||||
collect `(seq ,(substring component 0 i)
|
||||
(or (not (any ,(aref component i)))
|
||||
string-end)))))
|
||||
string-end))
|
||||
|
||||
(defsubst orderless--match-p (pred regexp str)
|
||||
"Return t if STR matches PRED and REGEXP."
|
||||
(and str
|
||||
(or (not pred) (funcall pred str))
|
||||
(or (not regexp)
|
||||
(let ((case-fold-search completion-ignore-case))
|
||||
(string-match-p regexp str)))))
|
||||
|
||||
(defun orderless-not (pred regexp)
|
||||
"Match strings that do *not* match PRED and REGEXP."
|
||||
(lambda (str)
|
||||
(not (orderless--match-p pred regexp str))))
|
||||
|
||||
(defun orderless--metadata ()
|
||||
"Return completion metadata iff inside minibuffer."
|
||||
(when-let (((minibufferp))
|
||||
(table minibuffer-completion-table))
|
||||
;; Return non-nil metadata iff inside minibuffer
|
||||
(or (completion-metadata (buffer-substring-no-properties
|
||||
(minibuffer-prompt-end) (point))
|
||||
table minibuffer-completion-predicate)
|
||||
'((nil . nil)))))
|
||||
|
||||
(defun orderless-annotation (pred regexp)
|
||||
"Match candidates where the annotation matches PRED and REGEXP."
|
||||
(let ((md (orderless--metadata)))
|
||||
(if-let ((fun (compat-call completion-metadata-get md 'affixation-function)))
|
||||
(lambda (str)
|
||||
(cl-loop for s in (cdar (funcall fun (list str)))
|
||||
thereis (orderless--match-p pred regexp s)))
|
||||
(when-let ((fun (compat-call completion-metadata-get md 'annotation-function)))
|
||||
(lambda (str) (orderless--match-p pred regexp (funcall fun str)))))))
|
||||
|
||||
;;; Highlighting matches
|
||||
|
||||
(defun orderless--highlight (regexps ignore-case string)
|
||||
"Destructively propertize STRING to highlight a match of each of the REGEXPS.
|
||||
The search is case insensitive if IGNORE-CASE is non-nil."
|
||||
(cl-loop with case-fold-search = ignore-case
|
||||
with n = (length orderless-match-faces)
|
||||
for regexp in regexps and i from 0
|
||||
when (string-match regexp string) do
|
||||
(cl-loop
|
||||
for (x y) on (let ((m (match-data))) (or (cddr m) m)) by #'cddr
|
||||
when x do
|
||||
(add-face-text-property
|
||||
x y
|
||||
(aref orderless-match-faces (mod i n))
|
||||
nil string)))
|
||||
string)
|
||||
|
||||
(defun orderless-highlight-matches (regexps strings)
|
||||
"Highlight a match of each of the REGEXPS in each of the STRINGS.
|
||||
Warning: only use this if you know all REGEXPs match all STRINGS!
|
||||
For the user's convenience, if REGEXPS is a string, it is
|
||||
converted to a list of regexps according to the value of
|
||||
`orderless-matching-styles'."
|
||||
(when (stringp regexps)
|
||||
(setq regexps (cdr (orderless-compile regexps))))
|
||||
(cl-loop with ignore-case = (orderless--ignore-case-p regexps)
|
||||
for str in strings
|
||||
collect (orderless--highlight regexps ignore-case (substring str))))
|
||||
|
||||
;;; Compiling patterns to lists of regexps
|
||||
|
||||
(defun orderless-escapable-split-on-space (string)
|
||||
"Split STRING on spaces, which can be escaped with backslash."
|
||||
(mapcar
|
||||
(lambda (piece) (replace-regexp-in-string (string 0) " " piece))
|
||||
(split-string (replace-regexp-in-string
|
||||
"\\\\\\\\\\|\\\\ "
|
||||
(lambda (x) (if (equal x "\\ ") (string 0) x))
|
||||
string 'fixedcase 'literal)
|
||||
" +")))
|
||||
|
||||
(defun orderless--dispatch (dispatchers default string index total)
|
||||
"Run DISPATCHERS to compute matching styles for STRING.
|
||||
|
||||
A style dispatcher is a function that takes a STRING, component
|
||||
INDEX and the TOTAL number of components. It should either
|
||||
return (a) nil to indicate the dispatcher will not handle the
|
||||
string, (b) a new string to replace the current string and
|
||||
continue dispatch, or (c) the matching styles to use and, if
|
||||
needed, a new string to use in place of the current one (for
|
||||
example, a dispatcher can decide which style to use based on a
|
||||
suffix of the string and then it must also return the component
|
||||
stripped of the suffix).
|
||||
|
||||
More precisely, the return value of a style dispatcher can be of
|
||||
one of the following forms:
|
||||
|
||||
- nil (to continue dispatching)
|
||||
|
||||
- a string (to replace the component and continue dispatching),
|
||||
|
||||
- a matching style or non-empty list of matching styles to
|
||||
return,
|
||||
|
||||
- a `cons' whose `car' is either as in the previous case or
|
||||
nil (to request returning the DEFAULT matching styles), and
|
||||
whose `cdr' is a string (to replace the current one).
|
||||
|
||||
This function tries all DISPATCHERS in sequence until one returns
|
||||
a list of styles. When that happens it returns a `cons' of the
|
||||
list of styles and the possibly updated STRING. If none of the
|
||||
DISPATCHERS returns a list of styles, the return value will use
|
||||
DEFAULT as the list of styles."
|
||||
(cl-loop for dispatcher in dispatchers
|
||||
for result = (funcall dispatcher string index total)
|
||||
if (stringp result)
|
||||
do (setq string result result nil)
|
||||
else if (and (consp result) (null (car result)))
|
||||
do (setf (car result) default)
|
||||
else if (and (consp result) (stringp (cdr result)))
|
||||
do (setq string (cdr result) result (car result))
|
||||
when result return (cons result string)
|
||||
finally (return (cons default string))))
|
||||
|
||||
(defun orderless--compile-component (component index total styles dispatchers)
|
||||
"Compile COMPONENT at INDEX of TOTAL components with STYLES and DISPATCHERS."
|
||||
(cl-loop
|
||||
with pred = nil
|
||||
with (newsty . newcomp) = (orderless--dispatch dispatchers styles
|
||||
component index total)
|
||||
for style in (if (functionp newsty) (list newsty) newsty)
|
||||
for res = (condition-case nil
|
||||
(funcall style newcomp)
|
||||
(wrong-number-of-arguments
|
||||
(when-let ((res (orderless--compile-component
|
||||
newcomp index total styles dispatchers)))
|
||||
(funcall style (car res) (cdr res)))))
|
||||
if (functionp res) do (cl-callf orderless--predicate-and pred res)
|
||||
else if res collect (if (stringp res) `(regexp ,res) res) into regexps
|
||||
finally return
|
||||
(when (or pred regexps)
|
||||
(cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)) t))))))
|
||||
|
||||
(defun orderless-compile (pattern &optional styles dispatchers)
|
||||
"Build regexps to match the components of PATTERN.
|
||||
Split PATTERN on `orderless-component-separator' and compute
|
||||
matching styles for each component. For each component the style
|
||||
DISPATCHERS are run to determine the matching styles to be used;
|
||||
they are called with arguments the component, the 0-based index
|
||||
of the component and the total number of components. If the
|
||||
DISPATCHERS decline to handle the component, then the list of
|
||||
matching STYLES is used. See `orderless--dispatch' for details
|
||||
on dispatchers.
|
||||
|
||||
The STYLES default to `orderless-matching-styles', and the
|
||||
DISPATCHERS default to `orderless-dipatchers'. Since nil gets
|
||||
you the default, if you want no dispatchers to be run, use
|
||||
\\='(ignore) as the value of DISPATCHERS.
|
||||
|
||||
The return value is a pair of a predicate function and a list of
|
||||
regexps. The predicate function can also be nil. It takes a
|
||||
string as argument."
|
||||
(unless styles (setq styles orderless-matching-styles))
|
||||
(unless dispatchers (setq dispatchers orderless-style-dispatchers))
|
||||
(cl-loop
|
||||
with predicate = nil
|
||||
with temp = (if (functionp orderless-component-separator)
|
||||
(funcall orderless-component-separator pattern)
|
||||
(split-string pattern orderless-component-separator))
|
||||
with components = (if (equal (car (last temp)) "") (nbutlast temp) temp)
|
||||
with total = (length components)
|
||||
for comp in components and index from 0
|
||||
for (pred . regexp) = (orderless--compile-component
|
||||
comp index total styles dispatchers)
|
||||
when regexp collect regexp into regexps
|
||||
when pred do (cl-callf orderless--predicate-and predicate pred)
|
||||
finally return (cons predicate regexps)))
|
||||
|
||||
;;; Completion style implementation
|
||||
|
||||
(defun orderless--predicate-normalized-and (p q)
|
||||
"Combine two predicate functions P and Q with `and'.
|
||||
The first function P is a completion predicate which can receive
|
||||
up to two arguments. The second function Q always receives a
|
||||
normalized string as argument."
|
||||
(cond
|
||||
((and p q)
|
||||
(lambda (k &rest v) ;; v for hash table
|
||||
(when (if v (funcall p k (car v)) (funcall p k))
|
||||
(setq k (if (consp k) (car k) k)) ;; alist
|
||||
(funcall q (if (symbolp k) (symbol-name k) k)))))
|
||||
(q
|
||||
(lambda (k &optional _) ;; _ for hash table
|
||||
(setq k (if (consp k) (car k) k)) ;; alist
|
||||
(funcall q (if (symbolp k) (symbol-name k) k))))
|
||||
(p)))
|
||||
|
||||
(defun orderless--predicate-and (p q)
|
||||
"Combine two predicate functions P and Q with `and'."
|
||||
(or (and p q (lambda (x) (and (funcall p x) (funcall q x)))) p q))
|
||||
|
||||
(defun orderless--compile (string table pred)
|
||||
"Compile STRING to a prefix and a list of regular expressions.
|
||||
The predicate PRED is used to constrain the entries in TABLE."
|
||||
(pcase-let* ((limit (car (completion-boundaries string table pred "")))
|
||||
(prefix (substring string 0 limit))
|
||||
(pattern (substring string limit))
|
||||
(`(,fun . ,regexps) (orderless-compile pattern)))
|
||||
(list prefix regexps (orderless--ignore-case-p pattern)
|
||||
(orderless--predicate-normalized-and pred fun))))
|
||||
|
||||
;; Thanks to @jakanakaevangeli for writing a version of this function:
|
||||
;; https://github.com/oantolin/orderless/issues/79#issuecomment-916073526
|
||||
(defun orderless--literal-prefix-p (regexp)
|
||||
"Determine if REGEXP is a quoted regexp anchored at the beginning.
|
||||
If REGEXP is of the form \"\\`q\" for q = (regexp-quote u),
|
||||
then return (cons REGEXP u); else return nil."
|
||||
(when (and (string-prefix-p "\\`" regexp)
|
||||
(not (string-match-p "[$*+.?[\\^]"
|
||||
(replace-regexp-in-string
|
||||
"\\\\[$*+.?[\\^]" "" regexp
|
||||
'fixedcase 'literal nil 2))))
|
||||
(cons regexp
|
||||
(replace-regexp-in-string "\\\\\\([$*+.?[\\^]\\)" "\\1"
|
||||
regexp 'fixedcase nil nil 2))))
|
||||
|
||||
(defun orderless--ignore-case-p (regexps)
|
||||
"Return non-nil if case should be ignored for REGEXPS."
|
||||
(if orderless-smart-case
|
||||
(cl-loop for regexp in (ensure-list regexps)
|
||||
always (isearch-no-upper-case-p regexp t))
|
||||
completion-ignore-case))
|
||||
|
||||
(defun orderless--filter (prefix regexps ignore-case table pred)
|
||||
"Filter TABLE by PREFIX, REGEXPS and PRED.
|
||||
The matching should be case-insensitive if IGNORE-CASE is non-nil."
|
||||
;; If there is a regexp of the form \`quoted-regexp then
|
||||
;; remove the first such and add the unquoted form to the prefix.
|
||||
(pcase (cl-loop for r in regexps
|
||||
thereis (orderless--literal-prefix-p r))
|
||||
(`(,regexp . ,literal)
|
||||
(setq prefix (concat prefix literal)
|
||||
regexps (remove regexp regexps))))
|
||||
(let ((completion-regexp-list regexps)
|
||||
(completion-ignore-case ignore-case))
|
||||
(all-completions prefix table pred)))
|
||||
|
||||
(defun orderless-filter (string table &optional pred)
|
||||
"Split STRING into components and find entries TABLE matching all.
|
||||
The predicate PRED is used to constrain the entries in TABLE."
|
||||
(pcase-let ((`(,prefix ,regexps ,ignore-case ,pred)
|
||||
(orderless--compile string table pred)))
|
||||
(orderless--filter prefix regexps ignore-case table pred)))
|
||||
|
||||
;;;###autoload
|
||||
(defun orderless-all-completions (string table pred _point)
|
||||
"Split STRING into components and find entries TABLE matching all.
|
||||
The predicate PRED is used to constrain the entries in TABLE. The
|
||||
matching portions of each candidate are highlighted.
|
||||
This function is part of the `orderless' completion style."
|
||||
(pcase-let ((`(,prefix ,regexps ,ignore-case ,pred)
|
||||
(orderless--compile string table pred)))
|
||||
(when-let ((completions (orderless--filter prefix regexps ignore-case table pred)))
|
||||
(if completion-lazy-hilit
|
||||
(setq completion-lazy-hilit-fn
|
||||
(apply-partially #'orderless--highlight regexps ignore-case))
|
||||
(cl-loop for str in-ref completions do
|
||||
(setf str (orderless--highlight regexps ignore-case (substring str)))))
|
||||
(nconc completions (length prefix)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun orderless-try-completion (string table pred point)
|
||||
"Complete STRING to unique matching entry in TABLE.
|
||||
This uses `orderless-all-completions' to find matches for STRING
|
||||
in TABLE among entries satisfying PRED. If there is only one
|
||||
match, it completes to that match. If there are no matches, it
|
||||
returns nil. In any other case it \"completes\" STRING to
|
||||
itself, without moving POINT.
|
||||
This function is part of the `orderless' completion style."
|
||||
(or
|
||||
(pcase orderless-expand-substring
|
||||
('nil nil)
|
||||
('prefix (completion-emacs21-try-completion string table pred point))
|
||||
(_ (completion-substring-try-completion string table pred point)))
|
||||
(catch 'orderless--many
|
||||
(pcase-let ((`(,prefix ,regexps ,ignore-case ,pred)
|
||||
(orderless--compile string table pred))
|
||||
(one nil))
|
||||
;; Abuse all-completions/orderless--filter as a fast search loop.
|
||||
;; Should be almost allocation-free since our "predicate" is not
|
||||
;; called more than two times.
|
||||
(orderless--filter
|
||||
prefix regexps ignore-case table
|
||||
(orderless--predicate-normalized-and
|
||||
pred
|
||||
(lambda (arg)
|
||||
;; Check if there is more than a single match (= many).
|
||||
(when (and one (not (equal one arg)))
|
||||
(throw 'orderless--many (cons string point)))
|
||||
(setq one arg)
|
||||
t)))
|
||||
(when one
|
||||
;; Prepend prefix if the candidate does not already have the same
|
||||
;; prefix. This workaround is needed since the predicate may either
|
||||
;; receive an unprefixed or a prefixed candidate as argument. Most
|
||||
;; completion tables consistently call the predicate with unprefixed
|
||||
;; candidates, for example `completion-file-name-table'. In contrast,
|
||||
;; `completion-table-with-context' calls the predicate with prefixed
|
||||
;; candidates. This could be an unintended bug or oversight in
|
||||
;; `completion-table-with-context'.
|
||||
(unless (or (equal prefix "")
|
||||
(and (string-prefix-p prefix one)
|
||||
(test-completion one table pred)))
|
||||
(setq one (concat prefix one)))
|
||||
(or (equal string one) ;; Return t for unique exact match
|
||||
(cons one (length one))))))))
|
||||
|
||||
;;;###autoload
|
||||
(add-to-list 'completion-styles-alist
|
||||
'(orderless
|
||||
orderless-try-completion orderless-all-completions
|
||||
"Completion of multiple components, in any order."))
|
||||
|
||||
(defmacro orderless-define-completion-style
|
||||
(name &optional docstring &rest configuration)
|
||||
"Define an orderless completion style with given CONFIGURATION.
|
||||
The CONFIGURATION should be a list of bindings that you could use
|
||||
with `let' to configure orderless. You can include bindings for
|
||||
`orderless-matching-styles' and `orderless-style-dispatchers',
|
||||
for example.
|
||||
|
||||
The completion style consists of two functions that this macro
|
||||
defines for you, NAME-try-completion and NAME-all-completions.
|
||||
This macro registers those in `completion-styles-alist' as
|
||||
forming the completion style NAME.
|
||||
|
||||
The optional DOCSTRING argument is used as the documentation
|
||||
string for the completion style."
|
||||
(declare (doc-string 2) (indent 1))
|
||||
(unless (stringp docstring)
|
||||
(push docstring configuration)
|
||||
(setq docstring nil))
|
||||
(let* ((fn-name (lambda (string) (intern (concat (symbol-name name) string))))
|
||||
(try-completion (funcall fn-name "-try-completion"))
|
||||
(all-completions (funcall fn-name "-all-completions"))
|
||||
(doc-fmt "`%s' function for the %s style.
|
||||
This function delegates to `orderless-%s'.
|
||||
The orderless configuration is locally modified
|
||||
specifically for the %s style.")
|
||||
(fn-doc (lambda (fn) (format doc-fmt fn name fn name name))))
|
||||
`(progn
|
||||
(defun ,try-completion (string table pred point)
|
||||
,(funcall fn-doc "try-completion")
|
||||
(let ,configuration
|
||||
(orderless-try-completion string table pred point)))
|
||||
(defun ,all-completions (string table pred point)
|
||||
,(funcall fn-doc "all-completions")
|
||||
(let ,configuration
|
||||
(orderless-all-completions string table pred point)))
|
||||
(add-to-list 'completion-styles-alist
|
||||
'(,name ,try-completion ,all-completions ,docstring)))))
|
||||
|
||||
;;; Ivy integration
|
||||
|
||||
;;;###autoload
|
||||
(defun orderless-ivy-re-builder (str)
|
||||
"Convert STR into regexps for use with ivy.
|
||||
This function is for integration of orderless with ivy, use it as
|
||||
a value in `ivy-re-builders-alist'."
|
||||
(or (mapcar (lambda (x) (cons x t)) (cdr (orderless-compile str))) ""))
|
||||
|
||||
(defvar ivy-regex)
|
||||
(defun orderless-ivy-highlight (str)
|
||||
"Highlight a match in STR of each regexp in `ivy-regex'.
|
||||
This function is for integration of orderless with ivy."
|
||||
(orderless--highlight (mapcar #'car ivy-regex) t str) str)
|
||||
|
||||
(provide 'orderless)
|
||||
;;; orderless.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
749
.emacs.d/lisp/vertico.el
Normal file
749
.emacs.d/lisp/vertico.el
Normal file
@@ -0,0 +1,749 @@
|
||||
;;; vertico.el --- VERTical Interactive COmpletion -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Daniel Mendler <mail@daniel-mendler.de>
|
||||
;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
|
||||
;; Created: 2021
|
||||
;; Version: 2.6
|
||||
;; 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)
|
||||
(completion-show-inline-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--all-groups nil
|
||||
"List of all group titles.")
|
||||
|
||||
(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--recompute (pt content)
|
||||
"Recompute state given PT and CONTENT."
|
||||
(pcase-let* ((table minibuffer-completion-table)
|
||||
(pred minibuffer-completion-predicate)
|
||||
(before (substring content 0 pt))
|
||||
(after (substring content 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 content (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 content table pred pt vertico--metadata))
|
||||
(base (or (when-let ((z (last all))) (prog1 (cdr z) (setcdr z nil))) 0))
|
||||
(vertico--base (substring content 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 content "") (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--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 . ,(cadr groups))
|
||||
(vertico--all-groups . ,(or (caddr groups) vertico--all-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 content))
|
||||
(test-completion content 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 ((vertico--lock-groups)
|
||||
(group (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 (&optional interruptible)
|
||||
"Update state, optionally INTERRUPTIBLE."
|
||||
(let* ((pt (max 0 (- (point) (minibuffer-prompt-end))))
|
||||
(content (minibuffer-contents-no-properties))
|
||||
(input (cons content 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 content 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 content) (vertico--remote-p default-directory))))
|
||||
(vertico--recompute pt content)
|
||||
(let ((non-essential t))
|
||||
(while-no-input (vertico--recompute pt content)))))
|
||||
('nil (abort-recursive-edit))
|
||||
((and state (pred consp))
|
||||
(setq vertico--input input)
|
||||
(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)
|
||||
(if (setq vertico--lock-groups (not (eq n 0)))
|
||||
(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))))
|
||||
(setq vertico--groups nil
|
||||
vertico--all-groups nil))
|
||||
(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 (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
|
||||
@@ -39,6 +39,10 @@
|
||||
'(font-lock-type-face ((t (:foreground "#85B8DE"))))
|
||||
'(font-lock-warning-face ((t (:foreground "#FC2D07"))))
|
||||
|
||||
;; Dired
|
||||
'(dired-directory ((t (:foreground "#5FAFD7" :weight bold))))
|
||||
'(dired-symlink ((t (:foreground "#87919D"))))
|
||||
|
||||
;; Custom/widget faces
|
||||
'(custom-group-tag ((t (:underline t :foreground "lightblue"))))
|
||||
'(custom-variable-tag ((t (:underline t :foreground "lightblue"))))
|
||||
|
||||
@@ -87,14 +87,12 @@
|
||||
'(flyspell-incorrect ((t (:underline (:style wave :color "#772222")))))
|
||||
'(flyspell-duplicate ((t (:underline (:style wave :color "#986032")))))
|
||||
|
||||
;; Ivy
|
||||
'(ivy-current-match ((t (:background "#1C4449" :foreground "#BFC9DB"))))
|
||||
'(ivy-minibuffer-match-face-1 ((t (:foreground "#599999"))))
|
||||
'(ivy-minibuffer-match-face-2 ((t (:foreground "#26B2B2" :weight bold))))
|
||||
'(ivy-minibuffer-match-face-3 ((t (:foreground "#E0AD82" :weight bold))))
|
||||
'(ivy-minibuffer-match-face-4 ((t (:foreground "#D699B5" :weight bold))))
|
||||
'(ivy-confirm-face ((t (:foreground "#227722"))))
|
||||
'(ivy-match-required-face ((t (:foreground "#772222"))))
|
||||
;; Vertico
|
||||
'(vertico-current ((t (:background "#1C4449" :foreground "#BFC9DB"))))
|
||||
'(vertico-group-title ((t (:foreground "#599999"))))
|
||||
'(vertico-group-separator ((t (:foreground "#3A4255"))))
|
||||
'(completions-common-part ((t (:foreground "#26B2B2"))))
|
||||
'(completions-first-difference ((t (:foreground "#E0AD82" :weight bold))))
|
||||
|
||||
;; Dired
|
||||
'(dired-directory ((t (:foreground "#82AAA3"))))
|
||||
|
||||
@@ -86,14 +86,12 @@
|
||||
'(flyspell-incorrect ((t (:underline (:style wave :color "#ff6f6f")))))
|
||||
'(flyspell-duplicate ((t (:underline (:style wave :color "#d09950")))))
|
||||
|
||||
;; Ivy
|
||||
'(ivy-current-match ((t (:background "#503240" :foreground "#efd5c5"))))
|
||||
'(ivy-minibuffer-match-face-1 ((t (:foreground "#8fcfd0"))))
|
||||
'(ivy-minibuffer-match-face-2 ((t (:foreground "#ff9f0a" :weight bold))))
|
||||
'(ivy-minibuffer-match-face-3 ((t (:foreground "#ffaacf" :weight bold))))
|
||||
'(ivy-minibuffer-match-face-4 ((t (:foreground "#d0b0ff" :weight bold))))
|
||||
'(ivy-confirm-face ((t (:foreground "#51b04f"))))
|
||||
'(ivy-match-required-face ((t (:foreground "#ff6f6f"))))
|
||||
;; Vertico
|
||||
'(vertico-current ((t (:background "#503240" :foreground "#efd5c5"))))
|
||||
'(vertico-group-title ((t (:foreground "#8fcfd0"))))
|
||||
'(vertico-group-separator ((t (:foreground "#635850"))))
|
||||
'(completions-common-part ((t (:foreground "#ff9f0a"))))
|
||||
'(completions-first-difference ((t (:foreground "#ffaacf" :weight bold))))
|
||||
|
||||
;; Dired
|
||||
'(dired-directory ((t (:foreground "#57b0ff"))))
|
||||
|
||||
Reference in New Issue
Block a user