Initial commit of Corfu candidate overlay
The minor mode uses underlying corfu completion data to show the first candidate inline while typing.
This commit is contained in:
commit
cfd74e2f6b
1 changed files with 222 additions and 0 deletions
222
corfu-candidate-overlay.el
Normal file
222
corfu-candidate-overlay.el
Normal file
|
|
@ -0,0 +1,222 @@
|
||||||
|
;;; corfu-candidate-overlay.el --- Show first candidate in an overlay while typing -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
|
||||||
|
|
||||||
|
;; Author: Adam Kruszewski <adam@kruszewski.name>
|
||||||
|
;; Maintainer: Adam Kruszewski <adam@kruszewski.name>
|
||||||
|
;; Created: 2023
|
||||||
|
;; Version: 0.1
|
||||||
|
;; Package-Requires: ((emacs "27.1") (corfu "0.36"))
|
||||||
|
;; Homepage: https://code.bsdgeek.org/adam/corfu-candidate-overlay/
|
||||||
|
|
||||||
|
;; 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:
|
||||||
|
|
||||||
|
;; Show first candidate in an inline overlay while typing.
|
||||||
|
;; When there is only one candidate the overlay text will
|
||||||
|
;; be underlined.
|
||||||
|
;;
|
||||||
|
;; It is ment to be used with `corfu-auto' set to `nil', and
|
||||||
|
;; executing the corfu completion popup with a keybind.
|
||||||
|
;;
|
||||||
|
;; Enable by executing `corfu-candidate-overlay-mode'.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'corfu)
|
||||||
|
|
||||||
|
(defvar-local corfu--candidate-overlay nil
|
||||||
|
"Overlay for Corfu candidates display when typing.")
|
||||||
|
|
||||||
|
(defvar-local corfu--candidate-last-point nil
|
||||||
|
"Last point location when the overlay was calculated for.")
|
||||||
|
|
||||||
|
(defvar corfu--candidate-overlay-map nil
|
||||||
|
"Keymap to dismiss the Corfu candidate overlay.")
|
||||||
|
|
||||||
|
(defcustom corfu-overlay-auto-commands
|
||||||
|
'("delete-backward-char\\'")
|
||||||
|
"Additional commands apart from corfu-auto-commands which initiate
|
||||||
|
completion candidate overlay."
|
||||||
|
:type '(repeat (choice regexp symbol))
|
||||||
|
:group 'corfu)
|
||||||
|
|
||||||
|
(defface corfu--candidate-overlay-face
|
||||||
|
'((((background light))
|
||||||
|
:foreground "MistyRose4")
|
||||||
|
(((background dark))
|
||||||
|
:foreground "wheat"))
|
||||||
|
"Face used for the overlay with the first candidate.")
|
||||||
|
|
||||||
|
(defface corfu--candidate-overlay-face-exact-match
|
||||||
|
'((t (:inherit 'corfu--candidate-overlay-face :underline t)))
|
||||||
|
"Face used for the overlay when there is only one candidate.")
|
||||||
|
|
||||||
|
(defun corfu--candiate-overlay-prepare (beg end)
|
||||||
|
"Sets the default properties of the candidates overlay.
|
||||||
|
The overlay can be dismissed with a mouse click."
|
||||||
|
(when (not corfu--candidate-overlay-map)
|
||||||
|
(setq corfu--candidate-overlay-map (make-sparse-keymap))
|
||||||
|
(define-key corfu--candidate-overlay-map (kbd "<mouse-1>")
|
||||||
|
(lambda ()
|
||||||
|
(interactive)
|
||||||
|
(delete-overlay corfu--candidate-overlay))))
|
||||||
|
|
||||||
|
(if corfu--candidate-overlay
|
||||||
|
(move-overlay corfu--candidate-overlay end end)
|
||||||
|
(progn
|
||||||
|
(setq corfu--candidate-overlay (make-overlay end end nil))
|
||||||
|
;; priority of 1k is the value used by Corfu.
|
||||||
|
(overlay-put corfu--candidate-overlay 'priority 1000))))
|
||||||
|
|
||||||
|
(defun corfu--candidate-overlay-update (beg end prefix candidate how-many-candidates)
|
||||||
|
"Updates the candidate overlay with the first candidate found by Corfu."
|
||||||
|
(corfu--candiate-overlay-prepare beg end)
|
||||||
|
|
||||||
|
(unless (string-empty-p candidate)
|
||||||
|
(add-text-properties 0 1 '(cursor 1) candidate))
|
||||||
|
|
||||||
|
(overlay-put corfu--candidate-overlay 'window (selected-window))
|
||||||
|
(overlay-put corfu--candidate-overlay 'after-string
|
||||||
|
(propertize
|
||||||
|
candidate
|
||||||
|
'face (if (= how-many-candidates 1)
|
||||||
|
'corfu--candidate-overlay-face-exact-match
|
||||||
|
'corfu--candidate-overlay-face)
|
||||||
|
'keymap corfu--candidate-overlay-map)))
|
||||||
|
|
||||||
|
(defun corfu-hide-candidate-overlay ()
|
||||||
|
"Hide the candidate overlay."
|
||||||
|
(when (and
|
||||||
|
corfu--candidate-overlay
|
||||||
|
(overlayp corfu--candidate-overlay))
|
||||||
|
;; 'invisible property doesn't work really; deleting the overlay
|
||||||
|
;; would need to recreate the object on basically each keystroke
|
||||||
|
;; and I don't like the perspective of it, would also flicker
|
||||||
|
;; for sure - so we keep the one overlay and we clear the contents.
|
||||||
|
(overlay-put corfu--candidate-overlay 'after-string "")))
|
||||||
|
|
||||||
|
(defun corfu-show-candidate-overlay ()
|
||||||
|
"Computes completion candidates just like Corfu and updats the candidate
|
||||||
|
overlay to reflect the first one. Uses different face when there is only
|
||||||
|
one candidate available (defaults to underline)."
|
||||||
|
(let ((value (while-no-input ;; Interruptible capf query
|
||||||
|
(run-hook-wrapped 'completion-at-point-functions #'corfu--capf-wrapper))))
|
||||||
|
|
||||||
|
(if (not value)
|
||||||
|
(corfu-hide-candidate-overlay) ;; when empty, we hide the overlay.
|
||||||
|
(pcase value ;; when not, we check the completion data.
|
||||||
|
(`(,fun ,beg ,end ,table . ,plist)
|
||||||
|
(let ((completion-in-region-mode-predicate
|
||||||
|
(lambda ()
|
||||||
|
(when-let (newbeg (car-safe (funcall fun)))
|
||||||
|
(= newbeg beg))))
|
||||||
|
(completion-extra-properties plist))
|
||||||
|
|
||||||
|
(setq completion-in-region--data
|
||||||
|
(list (if (markerp beg) beg (copy-marker beg))
|
||||||
|
(copy-marker end t)
|
||||||
|
table
|
||||||
|
(plist-get plist :predicate)))
|
||||||
|
|
||||||
|
(when (>= (- end beg) corfu-auto-prefix) ;; adhere to auto prefix length settings.
|
||||||
|
(corfu--update)
|
||||||
|
(let* ((candidate (car corfu--candidates))
|
||||||
|
(how-many-candidates (length corfu--candidates))
|
||||||
|
(len (- end beg))
|
||||||
|
(prefix (buffer-substring-no-properties beg end))
|
||||||
|
(suffix (substring candidate len)))
|
||||||
|
|
||||||
|
(if (and
|
||||||
|
;; need candidate
|
||||||
|
candidate
|
||||||
|
;; the prefix can't be empty (in case of corfu-auto-prefix equal 0)
|
||||||
|
(not (string-empty-p prefix))
|
||||||
|
;; prefix need to match the candidate as there are „fuzzy”
|
||||||
|
;; found candidates, esp. when using templates and the user
|
||||||
|
;; could see strage results at the first character.
|
||||||
|
(string-prefix-p prefix candidate))
|
||||||
|
|
||||||
|
(corfu--candidate-overlay-update
|
||||||
|
beg
|
||||||
|
end
|
||||||
|
prefix
|
||||||
|
suffix
|
||||||
|
how-many-candidates)
|
||||||
|
;; otherwise we hide the overlay.
|
||||||
|
(corfu-hide-candidate-overlay))))))))))
|
||||||
|
|
||||||
|
(defun corfu--candidate-overlay-post-command ()
|
||||||
|
"Post command hook updating the candidate overlay when user inserts character
|
||||||
|
and the cursor is at the end of word."
|
||||||
|
(let* ((is-insert-command
|
||||||
|
(corfu--match-symbol-p corfu-auto-commands this-command))
|
||||||
|
(is-delete-command
|
||||||
|
(corfu--match-symbol-p corfu-overlay-auto-commands this-command)))
|
||||||
|
(if (and
|
||||||
|
;; we are not in minibuffer, as it looks awkward.
|
||||||
|
(not (minibuffer-window-active-p (selected-window)))
|
||||||
|
(not (and ;; do not update it the point have not moved.
|
||||||
|
corfu--candidate-last-point
|
||||||
|
(= corfu--candidate-last-point (point))))
|
||||||
|
(or ;; do not update if it is not one of the insert or delete commands.
|
||||||
|
is-insert-command
|
||||||
|
is-delete-command))
|
||||||
|
(let ((next-char (char-after)))
|
||||||
|
(when (or ;; do not update if we are not at the end of the word.
|
||||||
|
(not next-char) ;; end of file
|
||||||
|
;; one of whitespace, quoting character, punctuation,
|
||||||
|
;; closing bracket, etc is next.
|
||||||
|
;; When those characters follow next completion won't trigger
|
||||||
|
;; eitherway: ' = * - + / ~ _ (have not investigated further)
|
||||||
|
(memq next-char '(?\s ?\t ?\r ?\n
|
||||||
|
?\" ?\` ?\) ?\] ?\>
|
||||||
|
?\. ?\, ?\: ?\;)))
|
||||||
|
;; When the completion backend is SLOW, i.e. like every LSP client,
|
||||||
|
;; then the overlay will not update and will interfere with the typing.
|
||||||
|
;; That's why we move preemptively when inserting and deleting the first
|
||||||
|
;; character (look awkward when typing a different word than the completion
|
||||||
|
;; but still looks better than flickering).
|
||||||
|
;; When deleting -- we just move the overlay so it will show
|
||||||
|
;; the „lagging” candidate.
|
||||||
|
(when (and is-insert-command corfu--candidate-overlay)
|
||||||
|
(let ((previous-text (overlay-get corfu--candidate-overlay 'after-string)))
|
||||||
|
(when (not (string-empty-p previous-text))
|
||||||
|
(overlay-put corfu--candidate-overlay 'after-string
|
||||||
|
(substring previous-text 1)))
|
||||||
|
(move-overlay corfu--candidate-overlay (point) (point))))
|
||||||
|
|
||||||
|
;; preserve the current position, show and update the overlay.
|
||||||
|
(setq corfu--candidate-last-point (point))
|
||||||
|
(corfu-show-candidate-overlay)))
|
||||||
|
;; or hide the overlay if the conditions where not met.
|
||||||
|
(corfu-hide-candidate-overlay))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(define-minor-mode corfu-candidate-overlay-mode
|
||||||
|
"Show first candidate in an overlay while typing."
|
||||||
|
:global t
|
||||||
|
:group 'corfu
|
||||||
|
(if corfu-candidate-overlay-mode
|
||||||
|
(progn
|
||||||
|
(add-hook 'post-command-hook #'corfu--candidate-overlay-post-command)
|
||||||
|
(message "Enabled `corfu-candidate-overlay-mode'."))
|
||||||
|
(progn
|
||||||
|
(remove-hook 'post-command-hook #'corfu--candidate-overlay-post-command)
|
||||||
|
(message "Disabled `corfu-candidate-overlay-mode'."))))
|
||||||
|
|
||||||
|
;;; corfu-candidate-overlay.el ends here
|
||||||
Loading…
Reference in a new issue