branch: externals/corfu
commit 59949d3db2b6f4923f0817b9712c02b61d80fc41
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Use child frames instead of overlays
Fix #10, #13 and #15.
---
README.org | 11 ++-
corfu.el | 270 ++++++++++++++++++++++++++++++++++---------------------------
2 files changed, 158 insertions(+), 123 deletions(-)
diff --git a/README.org b/README.org
index a49e053..1218f53 100644
--- a/README.org
+++ b/README.org
@@ -9,9 +9,9 @@
* Introduction
Corfu enhances the default completion in region function with a completion
-overlay. The current candidates are shown in a popup overlay below or above the
-point. Corfu can be considered the minimalistic completion-in-region
counterpart
-of the [[https://github.com/minad/vertico][Vertico]] minibuffer UI.
+overlay. The current candidates are shown in a popup below or above the point.
+Corfu can be considered the minimalistic completion-in-region counterpart of
the
+[[https://github.com/minad/vertico][Vertico]] minibuffer UI.
Icomplete implements both completion-in-region and minibuffer completion in a
single package. While Corfu and Vertico are technically similar to Icomplete,
@@ -135,14 +135,13 @@ counterpart of Corfu.
This package is experimental and new. I am not yet claiming that this package
works correctly. There are a few known technical caveats.
-- The overlay popup is brittle (Alternatives to consider: Posframe, Postip)
-- The thin popup borders are only drawn if =line-spacing=nil=.
+- The package does not work in text mode since it uses child frames.
- The abort handling could be improved, for example the input could be undone.
- The ~completion-in-region-mode-predicate~ is ignored in order to
give the completion style full control. The predicate asks the backend if
the starting point of the completion has changed.
- Company kind icons and metadata are not supported (~company-kind~,
~company-docsig~)
-- No support for multi-backends like Company (Implement a multi-capf?)
+- No support for multi-backends like Company (Implement a multi-capf?).
- No sorting by history, since ~completion-at-point~ does not
maintain a history (See branch =history= for a possible solution).
diff --git a/corfu.el b/corfu.el
index 164bd7b..e828207 100644
--- a/corfu.el
+++ b/corfu.el
@@ -28,8 +28,8 @@
;; Corfu enhances the default completion in region function with a
;; completion overlay. The current candidates are shown in a popup
-;; overlay below or above the point. Corfu can be considered the
-;; minimalistic completion-in-region counterpart of Vertico.
+;; below or above the point. Corfu can be considered the minimalistic
+;; completion-in-region counterpart of Vertico.
;;; Code:
@@ -88,21 +88,19 @@ Set to nil in order to disable confirmation."
(defface corfu-bar
'((((class color) (min-colors 88) (background dark))
- :foreground "#444" :background "#bbb")
+ :foreground "#444")
(((class color) (min-colors 88) (background light))
- :foreground "#bbb" :background "#444")
- (t :foreground "gray" :background "black"))
- "The foreground color is used for the scrollbar indicator.
-If `line-spacing/=nil' or in text-mode, the background color is used instead.")
+ :foreground "#bbb")
+ (t :foreground "gray"))
+ "The foreground color is used for the scrollbar indicator.")
(defface corfu-border
'((((class color) (min-colors 88) (background dark))
- :foreground "#444" :background "#444" )
+ :foreground "#444")
(((class color) (min-colors 88) (background light))
- :foreground "#bbb" :background "#ddd")
- (t :foreground "gray" :background "gray"))
- "The foreground color used for the thin border.
-If `line-spacing/=nil' or in text-mode, the background color is used instead.")
+ :foreground "#bbb")
+ (t :foreground "gray"))
+ "The foreground color used for the thin border.")
(defvar corfu-map
(let ((map (make-sparse-keymap)))
@@ -144,8 +142,14 @@ If `line-spacing/=nil' or in text-mode, the background
color is used instead.")
(defvar-local corfu--input nil
"Cons of last prompt contents and point or t.")
-(defvar-local corfu--overlays nil
- "Overlay showing the candidates.")
+(defvar-local corfu--popup-frame nil
+ "Popup frame.")
+
+(defvar-local corfu--popup-buffer nil
+ "Popup buffer.")
+
+(defvar-local corfu--overlay nil
+ "Current candidate overlay.")
(defvar-local corfu--extra-properties nil
"Extra completion properties.")
@@ -162,15 +166,12 @@ If `line-spacing/=nil' or in text-mode, the background
color is used instead.")
corfu--index
corfu--input
corfu--total
- corfu--overlays
+ corfu--popup-frame
+ corfu--popup-buffer
+ corfu--overlay
corfu--extra-properties)
"Buffer-local state variables used by Corfu.")
-(defun corfu--char-size ()
- "Return character size in pixels."
- (let ((lh (line-pixel-height)))
- (cons (round (* lh (frame-char-width)) (frame-char-height)) lh)))
-
;; XXX Is there a better way to generate an image? Bitmap vector?
(defun corfu--border (w h width fg bg)
"Generate border with FG and BG colors, WIDTH and image size W*H."
@@ -185,81 +186,106 @@ If `line-spacing/=nil' or in text-mode, the background
color is used instead.")
:background ,(face-attribute bg :background)
:foreground ,(face-attribute fg :foreground)))))
-;; XXX The popup code is unreliable. There are many problematic
-;; scenarios where the popup may fail:
-;; 1. display-line-numbers-mode
-;; 2. Overhanging lines (popup at the end of buffer)
-;; 3. Overhanging columns (popup at the end of line)
-;; 4. Outline folding
-;; 5. Wide characters like TAB
-;; 6. Lines with invisible/display properties (Org folding)
-;; 7. Scrolled windows
+;; Function adapted from posframe.el by tumashu
+(defun corfu--child-frame (x y width height content)
+ "Show child frame at X/Y with WIDTH/HEIGHT and CONTENT."
+ (let* ((window-min-height 1)
+ (window-min-width 1)
+ (after-make-frame-functions)
+ (frame-resize-pixelwise t)
+ (window-resize-pixelwise t)
+ (edge (window-inside-pixel-edges))
+ (lh (line-pixel-height))
+ (x (max 0 (min (+ (car edge) x) (- (frame-pixel-width) width))))
+ (y (+ (cadr edge) y))
+ (y (if (> (+ y lh height) (frame-pixel-height))
+ (- y height)
+ (+ y lh))))
+ (setq corfu--popup-buffer (or corfu--popup-buffer (generate-new-buffer "
*corfu*")))
+ (with-current-buffer corfu--popup-buffer
+ (setq-local mode-line-format nil
+ header-line-format nil
+ frame-title-format ""
+ truncate-lines nil
+ cursor-type nil
+ cursor-in-non-selected-windows nil
+ show-trailing-whitespace nil
+ display-line-numbers nil
+ left-fringe-width nil
+ right-fringe-width nil
+ left-margin-width nil
+ right-margin-width nil
+ fringes-outside-margins 0)
+ (let (inhibit-modification-hooks)
+ (erase-buffer)
+ (insert content)))
+ (setq corfu--popup-frame
+ (or corfu--popup-frame
+ (make-frame
+ `((parent-frame . ,(window-frame))
+ (background-color . ,(face-attribute 'corfu-background
:background))
+ (no-accept-focus . t)
+ (min-width . t)
+ (min-height . t)
+ (width . 0)
+ (height . 0)
+ (line-spacing . 0)
+ (border-width . 0)
+ (internal-border-width . 0)
+ (left-fringe . 0)
+ (right-fringe . 0)
+ (vertical-scroll-bars . nil)
+ (horizontal-scroll-bars . nil)
+ (menu-bar-lines . 0)
+ (tool-bar-lines . 0)
+ (tab-bar-lines . 0)
+ (no-other-frame . t)
+ (unsplittable . t)
+ (undecorated . t)
+ (visibility . nil)
+ (cursor-type . nil)
+ (minibuffer . nil)
+ (no-special-glyphs . t)))))
+ (set-window-buffer (frame-root-window corfu--popup-frame)
corfu--popup-buffer)
+ (set-frame-size corfu--popup-frame width height t)
+ (set-frame-position corfu--popup-frame x y)
+ (make-frame-visible corfu--popup-frame)))
+
(defun corfu--popup (pos lines &optional curr lo bar)
"Show LINES as popup at POS, with CURR highlighted and scrollbar from LO to
LO+BAR."
- (save-excursion
- (goto-char pos)
- (let* ((inhibit-field-text-motion t) ;; ignore field boundaries
(shell-mode!)
- (size (corfu--char-size))
- ;; XXX Deactivate fancy border on terminal or if line-spacing is
used
- (fancy (and (not line-spacing) (display-graphic-p)))
- (lborder-curr (corfu--border (car size) (cdr size) 1 'corfu-border
'corfu-current))
- (rborder-curr (corfu--border (car size) (cdr size) -1 'corfu-border
'corfu-current))
- (rbar-curr (corfu--border (car size) (cdr size) (- (ceiling (car
size) 3))
- 'corfu-bar 'corfu-current))
- (lborder (corfu--border (car size) (cdr size) 1 'corfu-border
'corfu-background))
- (rborder (corfu--border (car size) (cdr size) -1 'corfu-border
'corfu-background))
- (rbar (corfu--border (car size) (cdr size) (- (ceiling (car size)
3))
- 'corfu-bar 'corfu-background))
- (max-width (min (cdr corfu-width-limits) (/ (window-total-width)
2)))
- (col (- pos (line-beginning-position)))
- (rest-width (- (window-total-width) col 4))
- (ypos (count-screen-lines (save-excursion (move-to-window-line 0)
(point))
- (point)))
- (count (length lines))
- (row 0) (width) (formatted) (beg))
- (if (< rest-width (car corfu-width-limits))
- (setq lines (mapcar (lambda (x) (truncate-string-to-width x
max-width)) lines)
- width (apply #'max (car corfu-width-limits) (mapcar
#'string-width lines))
- col (max 0 (- col width 2)))
- (setq max-width (min rest-width max-width)
- lines (mapcar (lambda (x) (truncate-string-to-width x
max-width)) lines)
- width (apply #'max (car corfu-width-limits) (mapcar
#'string-width lines))))
- (beginning-of-line)
- (vertical-motion (if (and (< count ypos)
- (>= count (- (floor (window-pixel-height) (cdr
size)) ypos 1)))
- (- count) 1))
- (setq beg (point))
- (when (save-excursion
- (vertical-motion 1)
- (/= (point) (line-beginning-position)))
- (push #(" \n" 0 1 (cursor t)) formatted))
- (dolist (line lines)
- (let ((bufline (buffer-substring (point) (line-end-position)))
- (str (concat
- (if fancy (if (eq row curr) lborder-curr lborder) " ")
- line
- (make-string (- width (string-width line)) 32)
- (cond
- (fancy (if (and lo (<= lo row (+ lo bar)))
- (if (eq row curr) rbar-curr rbar)
- (if (eq row curr) rborder-curr rborder)))
- (lo (propertize " " 'face (if (<= lo row (+ lo bar))
- 'corfu-bar 'corfu-border)))
- (t " ")))))
- (add-face-text-property 0 (length str) (if (eq row curr)
'corfu-current 'corfu-background) 'append str)
- (push (concat
- (truncate-string-to-width bufline col 0 32) str
- (substring bufline (length (truncate-string-to-width bufline
(+ col width 2))))
- "\n")
- formatted)
- (setq row (1+ row))
- (vertical-motion 1)))
- (let ((ov (make-overlay beg (point))))
- (overlay-put ov 'priority 900)
- (overlay-put ov 'window (selected-window))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'before-string (string-join (nreverse formatted)))
- (push ov corfu--overlays)))))
+ (let* ((cw (frame-char-width))
+ (ch (frame-char-height))
+ (bw (* 3 (ceiling cw 5)))
+ (lborder (corfu--border bw ch 1 'corfu-border 'corfu-background))
+ (lborder-curr (corfu--border bw ch 1 'corfu-border 'corfu-current))
+ (rborder (corfu--border bw ch -1 'corfu-border 'corfu-background))
+ (rborder-curr (corfu--border bw ch -1 'corfu-border 'corfu-current))
+ (rbar-curr (corfu--border bw ch (- (ceiling cw 4))
+ 'corfu-bar 'corfu-current))
+ (rbar (corfu--border bw ch (- (ceiling cw 4))
+ 'corfu-bar 'corfu-background))
+ (width (min (cdr corfu-width-limits)
+ (/ (frame-width) 2)
+ (apply #'max (car corfu-width-limits)
+ (mapcar #'string-width lines))))
+ (row 0)
+ (pos (posn-x-y (posn-at-point pos))))
+ (corfu--child-frame
+ (- (or (car pos) 0) bw) (or (cdr pos) 0)
+ (+ (* width cw) bw bw) (* (length lines) ch)
+ (mapconcat (lambda (line)
+ (let ((str (concat
+ (if (eq row curr) lborder-curr lborder)
+ (truncate-string-to-width line width 0 32)
+ (if (and lo (<= lo row (+ lo bar)))
+ (if (eq row curr) rbar-curr rbar)
+ (if (eq row curr) rborder-curr rborder)))))
+ (when (eq row curr)
+ (add-face-text-property
+ 0 (length str) 'corfu-current 'append str))
+ (setq row (1+ row))
+ str))
+ lines "\n"))))
(defun corfu--move-to-front (elem list)
"Move ELEM to front of LIST."
@@ -365,13 +391,6 @@ If `line-spacing/=nil' or in text-mode, the background
color is used instead.")
(and (symbolp this-command)
(string-match-p corfu--keep-alive (symbol-name this-command))))
-(defun corfu--pre-command-hook ()
- "Delete overlays."
- (mapc #'delete-overlay corfu--overlays)
- (setq corfu--overlays nil)
- (unless (or (< corfu--index 0) (corfu--keep-alive-p))
- (corfu--insert 'exact)))
-
(defun corfu-abort ()
"Abort Corfu completion."
(interactive)
@@ -413,11 +432,11 @@ If `line-spacing/=nil' or in text-mode, the background
color is used instead.")
(cands (funcall corfu--highlight (seq-subseq corfu--candidates start
last)))
(ann-cands (mapcar #'corfu--format-candidate (corfu--annotate
metadata cands))))
(when (>= curr 0)
- (let ((ov (make-overlay beg end nil t t)))
- (overlay-put ov 'priority 1000)
- (overlay-put ov 'window (selected-window))
- (overlay-put ov 'display (concat (substring str 0 corfu--base) (nth
curr cands)))
- (push ov corfu--overlays)))
+ (when corfu--overlay (delete-overlay corfu--overlay))
+ (setq corfu--overlay (make-overlay beg end nil t t))
+ (overlay-put corfu--overlay 'priority 1000)
+ (overlay-put corfu--overlay 'window (selected-window))
+ (overlay-put corfu--overlay 'display (concat (substring str 0
corfu--base) (nth curr cands))))
;; Nonlinearity at the end and the beginning
(when (/= start 0)
(setq lo (max 1 lo)))
@@ -440,32 +459,45 @@ If `line-spacing/=nil' or in text-mode, the background
color is used instead.")
((condition-case err
(unless (equal corfu--input (cons str pt))
(and (corfu--update-candidates str metadata pt table pred)) nil)
- (t (message "%s" (error-message-string err)))))
+ (t (message "%s" (error-message-string err))
+ nil)))
((and (not corfu--candidates) ;; 1) There are no
candidates
initializing) ;; & Initializing,
first retrieval of candidates.
- (minibuffer-message "No match")) ;; => Show error message
+ (minibuffer-message "No match") ;; => Show error message
+ nil)
((and (not corfu--candidates) ;; 2) There are no
candidates
corfu-confirm) ;; & Confirmation is
enabled
- (corfu--popup beg (list corfu-confirm))) ;; => Show confirmation
popup
+ (corfu--popup beg (list corfu-confirm)) ;; => Show confirmation
popup
+ t)
((and corfu--candidates ;; 3) There exist
candidates
(not (equal corfu--candidates (list str))) ;; & Not a sole exactly
matching candidate
(or (/= beg end) (corfu--keep-alive-p))) ;; & Input is non-empty
or keep-alive command
- (corfu--show-candidates beg end str metadata)) ;; => Show candidates
popup
+ (corfu--show-candidates beg end str metadata) ;; => Show candidates
popup
+ t)
;; When after `completion-at-point/corfu-complete', no further completion
is possible and the
;; current string is a valid match, exit with status 'finished.
((and (memq this-command '(corfu-complete completion-at-point))
(not (stringp (try-completion str table pred)))
(test-completion str table pred))
- (corfu--done str 'finished)))))
+ (corfu--done str 'finished)
+ nil))))
+
+(defun corfu--pre-command-hook ()
+ "Insert selected candidate unless keep alive command."
+ (unless (or (< corfu--index 0) (corfu--keep-alive-p))
+ (corfu--insert 'exact)))
+
+(defun corfu--window-configuration-change-hook ()
+ "Terminate completion when window configuration changed."
+ (completion-in-region-mode -1))
(defun corfu--post-command-hook ()
"Refresh Corfu after last command."
- (pcase completion-in-region--data
- (`(,beg ,end ,_table ,_pred)
- (when (and (eq (marker-buffer beg) (current-buffer)) (<= beg (point) end))
- (corfu--update))))
- (unless corfu--overlays
- (completion-in-region-mode -1)))
+ (or (pcase completion-in-region--data
+ (`(,beg ,end ,_table ,_pred)
+ (when (and (eq (marker-buffer beg) (current-buffer)) (<= beg (point)
end))
+ (corfu--update))))
+ (completion-in-region-mode -1)))
(defun corfu--goto (index)
"Go to candidate with INDEX."
@@ -608,14 +640,18 @@ If `line-spacing/=nil' or in text-mode, the background
color is used instead.")
"Setup Corfu completion state."
(setq corfu--extra-properties completion-extra-properties)
(setcdr (assq #'completion-in-region-mode minor-mode-overriding-map-alist)
corfu-map)
+ (add-hook 'window-configuration-change-hook
#'corfu--window-configuration-change-hook nil 'local)
(add-hook 'pre-command-hook #'corfu--pre-command-hook nil 'local)
(add-hook 'post-command-hook #'corfu--post-command-hook nil 'local))
(defun corfu--teardown ()
"Teardown Corfu."
+ (remove-hook 'window-configuration-change-hook
#'corfu--window-configuration-change-hook 'local)
(remove-hook 'pre-command-hook #'corfu--pre-command-hook 'local)
(remove-hook 'post-command-hook #'corfu--post-command-hook 'local)
- (mapc #'delete-overlay corfu--overlays)
+ (when corfu--overlay (delete-overlay corfu--overlay))
+ (when corfu--popup-frame (delete-frame corfu--popup-frame))
+ (when corfu--popup-buffer (kill-buffer corfu--popup-buffer))
(mapc #'kill-local-variable corfu--state-vars))
(defun corfu--mode-hook ()
