diff options
Diffstat (limited to '.config/emacs/lisp/minadstack/corfu.el')
| -rw-r--r-- | .config/emacs/lisp/minadstack/corfu.el | 1444 |
1 files changed, 1444 insertions, 0 deletions
diff --git a/.config/emacs/lisp/minadstack/corfu.el b/.config/emacs/lisp/minadstack/corfu.el new file mode 100644 index 0000000..bd3b314 --- /dev/null +++ b/.config/emacs/lisp/minadstack/corfu.el @@ -0,0 +1,1444 @@ +;;; corfu.el --- COmpletion in Region FUnction -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2026 Free Software Foundation, Inc. + +;; Author: Daniel Mendler <mail@daniel-mendler.de> +;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> +;; Created: 2021 +;; Version: 2.10 +;; Package-Requires: ((emacs "29.1") (compat "31")) +;; URL: https://github.com/minad/corfu +;; Keywords: abbrev, convenience, matching, completion, text + +;; 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: + +;; Corfu enhances in-buffer completion with a small completion popup. +;; The current candidates are shown in a popup below or above the +;; point. The candidates can be selected by moving up and down. +;; Corfu is the minimalistic in-buffer completion counterpart of the +;; Vertico minibuffer UI. + +;;; Code: + +(require 'compat) +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) + +(defgroup corfu nil + "COmpletion in Region FUnction." + :link '(info-link :tag "Info Manual" "(corfu)") + :link '(url-link :tag "Website" "https://github.com/minad/corfu") + :link '(url-link :tag "Wiki" "https://github.com/minad/corfu/wiki") + :link '(emacs-library-link :tag "Library Source" "corfu.el") + :group 'convenience + :group 'tools + :group 'matching + :prefix "corfu-") + +(defcustom corfu-count 10 + "Maximal number of candidates to show." + :type 'natnum) + +(defcustom corfu-scroll-margin 2 + "Number of lines at the top and bottom when scrolling. +The value should lie between 0 and corfu-count/2." + :type 'natnum) + +(defcustom corfu-min-width 15 + "Popup minimum width in characters." + :type 'natnum) + +(defcustom corfu-max-width 100 + "Popup maximum width in characters." + :type 'natnum) + +(defcustom corfu-cycle nil + "Enable cycling for `corfu-next' and `corfu-previous'." + :type 'boolean) + +(defcustom corfu-on-exact-match nil + "Configure how a single exact match should be handled. +- nil: No special handling, continue completion. +- insert: Insert candidate, quit and call the `:exit-function'. +- quit: Quit completion without further action. +- show: Initiate completion even for a single match only." + :type '(choice (const insert) (const show) (const quit) (const nil))) + +(defcustom corfu-continue-commands + '(ignore universal-argument universal-argument-more digit-argument + "\\`corfu-" "\\`scroll-other-window") + "Continue Corfu completion after executing these commands. +The list can contain either command symbols or regular expressions." + :type '(repeat (choice regexp symbol))) + +(defcustom corfu-preview-current 'insert + "Preview currently selected candidate. +If the variable has the value `insert', the candidate is automatically +inserted on further input." + :type '(choice boolean (const insert))) + +(defcustom corfu-preselect 'valid + "Configure if the prompt or first candidate is preselected. +- prompt: Always select the prompt. +- first: Always select the first candidate. +- valid: Only select the prompt if valid and not equal to the first candidate. +- directory: Like first, but select the prompt if it is a directory." + :type '(choice (const prompt) (const valid) (const first) (const directory))) + +(defcustom corfu-separator ?\s + "Component separator character. +The character used for separating components in the input. The presence +of this separator character will inhibit quitting at completion +boundaries, so that any further characters can be entered. To enter the +first separator character, call `corfu-insert-separator' (bound to M-SPC +by default). Useful for multi-component completion styles such as +Orderless." + :type 'character) + +(defcustom corfu-quit-at-boundary 'separator + "Automatically quit at completion boundary. +nil: Never quit at completion boundary. +t: Always quit at completion boundary. +separator: Quit at boundary if no `corfu-separator' has been inserted." + :type '(choice boolean (const separator))) + +(defcustom corfu-quit-no-match 'separator + "Automatically quit if no matching candidate is found. +When staying alive even if there is no match a warning message is +shown in the popup. +nil: Stay alive even if there is no match. +t: Quit if there is no match. +separator: Only stay alive if there is no match and +`corfu-separator' has been inserted." + :type '(choice boolean (const separator))) + +(defcustom corfu-left-margin-width 0.5 + "Width of the left margin in units of the character width." + :type 'float) + +(defcustom corfu-right-margin-width 0.5 + "Width of the right margin in units of the character width." + :type 'float) + +(defcustom corfu-bar-width 0.2 + "Width of the bar in units of the character width." + :type 'float) + +(defcustom corfu-border-width 1 + "Width of the border in pixels, only applies to GUI Emacs." + :type 'natnum) + +(defcustom corfu-margin-formatters nil + "Registry for margin formatter functions. +Each function of the list is called with the completion metadata as +argument until an appropriate formatter is found. The function should +return a formatter function, which takes the candidate string and must +return a string, possibly an icon. In order to preserve correct popup +alignment, the length and display width of the returned string must +precisely span the same number of characters of the fixed-width popup +font. For example the kind-icon package returns a string of length 3 +with a display width of 3 characters." + :type 'hook) + +(defcustom corfu-sort-function #'corfu-sort-length-alpha + "Default sorting function. +This function is used if the completion table does not specify a +`display-sort-function'." + :type `(choice + (const :tag "No sorting" nil) + (const :tag "By length and alpha" ,#'corfu-sort-length-alpha) + (function :tag "Custom function"))) + +(defcustom corfu-sort-override-function nil + "Override sort function which overrides the `display-sort-function'. +This function is used even if a completion table specifies its +own sort function." + :type '(choice (const nil) function)) + +(defcustom corfu-auto nil + "Enable auto completion. +Auto completion is disabled by default for safety and unobtrusiveness. +Note that auto completion is particularly dangerous in untrusted files +since some completion functions may perform arbitrary code execution, +notably the Emacs built-in `elisp-completion-at-point'. See also the +settings `corfu-auto-delay', `corfu-auto-prefix' and +`corfu-auto-commands'." + :type 'boolean) + +(defgroup corfu-faces nil + "Faces used by Corfu." + :group 'corfu + :group 'faces) + +(defface corfu-default + '((((class color) (min-colors 88) (background dark)) :background "#191a1b") + (((class color) (min-colors 88) (background light)) :background "#f0f0f0") + (((background dark)) :background "gray" :foreground "black") + (t :background "gray")) + "Default face, foreground and background colors used for the popup.") + +(defface corfu-current + '((((class color) (min-colors 88) (background dark)) + :background "#00415e" :foreground "white" :extend t) + (((class color) (min-colors 88) (background light)) + :background "#c0efff" :foreground "black" :extend t) + (t :background "magenta" :foreground "white" :extend t)) + "Face used to highlight the currently selected candidate.") + +(defface corfu-bar + '((((class color) (min-colors 88) (background dark)) :background "#a8a8a8") + (((class color) (min-colors 88) (background light)) :background "#505050") + (t :background "black")) + "The background color is used for the scrollbar indicator.") + +(defface corfu-border + '((((class color) (min-colors 88) (background dark)) :background "#323232") + (((class color) (min-colors 88) (background light)) :background "#d7d7d7") + (t :background "gray")) + "The background color used for the thin border.") + +(defface corfu-annotations + '((t :inherit completions-annotations)) + "Face used for annotations.") + +(defface corfu-deprecated + '((t :inherit shadow :strike-through t)) + "Face used for deprecated candidates.") + +(defvar-keymap corfu-mode-map + :doc "Keymap used when `corfu-mode' is active.") + +(defvar-keymap corfu-map + :doc "Keymap used when popup is shown." + "<remap> <move-beginning-of-line>" #'corfu-prompt-beginning + "<remap> <move-end-of-line>" #'corfu-prompt-end + "<remap> <beginning-of-buffer>" #'corfu-first + "<remap> <end-of-buffer>" #'corfu-last + "<remap> <scroll-down-command>" #'corfu-scroll-down + "<remap> <scroll-up-command>" #'corfu-scroll-up + "<remap> <next-line>" #'corfu-next + "<remap> <previous-line>" #'corfu-previous + "<remap> <completion-at-point>" #'corfu-complete + "<remap> <keyboard-escape-quit>" #'corfu-reset + "<down>" #'corfu-next + "<up>" #'corfu-previous + "M-n" #'corfu-next + "M-p" #'corfu-previous + "C-g" #'corfu-quit + "RET" #'corfu-insert + "TAB" #'corfu-complete + "M-TAB" #'corfu-expand + "M-g" 'corfu-info-location + "M-h" 'corfu-info-documentation + "M-SPC" #'corfu-insert-separator) + +(defvar corfu--candidates nil + "List of candidates.") + +(defvar corfu--metadata nil + "Completion metadata.") + +(defvar corfu--base "" + "Base string, which is concatenated with the candidate.") + +(defvar corfu--total 0 + "Length of the candidate list `corfu--candidates'.") + +(defvar corfu--hilit #'identity + "Lazy candidate highlighting function.") + +(defvar corfu--index -1 + "Index of current candidate or negative for prompt selection.") + +(defvar corfu--preselect -1 + "Index of preselected candidate, negative for prompt selection.") + +(defvar corfu--scroll 0 + "Scroll position.") + +(defvar corfu--input nil + "Cons of last prompt contents and point.") + +(defvar corfu--preview-ov nil + "Current candidate overlay.") + +(defvar corfu--change-group nil + "Undo change group.") + +(defvar corfu--frame nil + "Popup frame.") + +(defvar corfu--width 0 + "Popup width of current completion to reduce width fluctuations.") + +(defconst corfu--initial-state + (mapcar + (lambda (k) (cons k (symbol-value k))) + '(corfu--base + corfu--candidates + corfu--hilit + corfu--index + corfu--preselect + corfu--scroll + corfu--input + corfu--total + corfu--preview-ov + corfu--change-group + corfu--metadata + corfu--width)) + "Initial Corfu state.") + +(defvar corfu--frame-parameters + '((no-accept-focus . t) + (no-focus-on-map . t) + (min-width . t) + (min-height . t) + (border-width . 0) + (outer-border-width . 0) + (vertical-scroll-bars . nil) + (horizontal-scroll-bars . nil) + (menu-bar-lines . 0) + (tool-bar-lines . 0) + (tab-bar-lines . 0) + (tab-bar-lines-keep-state . t) + (no-other-frame . t) + (unsplittable . t) + (undecorated . t) + (fullscreen . nil) + (cursor-type . nil) + (no-special-glyphs . t) + (desktop-dont-save . t) + (inhibit-double-buffering . t)) ;; Avoid display artifacts on X/Gtk builds + "Default child frame parameters. +It is recommended to avoid changing these parameters.") + +(defvar corfu--buffer-parameters + '((mode-line-format . nil) + (header-line-format . nil) + (tab-line-format . nil) + (tab-bar-format . nil) + (frame-title-format . "") + (truncate-lines . t) + (cursor-in-non-selected-windows . nil) + (cursor-type . nil) + (show-trailing-whitespace . nil) + (display-line-numbers . nil) + (left-fringe-width . 0) + (right-fringe-width . 0) + (left-margin-width . 0) + (right-margin-width . 0) + (fringes-outside-margins . 0) + (fringe-indicator-alist (continuation) (truncation)) + (indicate-empty-lines . nil) + (indicate-buffer-boundaries . nil) + (buffer-read-only . t) + (pixel-scroll-precision-mode . nil)) + "Default child frame buffer parameters. +It is recommended to avoid changing these parameters.") + +(defvar corfu--mouse-ignore-map + (let ((map (define-keymap "<touchscreen-begin>" #'ignore))) + (dotimes (i 7) + (dolist (k '(mouse down-mouse drag-mouse double-mouse triple-mouse)) + (keymap-set map (format "<%s-%s>" k (1+ i)) #'ignore))) + map) + "Ignore all mouse clicks.") + +(defun corfu--replace (beg end str) + "Replace range between BEG and END with STR." + (unless (equal str (buffer-substring-no-properties beg end)) + (completion--replace beg end str))) + +(defun corfu--capf-wrapper (fun &optional prefix) + "Wrapper for `completion-at-point' FUN. +The wrapper determines if the Capf is applicable at the current +position, performs sanity checking on the returned result and computes +the initial completion state. PREFIX is the minimum prefix length." + (pcase (funcall fun) + (`(,beg ,end ,table . ,plist) + (and (integer-or-marker-p beg) ;; Valid Capf result + (<= beg (point) end) ;; Sanity checking + ;; Check minimal prefix length if given. + (or (not prefix) + (let ((len (or (plist-get plist :company-prefix-length) + (- (point) beg)))) + (or (eq len t) (>= len prefix)))) + (let* ((str (buffer-substring-no-properties beg end)) + (pt (- (point) beg)) + (pred (plist-get plist :predicate)) + (state (corfu--compute (cons str pt) table pred))) + (cond ((alist-get 'corfu--candidates state) + `(,fun ,beg ,end ,table :corfu--state ,state ,@plist)) + ;; Stop with empty result for exclusive Capf. + ((not (eq 'no (plist-get plist :exclusive))) + '(nil)))))))) + +(defun corfu--make-buffer (name) + "Create buffer with NAME." + (let ((fr face-remapping-alist) + (ls line-spacing) + (buffer (get-buffer-create name))) + (with-current-buffer buffer + ;;; XXX HACK install mouse ignore map + (use-local-map corfu--mouse-ignore-map) + (dolist (var corfu--buffer-parameters) + (set-local (car var) (cdr var))) + (setq-local face-remapping-alist (copy-tree fr) + line-spacing ls) + (cl-pushnew 'corfu-default (alist-get 'default face-remapping-alist)) + buffer))) + +(defvar corfu--gtk-resize-child-frames + (let ((case-fold-search t)) + ;; XXX HACK to fix resizing on gtk3/gnome taken from posframe.el + ;; More information: + ;; * https://github.com/minad/corfu/issues/17 + ;; * https://gitlab.gnome.org/GNOME/mutter/-/issues/840 + ;; * https://lists.gnu.org/archive/html/emacs-devel/2020-02/msg00001.html + (and (string-match-p "gtk3" system-configuration-features) + (string-match-p "gnome\\|cinnamon" + (or (getenv "XDG_CURRENT_DESKTOP") + (getenv "DESKTOP_SESSION") "")) + 'resize-mode))) + +;; Not present on non-gtk/non-x builds +(defvar x-gtk-resize-child-frames) +(defvar x-fast-protocol-requests) + +;; Function adapted from posframe.el by tumashu +(defun corfu--make-frame (frame x y width height) + "Show current buffer in child frame at X/Y with WIDTH/HEIGHT. +FRAME is the existing frame." + (when-let* (((frame-live-p frame)) + (timer (frame-parameter frame 'corfu--hide-timer))) + (cancel-timer timer) + (set-frame-parameter frame 'corfu--hide-timer nil)) + (let* ((window-min-height 1) + (window-min-width 1) + (inhibit-redisplay t) + (x-fast-protocol-requests t) + (x-gtk-resize-child-frames corfu--gtk-resize-child-frames) + (before-make-frame-hook) + (after-make-frame-functions) + (parent (window-frame)) + (graphic (display-graphic-p parent)) + (params `((background-color + . ,(face-attribute 'corfu-default :background nil 'default)) + (font . ,(frame-parameter parent 'font)) + (right-fringe . ,right-fringe-width) + (left-fringe . ,left-fringe-width) + (internal-border-width . ,corfu-border-width) + (child-frame-border-width . ,corfu-border-width) + ,@corfu--frame-parameters))) + (unless (and (frame-live-p frame) + (eq (frame-parent frame) + (and (not (and graphic (bound-and-true-p exwm--connection))) + parent)) + ;; Handle mixed tty/graphical sessions + (eq graphic (display-graphic-p frame)) + ;; If there is more than one window, `frame-root-window' may + ;; return nil. Recreate the frame in this case. + (window-live-p (frame-root-window frame))) + (when frame (delete-frame frame)) + (setq frame (make-frame + `((name . ,(if graphic "EmacsCorfuGUI" "EmacsCorfuTTY")) + (parent-frame . ,parent) + (minibuffer . ,(minibuffer-window parent)) + (width . 0) (height . 0) (visibility . nil) + ,@params)))) + ;; XXX HACK Setting the same frame-parameter/face-background is not a nop. + ;; Check before applying the setting. Without the check, the frame flickers + ;; on Mac. We have to apply the face background before adjusting the frame + ;; parameter, otherwise the border is not updated. + (let ((new (face-attribute 'corfu-border :background nil 'default))) + (unless (equal (face-attribute 'internal-border :background frame 'default) new) + (set-face-background 'internal-border new frame)) + ;; XXX The Emacs Mac Port does not support `internal-border', we also have + ;; to set `child-frame-border'. + (unless (equal (face-attribute 'child-frame-border :background frame 'default) new) + (set-face-background 'child-frame-border new frame))) + ;; Reset frame parameters if they changed. For example `tool-bar-mode' + ;; overrides the parameter `tool-bar-lines' for every frame, including child + ;; frames. The child frame API is a pleasure to work with. It is full of + ;; lovely surprises. + (let* ((win (frame-root-window frame)) + (is (frame-parameters frame)) + (diff (cl-loop for p in params for (k . v) = p + unless (equal (alist-get k is) v) collect p))) + (when diff (modify-frame-parameters frame diff)) + ;; XXX HACK: `set-window-buffer' must be called to force fringe update. + (when (or diff (not (eq (window-buffer win) (current-buffer)))) + (set-window-buffer win (current-buffer))) + ;; Disallow selection of root window (gh:minad/corfu#63) + (set-window-parameter win 'no-delete-other-windows t) + (set-window-parameter win 'no-other-window t) + ;; Mark window as dedicated to prevent frame reuse (gh:minad/corfu#60) + (set-window-dedicated-p win t)) + (redirect-frame-focus frame parent) + (pcase-let* ((`(,ox ,oy ,right ,bottom) (frame-edges frame 'outer-edges)) + (border (* 2 corfu-border-width)) + (ow (- (- right ox) left-fringe-width right-fringe-width border)) + (oh (- (- bottom oy) border)) + (pos-change (or (/= x ox) (/= y oy))) + (size-change (or (/= ow width) (/= oh height)))) + (cond + ((and pos-change size-change) + ;; TODO: New Emacs 31 function for faster resizing/movement in one go. + ;; Add this function to Compat 31 as backport. + (static-if (fboundp 'set-frame-size-and-position-pixelwise) + (set-frame-size-and-position-pixelwise frame width height x y) + (set-frame-size frame width height t) + (set-frame-position frame x y))) + (pos-change (set-frame-position frame x y)) + (size-change (set-frame-size frame width height t))))) + (make-frame-visible frame) + ;; Unparent child frame if EXWM is used, otherwise EXWM buffers are drawn on + ;; top of the Corfu child frame. + (when (and (bound-and-true-p exwm--connection) + (display-graphic-p frame) (frame-parent frame)) + (redisplay t) + (set-frame-parameter frame 'parent-frame nil)) + frame) + +(defun corfu--hide-frame-deferred (frame) + "Deferred hiding of child FRAME." + (when (and (frame-live-p frame) (frame-visible-p frame)) + (set-frame-parameter frame 'corfu--hide-timer nil) + (make-frame-invisible frame) + (with-current-buffer (window-buffer (frame-root-window frame)) + (with-silent-modifications + (delete-region (point-min) (point-max)))))) + +(defun corfu--hide-frame (frame) + "Hide child FRAME." + (when (and (frame-live-p frame) (frame-visible-p frame)) + (cond + ((not (display-graphic-p frame)) + (corfu--hide-frame-deferred frame)) + ((not (frame-parameter frame 'corfu--hide-timer)) + (set-frame-parameter + frame 'corfu--hide-timer + (run-at-time 0 nil #'corfu--hide-frame-deferred frame)))))) + +(defun corfu--move-to-front (elem list) + "Move all ELEM (also duplicates) to front of LIST." + (if (member elem list) + (nconc (cl-loop for x in list if (equal x elem) collect x) + (delete elem list)) + list)) + +(defun corfu--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 corfu--try-completion (str table pred pt &optional md) + "Complete STR given TABLE, predicate PRED, point PT and optional metadata MD." + (setq md (or md (completion-metadata (substring str 0 pt) table pred))) + (completion-try-completion str table pred pt md)) + +(defsubst corfu--length-string< (x y) + "Sorting predicate which compares X and Y first by length then by `string<'." + (or (< (length x) (length y)) (and (= (length x) (length y)) (string< x y)))) + +(defmacro corfu--partition! (list form) + "Evaluate FORM for every element and partition LIST." + (cl-with-gensyms (head1 head2 tail1 tail2) + `(let* ((,head1 (cons nil nil)) + (,head2 (cons nil nil)) + (,tail1 ,head1) + (,tail2 ,head2)) + (while ,list + (if (let ((it (car ,list))) ,form) + (progn + (setcdr ,tail1 ,list) + (pop ,tail1)) + (setcdr ,tail2 ,list) + (pop ,tail2)) + (pop ,list)) + (setcdr ,tail1 (cdr ,head2)) + (setcdr ,tail2 nil) + (setq ,list (cdr ,head1))))) + +(defun corfu--move-prefix-candidates-to-front (field cands) + "Move CANDS which match prefix of FIELD to the beginning." + (let* ((word (substring field 0 + (seq-position field corfu-separator))) + (len (length word))) + (corfu--partition! + cands + (and (>= (length it) len) + (eq t (compare-strings word 0 len it 0 len + completion-ignore-case)))))) + +(defun corfu--delete-dups (list) + "Delete `equal-including-properties' consecutive duplicates from LIST." + (let ((beg list)) + (while (cdr beg) + (let ((end (cdr beg))) + (while (equal (car beg) (car end)) (pop end)) + ;; The deduplication is quadratic in the number of duplicates. We could + ;; avoid this via a hash table taking properties into account. + (while (not (eq beg end)) + (let ((dup beg)) + (while (not (eq (cdr dup) end)) + (if (equal-including-properties (car beg) (cadr dup)) + (setcdr dup (cddr dup)) + (pop dup)))) + (pop beg))))) + list) + +(defun corfu--sort-function () + "Return the sorting function." + (or corfu-sort-override-function + (corfu--metadata-get 'display-sort-function) + corfu-sort-function)) + +(defun corfu--compute (input table pred) + "Compute state from INPUT, TABLE and PRED." + (pcase-let* ((`(,str . ,pt) input) + (before (substring str 0 pt)) + (after (substring str pt)) + (corfu--metadata (completion-metadata before table pred)) + ;; bug#47678: `completion-boundaries' fails for `partial-completion' + ;; if the cursor is moved before the slashes of "~//". + ;; See also vertico.el which has the same issue. + (bounds (condition-case nil + (completion-boundaries before table pred after) + (t (cons 0 (length after))))) + (field (substring str (car bounds) (+ pt (cdr bounds)))) + (completing-file (eq (corfu--metadata-get 'category) 'file)) + (`(,all . ,hl) (corfu--filter-completions str table pred pt corfu--metadata)) + (base (or (when-let* ((z (last all))) (prog1 (cdr z) (setcdr z nil))) 0)) + (corfu--base (substring str 0 base)) + (pre nil)) + ;; Filter the ignored file extensions. We cannot use modified predicate for + ;; this filtering, since this breaks the special casing in the + ;; `completion-file-name-table' for `file-exists-p' and `file-directory-p'. + (when completing-file (setq all (completion-pcm--filename-try-filter all))) + ;; Sort using the `display-sort-function' or the Corfu sort functions, and + ;; delete duplicates with respect to `equal-including-properties'. This is + ;; a deviation from the Vertico completion UI with more aggressive + ;; deduplication, where candidates are compared with `equal'. Corfu + ;; preserves candidates which differ in their text properties. Corfu tries + ;; to preserve text properties as much as possible, when calling the + ;; `:exit-function' to help Capfs with candidate disambiguation. This + ;; matters in particular for Lsp backends, which produce duplicates for + ;; overloaded methods. + (setq all (funcall (or (corfu--sort-function) #'identity) all) + all (corfu--move-prefix-candidates-to-front field all)) + (when (and completing-file (not (string-suffix-p "/" field))) + (setq all (corfu--move-to-front (concat field "/") all))) + (setq all (corfu--delete-dups (corfu--move-to-front field all)) + pre (if (or (eq corfu-preselect 'prompt) (not all) + (and completing-file (eq corfu-preselect 'directory) + (= (length corfu--base) (length str)) + (test-completion str table pred)) + (and (eq corfu-preselect 'valid) + (not (equal field (car all))) + (not (and completing-file (equal (concat field "/") (car all)))) + (test-completion str table pred))) + -1 0)) + `((corfu--input . ,input) + (corfu--base . ,corfu--base) + (corfu--metadata . ,corfu--metadata) + (corfu--candidates . ,all) + (corfu--total . ,(length all)) + (corfu--hilit . ,(or hl #'identity)) + (corfu--preselect . ,pre) + (corfu--index . ,(or (and (>= corfu--index 0) (/= corfu--index corfu--preselect) + (seq-position all (nth corfu--index corfu--candidates))) + pre))))) + +(defun corfu--update (&optional interruptible) + "Update state, optionally INTERRUPTIBLE." + (pcase-let* ((`(,beg ,end ,table ,pred . ,_) completion-in-region--data) + (pt (- (point) beg)) + (str (buffer-substring-no-properties beg end)) + (input (cons str pt))) + (unless (equal corfu--input input) + ;; Redisplay such that the input is immediately shown before the expensive + ;; candidate recomputation (gh:minad/corfu#48). See also corresponding + ;; issue gh:minad/vertico#89. + (when interruptible (redisplay)) + ;; Bind non-essential=t to prevent Tramp from opening new connections, + ;; without the user explicitly requesting it via M-TAB. + (pcase (let ((non-essential t)) + (if interruptible + (while-no-input (corfu--compute input table pred)) + (corfu--compute input table pred))) + ('nil (keyboard-quit)) + ((and state (pred consp)) + (dolist (s state) (set (car s) (cdr s)))))) + input)) + +(defun corfu--match-symbol-p (pattern sym) + "Return non-nil if SYM is matching an element of the PATTERN list." + (cl-loop with case-fold-search = nil + for x in (and (symbolp sym) pattern) + thereis (if (symbolp x) + (eq sym x) + (string-match-p x (symbol-name sym))))) + +(defun corfu--metadata-get (prop) + "Return PROP from completion metadata." + ;; Marginalia and various icon packages advise `completion-metadata-get' to + ;; inject their annotations, but are meant only for minibuffer completion. + ;; Therefore call `completion-metadata-get' without advices here. + (let ((completion-extra-properties (nth 4 completion-in-region--data))) + (funcall (advice--cd*r (symbol-function (compat-function completion-metadata-get))) + corfu--metadata prop))) + +(defun corfu--format-candidates (cands) + "Format annotated CANDS." + (cl-loop for c in cands do + (cl-loop for s in-ref c do + (setf s (replace-regexp-in-string "[ \t]*\n[ \t]*" " " s)))) + (let* ((cw (cl-loop for x in cands maximize (string-width (car x)))) + (pw (cl-loop for x in cands maximize (string-width (cadr x)))) + (sw (cl-loop for x in cands maximize (string-width (caddr x)))) + (width (min (max corfu--width corfu-min-width (+ pw cw sw)) + ;; -4 because of margins and some additional safety + corfu-max-width (- (frame-width) 4))) + (trunc (not (display-graphic-p)))) + (setq corfu--width width) + (list pw width + (cl-loop + for (cand prefix suffix) in cands collect + (let ((s (concat + prefix (make-string (- pw (string-width prefix)) ?\s) cand + (when (> sw 0) + (make-string (max 0 (- width pw (string-width cand) + (string-width suffix))) + ?\s)) + suffix))) + (if trunc (truncate-string-to-width s width) s)))))) + +(defun corfu--compute-scroll () + "Compute new scroll position." + (let ((off (max (min corfu-scroll-margin (/ corfu-count 2)) 0)) + (corr (if (= corfu-scroll-margin (/ corfu-count 2)) (1- (mod corfu-count 2)) 0))) + (setq corfu--scroll (min (max 0 (- corfu--total corfu-count)) + (max 0 (+ corfu--index off 1 (- corfu-count)) + (min (- corfu--index off corr) corfu--scroll)))))) + +(defun corfu--candidates-popup (pos) + "Show candidates popup at POS." + (corfu--compute-scroll) + (pcase-let* ((last (min (+ corfu--scroll corfu-count) corfu--total)) + (bar (ceiling (* corfu-count corfu-count) corfu--total)) + (lo (min (- corfu-count bar 1) (floor (* corfu-count corfu--scroll) corfu--total))) + (`(,mf . ,acands) + (corfu--affixate + (cl-loop + repeat corfu-count for c in (nthcdr corfu--scroll corfu--candidates) + collect (funcall corfu--hilit + ;; bug#77754: Highlight unquoted string. + (substring (or (get-text-property + 0 'completion--unquoted c) c)))))) + (`(,pw ,width ,fcands) (corfu--format-candidates acands)) + ;; Disable the left margin if a margin formatter is active. + (corfu-left-margin-width (if mf 0 corfu-left-margin-width))) + ;; Nonlinearity at the end and the beginning + (when (/= corfu--scroll 0) + (setq lo (max 1 lo))) + (when (/= last corfu--total) + (setq lo (min (- corfu-count bar 2) lo))) + (corfu--popup-show pos pw width fcands (- corfu--index corfu--scroll) + (and (> corfu--total corfu-count) lo) bar))) + +(defun corfu--range-valid-p () + "Check the completion range, return non-nil if valid." + (pcase-let ((buf (current-buffer)) + (pt (point)) + (`(,beg ,end . ,_) completion-in-region--data)) + (and beg end + (eq buf (marker-buffer end)) (eq buf (window-buffer)) + (<= beg pt end) + (save-excursion (goto-char beg) (<= (pos-bol) pt (pos-eol)))))) + +(defun corfu--continue-p () + "Check if completion should continue after a command. +Corfu bails out if the current buffer changed unexpectedly or if +point moved out of range, see `corfu--range-valid-p'. Also the +input must satisfy the `completion-in-region-mode--predicate' and +the last command must be listed in `corfu-continue-commands'." + (and (corfu--range-valid-p) + ;; We keep Corfu alive if a `overriding-terminal-local-map' is + ;; installed, e.g., the `universal-argument-map'. It would be good to + ;; think about a better criterion instead. Unfortunately relying on + ;; `this-command' alone is insufficient, since the value of + ;; `this-command' gets clobbered in the case of transient keymaps. + (or overriding-terminal-local-map + ;; Check if it is an explicitly listed continue command + (corfu--match-symbol-p corfu-continue-commands this-command) + (pcase-let ((`(,beg ,end . ,_) completion-in-region--data)) + (and (or (equal (or (car corfu--input) "") "") (< beg end)) ;; Check for empty input + (or (not corfu-quit-at-boundary) ;; Check separator or predicate + (and (eq corfu-quit-at-boundary 'separator) + (or (eq this-command #'corfu-insert-separator) + ;; with separator, any further chars allowed + (seq-contains-p (car corfu--input) corfu-separator))) + (funcall completion-in-region-mode--predicate))))))) + +(defun corfu--preview-current-p () + "Return t if the selected candidate is previewed." + (and corfu-preview-current (>= corfu--index 0) (/= corfu--index corfu--preselect))) + +(defun corfu--preview-current (beg end) + "Show current candidate as overlay given BEG and END." + (when (corfu--preview-current-p) + (corfu--preview-delete) + (setq beg (+ beg (length corfu--base)) + corfu--preview-ov (make-overlay beg end nil)) + (overlay-put corfu--preview-ov 'priority 1000) + (overlay-put corfu--preview-ov 'window (selected-window)) + (overlay-put corfu--preview-ov (if (= beg end) 'after-string 'display) + (substring-no-properties (nth corfu--index corfu--candidates))))) + +(defun corfu--preview-delete () + "Delete the preview overlay." + (when corfu--preview-ov + (delete-overlay corfu--preview-ov) + (setq corfu--preview-ov nil))) + +(defun corfu--window-change (_) + "Window and buffer change hook which quits Corfu." + (unless (corfu--range-valid-p) + (corfu-quit))) + +(defun corfu--debug (&rest _) + "Debugger used by `corfu--protect'." + (let ((inhibit-message t)) + (require 'backtrace) + (declare-function backtrace-to-string "backtrace") + (message "Corfu detected an error:\n%s" (backtrace-to-string))) + (let (message-log-max) + (message "%s %s" + (propertize "Corfu detected an error:" 'face 'error) + (substitute-command-keys "Press \\[view-echo-area-messages] to see the stack trace"))) + nil) + +(defun corfu--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 #'corfu--debug)) + (funcall fun))) + (when (or debug-on-error (condition-case nil + (progn (funcall fun) nil) + (error t))) + (let ((debug-on-error t) + (debugger #'corfu--debug)) + (condition-case nil + (funcall fun) + ((debug error) nil)))))) + +(defun corfu--post-command () + "Refresh Corfu after last command." + (corfu--protect + (lambda () + (if (corfu--continue-p) + (corfu--exhibit) + (corfu-quit))))) + +(defun corfu--goto (index) + "Go to candidate with INDEX." + (setq corfu--index (max corfu--preselect (min index (1- corfu--total))))) + +(defun corfu--exit-function (str status cands) + "Call the `:exit-function' with STR and STATUS. +Lookup STR in CANDS to restore text properties." + (when-let* ((exit (plist-get completion-extra-properties :exit-function))) + (funcall exit (or (car (member str cands)) str) status))) + +(defun corfu--done (str status cands) + "Exit completion and call the exit function with STR and STATUS. +Lookup STR in CANDS to restore text properties." + (let ((completion-extra-properties (nth 4 completion-in-region--data))) + ;; For successful completions, amalgamate undo operations, + ;; such that completion can be undone in a single step. + (undo-amalgamate-change-group corfu--change-group) + (corfu-quit) + (corfu--exit-function str status cands))) + +(defun corfu--setup (beg end table pred) + "Setup Corfu completion state. +See `completion-in-region' for the arguments BEG, END, TABLE, PRED." + (let ((props completion-extra-properties)) + (when (eq (car props) :corfu--state) + (dolist (s (cadr props)) (set (car s) (cdr s))) + (setq props (cddr props))) + (setq end (if (and (markerp end) (marker-insertion-type end)) end (copy-marker end t)) + completion-in-region--data (list (+ 0 beg) end table pred props))) + (completion-in-region-mode) + (activate-change-group (setq corfu--change-group (prepare-change-group))) + (setcdr (assq #'completion-in-region-mode minor-mode-overriding-map-alist) corfu-map) + (add-hook 'pre-command-hook #'corfu--prepare nil 'local) + (add-hook 'window-selection-change-functions #'corfu--window-change nil 'local) + (add-hook 'window-buffer-change-functions #'corfu--window-change nil 'local) + (add-hook 'post-command-hook #'corfu--post-command) + ;; Disable default post-command handling, since we have our own + ;; checks in `corfu--post-command'. + (remove-hook 'post-command-hook #'completion-in-region--postch) + (let ((sym (make-symbol "corfu--teardown")) + (buf (current-buffer))) + (fset sym (lambda () + ;; Ensure that the tear-down runs in the correct buffer, if still alive. + (unless completion-in-region-mode + (remove-hook 'completion-in-region-mode-hook sym) + (corfu--teardown buf)))) + (add-hook 'completion-in-region-mode-hook sym))) + +(defun corfu--in-region (&rest args) + "Corfu completion in region function called with ARGS." + ;; XXX We can get an endless loop when `completion-in-region-function' is set + ;; globally to `corfu--in-region'. This should never happen. + (apply (if (corfu--popup-support-p) #'corfu--in-region-1 + (default-value 'completion-in-region-function)) + args)) + +(defun corfu--in-region-1 (beg end table pred) + "Complete in region, see `completion-in-region' for BEG, END, TABLE, PRED." + (barf-if-buffer-read-only) + ;; Restart the completion. This can happen for example if C-M-/ + ;; (`dabbrev-completion') is pressed while the Corfu popup is already open. + (when completion-in-region-mode (corfu-quit)) + (let* ((pt (max 0 (- (point) beg))) + (str (buffer-substring-no-properties beg end)) + (input (cons str pt)) + (md (completion-metadata (substring str 0 pt) table pred)) + (threshold (completion--cycle-threshold md)) + (completion-in-region-mode-predicate + (or completion-in-region-mode-predicate #'always))) + (pcase (corfu--try-completion str table pred pt md) + ('nil (corfu--message "No match") nil) + ('t (goto-char end) + (corfu--message "Sole match") + (if (eq corfu-on-exact-match 'show) + (corfu--setup beg end table pred) + (corfu--exit-function + str 'finished + (alist-get 'corfu--candidates (corfu--compute input table pred)))) + t) + ((and newinp `(,newstr . ,newpt)) + (setq end (copy-marker end t)) + (corfu--replace beg end newstr) + (goto-char (+ beg newpt)) + (let* ((state (corfu--compute newinp table pred)) + (base (alist-get 'corfu--base state)) + (total (alist-get 'corfu--total state)) + (cands (alist-get 'corfu--candidates state))) + (cond + ((= total 0) + (when (test-completion newstr table pred) + (corfu--exit-function newstr 'finished nil))) + ((= total 1) + ;; Setup popup if `corfu-on-exact-match' is `show' or if completion + ;; can continue. + (if (or (eq corfu-on-exact-match 'show) + (consp (corfu--try-completion newstr table pred newpt))) + (corfu--setup beg end table pred) + (corfu--exit-function (car cands) 'finished nil))) + ;; Too many candidates for cycling -> Setup popup. + ((or (not threshold) (and (not (eq threshold t)) (< threshold total))) + (corfu--setup beg end table pred)) + (t + ;; Cycle through candidates. + (corfu--cycle-candidates total cands (+ (length base) beg) end) + ;; Do not show Corfu when completion is finished after the candidate. + (unless (equal (completion-boundaries (car cands) table pred "") '(0 . 0)) + (corfu--setup beg end table pred))))) + t)))) + +(defun corfu--message (&rest msg) + "Show completion MSG." + (let (message-log-max) (apply #'message msg))) + +(defun corfu--cycle-candidates (total cands beg end) + "Cycle between TOTAL number of CANDS. +See `completion-in-region' for the arguments BEG, END, TABLE, PRED." + (let* ((idx 0) + (map (make-sparse-keymap)) + (replace (lambda () + (interactive) + (corfu--replace beg end (nth idx cands)) + (corfu--message "Cycling %d/%d..." (1+ idx) total) + (setq idx (mod (1+ idx) total)) + (set-transient-map map)))) + (define-key map [remap completion-at-point] replace) + (define-key map [remap corfu-complete] replace) + (define-key map (vector last-command-event) replace) + (funcall replace))) + +(cl-defgeneric corfu--popup-show (pos off width lines &optional curr lo bar) + "Show LINES as popup at POS - OFF. +WIDTH is the width of the popup. +The current candidate CURR is highlighted. +A scroll bar is displayed from LO to LO+BAR." + (let ((lh (max (default-line-height) (cdr (posn-object-width-height pos))))) + (with-current-buffer (corfu--make-buffer " *corfu*") + (let* ((ch (default-line-height)) + (cw (default-font-width)) + ;; bug#74214, bug#37755, bug#37689: Even for larger fringes, fringe + ;; bitmaps can only have a width between 1 and 16. Therefore we + ;; restrict the fringe width to 16 pixel. This restriction may + ;; cause problem on HDPi systems. Hopefully Emacs will adopt + ;; larger fringe bitmaps in the future and lift the restriction. + (ml (min 16 (ceiling (* cw corfu-left-margin-width)))) + (mr (min 16 (ceiling (* cw corfu-right-margin-width)))) + (bw (min mr (ceiling (* cw corfu-bar-width)))) + (graphic (display-graphic-p)) + (marginl (and (not graphic) (propertize " " 'display `(space :width (,ml))))) + (sbar (if graphic + #(" " 0 1 (display (right-fringe corfu--bar corfu--bar))) + (concat + (propertize " " 'display `(space :align-to (- right (,bw)))) + (propertize " " 'face 'corfu-bar 'display `(space :width (,bw)))))) + (cbar (if graphic + #(" " 0 1 (display (left-fringe corfu--nil corfu-current)) + 1 2 (display (right-fringe corfu--bar corfu--cbar))) + sbar)) + (cmargin (and graphic + #(" " 0 1 (display (left-fringe corfu--nil corfu-current)) + 1 2 (display (right-fringe corfu--nil corfu-current))))) + (pos (posn-x-y pos)) + (width (+ (* width cw) (if graphic 0 (+ ml mr)))) + ;; XXX HACK: Minimum popup height must be at least 1 line of the + ;; parent frame (gh:minad/corfu#261). + (height (max lh (* (length lines) ch))) + (edge (window-inside-pixel-edges)) + (border (if graphic corfu-border-width 0)) + (x (max 0 (min (+ (car edge) (- (or (car pos) 0) ml (* cw off) border)) + (- (frame-pixel-width) width + (if graphic (+ ml mr (* 2 border)) 0))))) + (yb (+ (cadr edge) (or (cdr pos) 0) lh + (static-if (< emacs-major-version 31) (window-tab-line-height) 0))) + (y (if (> (+ yb (* corfu-count ch) lh lh) (frame-pixel-height)) + (- yb height lh border border) + yb)) + (bmp (logxor (1- (ash 1 mr)) (1- (ash 1 bw))))) + (setq left-fringe-width (if graphic ml 0) right-fringe-width (if graphic mr 0)) + ;; Define an inverted corfu--bar face + (unless (equal (and (facep 'corfu--bar) (face-attribute 'corfu--bar :foreground)) + (face-attribute 'corfu-bar :background)) + (set-face-attribute (make-face 'corfu--bar) nil + :foreground (face-attribute 'corfu-bar :background))) + (unless (or (= right-fringe-width 0) (eq (get 'corfu--bar 'corfu--bmp) bmp)) + (put 'corfu--bar 'corfu--bmp bmp) + (define-fringe-bitmap 'corfu--bar (vector (lognot bmp)) 1 mr '(top periodic)) + (define-fringe-bitmap 'corfu--nil [0] 1 1) + ;; Fringe bitmaps require symbol face specification, define internal face. + (set-face-attribute (make-face 'corfu--cbar) nil + :inherit '(corfu--bar corfu-current))) + (with-silent-modifications + (delete-region (point-min) (point-max)) + (apply #'insert + (cl-loop for row from 0 for line in lines collect + (let ((str (concat marginl line + (if (and lo (<= lo row (+ lo bar))) + (if (eq row curr) cbar sbar) + (and (eq row curr) cmargin)) + "\n"))) + (when (eq row curr) + (add-face-text-property + 0 (length str) 'corfu-current 'append str)) + str))) + (goto-char (point-min))) + (setq corfu--frame (corfu--make-frame corfu--frame x y width height)))))) + +(cl-defgeneric corfu--popup-hide () + "Hide Corfu popup." + (corfu--hide-frame corfu--frame)) + +(cl-defgeneric corfu--popup-support-p () + "Return non-nil if child frames are supported." + (or (display-graphic-p) (featurep 'tty-child-frames))) + +(cl-defgeneric corfu--insert (status) + "Insert current candidate, exit with STATUS if non-nil." + ;; XXX There is a small bug here, depending on interpretation. + ;; When completing "~/emacs/master/li|/calc" where "|" is the + ;; cursor, then the candidate only includes the prefix + ;; "~/emacs/master/lisp/", but not the suffix "/calc". Default + ;; completion has the same problem when selecting in the + ;; *Completions* buffer. See bug#48356. + (pcase-let* ((`(,beg ,end . ,_) completion-in-region--data) + (str (concat corfu--base (nth corfu--index corfu--candidates)))) + (corfu--replace beg end str) + (corfu--goto -1) ;; Reset selection, completion may continue. + (when status (corfu--done str status nil)) + str)) + +(cl-defgeneric corfu--affixate (cands) + "Annotate CANDS with annotation function." + (let* ((dep (corfu--metadata-get 'company-deprecated)) + (mf (let ((completion-extra-properties (nth 4 completion-in-region--data))) + (run-hook-with-args-until-success 'corfu-margin-formatters corfu--metadata)))) + (setq cands + (if-let* ((aff (corfu--metadata-get 'affixation-function))) + (funcall aff cands) + (if-let* ((ann (corfu--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. We use a custom `corfu-annotations' face to + ;; allow further styling which fits better for popups. + (unless (text-property-not-all 0 (length suff) 'face nil suff) + (setq suff (propertize suff 'face 'corfu-annotations))) + (list cand "" suff))) + (cl-loop for cand in cands collect (list cand "" ""))))) + (cl-loop for x in cands for (c . _) = x do + (when mf + (setf (cadr x) (funcall mf c))) + (when (and dep (funcall dep c)) + (setcar x (setq c (substring c))) + (add-face-text-property 0 (length c) 'corfu-deprecated 'append c))) + (cons mf cands))) + +(cl-defgeneric corfu--prepare () + "Insert selected candidate unless command is marked to continue completion." + (corfu--preview-delete) + ;; Ensure that state is initialized before next Corfu command + (when (and (symbolp this-command) (string-prefix-p "corfu-" (symbol-name this-command))) + (corfu--update)) + ;; If the next command is not listed in `corfu-continue-commands', insert the + ;; currently selected candidate and bail out of completion. This way you can + ;; continue typing after selecting a candidate. The candidate will be inserted + ;; and your new input will be appended. + (and (corfu--preview-current-p) (eq corfu-preview-current 'insert) + ;; See the comment about `overriding-local-map' in `corfu--post-command'. + (not (or overriding-terminal-local-map + (corfu--match-symbol-p corfu-continue-commands this-command))) + (corfu--insert 'exact))) + +(cl-defgeneric corfu--exhibit () + "Exhibit Corfu UI." + (pcase-let ((`(,beg ,end ,table ,pred . ,_) completion-in-region--data) + (`(,str . ,pt) (corfu--update 'interruptible))) + (cond + ;; 1) Single exactly matching candidate and no further completion is possible. + ((and corfu-on-exact-match + (not (eq corfu-on-exact-match 'show)) + (equal corfu--candidates (list str)) + (not (consp (corfu--try-completion str table pred pt)))) + (if (eq corfu-on-exact-match 'quit) + (corfu-quit) + (corfu--done (car corfu--candidates) 'finished nil))) + ;; 2) There exist candidates => Show candidates popup. + (corfu--candidates + (let ((pos (posn-at-point (min (point-max) (+ beg (length corfu--base)))))) + (corfu--preview-current beg end) + (corfu--candidates-popup pos))) + ;; 3) No candidates & `corfu-quit-no-match' & initialized => Confirmation popup. + ((pcase-exhaustive corfu-quit-no-match + ('t nil) + ('nil corfu--input) + ('separator (seq-contains-p (car corfu--input) corfu-separator))) + (corfu--popup-show (posn-at-point beg) 0 8 '(#("No match" 0 8 (face italic))))) + ;; 4) No candidates & initialized => Quit. + (corfu--input (corfu-quit))))) + +(cl-defgeneric corfu--teardown (buffer) + "Tear-down Corfu in BUFFER, which might be dead at this point." + (corfu--popup-hide) + (corfu--preview-delete) + (remove-hook 'post-command-hook #'corfu--post-command) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (remove-hook 'window-selection-change-functions #'corfu--window-change 'local) + (remove-hook 'window-buffer-change-functions #'corfu--window-change 'local) + (remove-hook 'pre-command-hook #'corfu--prepare 'local) + (accept-change-group corfu--change-group))) + (cl-loop for (k . v) in corfu--initial-state do (set k v))) + +(defun corfu-sort-length-alpha (list) + "Sort LIST by length and alphabetically." + (sort list #'corfu--length-string<)) + +(defun corfu-quit () + "Quit Corfu completion." + (interactive) + (completion-in-region-mode -1)) + +(defun corfu-reset () + "Reset Corfu completion. +This command can be executed multiple times by hammering the ESC key. If a +candidate is selected, unselect the candidate. Otherwise reset the input. If +there hasn't been any input, then quit." + (interactive) + (if (/= corfu--index corfu--preselect) + (progn + (corfu--goto -1) + (setq this-command #'corfu-first)) + ;; Cancel all changes and start new change group. + (pcase-let* ((`(,beg ,end . ,_) completion-in-region--data) + (str (buffer-substring-no-properties beg end))) + (cancel-change-group corfu--change-group) + (goto-char end) + (activate-change-group (setq corfu--change-group (prepare-change-group))) + ;; Quit when resetting, when input did not change. + (when (equal str (buffer-substring-no-properties beg end)) + (corfu-quit))))) + +(defun corfu-insert-separator () + "Insert a separator character, inhibiting quit on completion boundary. +If the currently selected candidate is previewed, jump to the input +prompt instead. See `corfu-separator' for more details." + (interactive) + (if (not (corfu--preview-current-p)) + (insert corfu-separator) + (corfu--goto -1) + (unless (or (= (car completion-in-region--data) (point)) + (= (char-before) corfu-separator)) + (insert corfu-separator)))) + +(defun corfu-next (&optional n) + "Go forward N candidates." + (interactive "p") + (let ((index (+ corfu--index (or n 1)))) + (corfu--goto + (cond + ((not corfu-cycle) index) + ((= corfu--total 0) -1) + ((< corfu--preselect 0) (1- (mod (1+ index) (1+ corfu--total)))) + (t (mod index corfu--total)))))) + +(defun corfu-previous (&optional n) + "Go backward N candidates." + (interactive "p") + (corfu-next (- (or n 1)))) + +(defun corfu-scroll-down (&optional n) + "Go back by N pages." + (interactive "p") + (corfu--goto (max 0 (- corfu--index (* (or n 1) corfu-count))))) + +(defun corfu-scroll-up (&optional n) + "Go forward by N pages." + (interactive "p") + (corfu-scroll-down (- (or n 1)))) + +(defun corfu-first () + "Go to first candidate. +If the first candidate is already selected, go to the prompt." + (interactive) + (corfu--goto (if (> corfu--index 0) 0 -1))) + +(defun corfu-last () + "Go to last candidate." + (interactive) + (corfu--goto (1- corfu--total))) + +(defun corfu-prompt-beginning (arg) + "Move to beginning of the prompt line. +If the point is already the beginning of the prompt move to the +beginning of the line. If ARG is not 1 or nil, move backward ARG - 1 +lines first." + (interactive "^p") + (let ((beg (car completion-in-region--data))) + (if (or (not (eq arg 1)) + (and (= corfu--preselect corfu--index) (= (point) beg))) + (move-beginning-of-line arg) + (corfu--goto -1) + (goto-char beg)))) + +(defun corfu-prompt-end (arg) + "Move to end of the prompt line. +If the point is already the end of the prompt move to the end of +the line. If ARG is not 1 or nil, move forward ARG - 1 lines +first." + (interactive "^p") + (let ((end (cadr completion-in-region--data))) + (if (or (not (eq arg 1)) + (and (= corfu--preselect corfu--index) (= (point) end))) + (move-end-of-line arg) + (corfu--goto -1) + (goto-char end)))) + +(defun corfu-complete () + "Complete current input. +If a candidate is selected, insert it. Otherwise invoke +`corfu-expand'. Return non-nil if the input has been expanded." + (interactive) + (if (< corfu--index 0) + (corfu-expand) + ;; Continue completion with selected candidate. Exit with status 'finished + ;; if input is a valid match and no further completion is possible. + (pcase-let ((`(,_beg ,_end ,table ,pred . ,_) completion-in-region--data) + (newstr (corfu--insert nil))) + (and (test-completion newstr table pred) + (or (not (consp (corfu--try-completion newstr table pred (length newstr)))) + ;; Additionally finish completion if at the end of a boundary, + ;; even if other longer candidates match, since the user invoked + ;; `corfu-complete' with an explicitly selected candidate! + (equal (completion-boundaries newstr table pred "") '(0 . 0))) + (corfu--done newstr 'finished nil)) + t))) + +(defun corfu-expand () + "Expands the common prefix of all candidates. +If the currently selected candidate is previewed, invoke +`corfu-complete' instead. Expansion relies on the completion +styles via `completion-try-completion'. Return non-nil if the +input has been expanded." + (interactive) + (if (corfu--preview-current-p) + (corfu-complete) + (pcase-let* ((`(,beg ,end ,table ,pred . ,_) completion-in-region--data) + (pt (max 0 (- (point) beg))) + (str (buffer-substring-no-properties beg end))) + (pcase (corfu--try-completion str table pred pt) + ('t + (goto-char end) + (corfu--done str 'finished corfu--candidates) + t) + ((and `(,newstr . ,newpt) (guard (not (and (= pt newpt) (equal newstr str))))) + (corfu--replace beg end newstr) + (goto-char (+ beg newpt)) + ;; Exit with status 'finished if input is a valid match + ;; and no further completion is possible. + (and (test-completion newstr table pred) + (not (consp (corfu--try-completion newstr table pred newpt))) + (corfu--done newstr 'finished corfu--candidates)) + t))))) + +(defun corfu-insert () + "Insert current candidate. +Quit if no candidate is selected." + (interactive) + (if (>= corfu--index 0) + (corfu--insert 'finished) + (corfu-quit))) + +(defun corfu-send () + "Insert current candidate and send it when inside comint or eshell." + (interactive) + (corfu-insert) + (cond + ((and (derived-mode-p 'eshell-mode) (fboundp 'eshell-send-input)) + (eshell-send-input)) + ((and (derived-mode-p 'comint-mode) (fboundp 'comint-send-input)) + (comint-send-input)))) + +;;;###autoload +(define-minor-mode corfu-mode + "COmpletion in Region FUnction." + :group 'corfu :keymap corfu-mode-map + (cond + (corfu-mode + (when corfu-auto + (require 'corfu-auto) + (add-hook 'post-command-hook 'corfu-auto--post-command 10 'local)) + (setq-local completion-in-region-function #'corfu--in-region)) + (t + (remove-hook 'post-command-hook 'corfu-auto--post-command 'local) + (kill-local-variable 'completion-in-region-function)))) + +(defcustom global-corfu-minibuffer t + "Corfu should be enabled in the minibuffer by `global-corfu-mode'. +The variable can either be t, nil or a custom predicate function. If +the variable is set to t, Corfu is only enabled if the minibuffer has +local `completion-at-point-functions'." + :type '(choice (const t) (const nil) function) + :group 'corfu) + +;;;###autoload +(define-globalized-minor-mode global-corfu-mode + corfu-mode corfu--on + :group 'corfu + :predicate t + (remove-hook 'minibuffer-setup-hook #'corfu--minibuffer-on) + (when (and global-corfu-mode global-corfu-minibuffer) + (add-hook 'minibuffer-setup-hook #'corfu--minibuffer-on 100))) + +(defun corfu--on () + "Enable `corfu-mode' in the current buffer respecting `global-corfu-modes'." + (unless (or noninteractive buffer-read-only (eq (aref (buffer-name) 0) ?\s)) + (corfu-mode))) + +(defun corfu--minibuffer-on () + "Enable `corfu-mode' in the minibuffer respecting `global-corfu-minibuffer'." + (when (and global-corfu-minibuffer (not noninteractive) + (if (functionp global-corfu-minibuffer) + (funcall global-corfu-minibuffer) + (local-variable-p 'completion-at-point-functions))) + (corfu-mode))) + +;; Do not show Corfu commands with M-X +(dolist (sym '( corfu-next corfu-previous corfu-first corfu-last corfu-quit corfu-reset + corfu-complete corfu-insert corfu-scroll-up corfu-scroll-down corfu-expand + corfu-send corfu-insert-separator corfu-prompt-beginning corfu-prompt-end + corfu-info-location corfu-info-documentation ;; autoloads in corfu-info.el + corfu-quick-jump corfu-quick-insert corfu-quick-complete)) ;; autoloads in corfu-quick.el + (put sym 'completion-predicate #'ignore)) + +(defun corfu--capf-wrapper-advice (orig fun which) + "Around advice for `completion--capf-wrapper'. +The ORIG function takes the FUN and WHICH arguments." + (if corfu-mode (corfu--capf-wrapper fun) (funcall orig fun which))) + +(defun corfu--eldoc-advice () + "Return non-nil if Corfu is currently not active." + (not (and corfu-mode completion-in-region-mode))) + +;; Install advice which fixes `completion--capf-wrapper', such that it respects +;; the completion styles for non-exclusive Capfs. See also the fixme comment in +;; the `completion--capf-wrapper' function in minibuffer.el. +(advice-add #'completion--capf-wrapper :around #'corfu--capf-wrapper-advice) + +;; Register Corfu with ElDoc +(advice-add #'eldoc-display-message-no-interference-p + :before-while #'corfu--eldoc-advice) +(eldoc-add-command #'corfu-complete #'corfu-insert #'corfu-expand #'corfu-send) + +(with-eval-after-load 'corfu-terminal + (when (featurep 'tty-child-frames) + (display-warning 'corfu "`corfu-terminal' is not needed on Emacs 31"))) + +(provide 'corfu) +;;; corfu.el ends here |