[elpa] externals/corfu a61992d 29/29: Rework popup function

[Stefan Monnier]

branch: externals/corfu
commit a61992ddd13917eb802359f9e73c10271494b7c0
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Rework popup function
---
 corfu.el | 70 +++++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 36 insertions(+), 34 deletions(-)

diff --git a/corfu.el b/corfu.el
index d5def1a..8f4bddd 100644
--- a/corfu.el
+++ b/corfu.el
@@ -179,10 +179,10 @@
          (rborder (corfu--border (car size) (cdr size) 'corfu-border -1))
          (rbar (corfu--border (car size) (cdr size) 'corfu-bar (- (ceiling 
(car size) 3))))
          (col (+ (- pos (line-beginning-position)) corfu--base))
-         (max-width (min (/ (window-total-width) 2) (- (window-total-width) 
col)))
-         (pixelpos (cdr (window-absolute-pixel-position pos)))
+         (max-width (min (/ (window-total-width) 2) (- (window-total-width) 
col 4)))
+         (pixel-pos (cdr (window-absolute-pixel-position pos)))
          (count (length lines))
-         (row 0) (tail) (width))
+         (row 0) (width) (formatted) (beg))
     (if (< max-width corfu-min-width)
         (setq width (max corfu-min-width (/ (window-total-width) 2))
               lines (mapcar (lambda (x) (truncate-string-to-width x width)) 
lines)
@@ -191,39 +191,41 @@
       (setq lines (mapcar (lambda (x) (truncate-string-to-width x max-width)) 
lines)
             width (apply #'max corfu-min-width (mapcar #'string-width lines))))
     (save-excursion
-      (when (and (>= count (floor (- (window-pixel-height) pixelpos) (cdr 
size)))
-                 (< count (floor pixelpos (cdr size))))
-        (forward-line (- -1 count)))
       (beginning-of-line)
+      (forward-line (if (and (>= count (floor (- (window-pixel-height) 
pixel-pos) (cdr size)))
+                             (< count (floor pixel-pos (cdr size))))
+                        (- count) 1))
+      (setq beg (point))
+      (when (save-excursion
+              (forward-line 1)
+              (/= (point) (line-beginning-position)))
+        (push #(" \n" 0 1 (cursor t)) formatted))
       (dolist (line lines)
-        (let ((old (point)))
-          (forward-line 1)
-          (beginning-of-line)
-          (when (= (point) old)
-            (setq tail (concat (propertize " " 'cursor t) "\n" (make-string 
col 32)))))
-        (let* ((beg (point))
-               (end (line-end-position))
-               (prefix (or tail (and (> col (- end beg)) (make-string (- col 
(- end beg)) 32))))
-               (ov (if prefix
-                       (make-overlay end end)
-                     (make-overlay (min (+ beg col) end) (min (+ beg col width 
2) end))))
-               (str (concat
-                     (if fancy-ui
-                         (propertize lborder 'face (if (= row idx) 
'corfu-current 'corfu-background))
-                       (propertize " " 'face (if (= row idx) 'corfu-current 
'corfu-background)))
-                     line
-                     (make-string (- width (string-width line)) 32)
-                     (if fancy-ui
-                         (propertize (if (and lo (<= lo row (+ lo bar))) rbar 
rborder)
-                                     'face (if (= row idx) 'corfu-current 
'corfu-background))
-                       (propertize " " 'face (if (and lo (<= lo row (+ lo 
bar))) 'corfu-bar 'corfu-border))))))
+        (let ((bufline (buffer-substring (point) (line-end-position)))
+              (str (concat
+                    (if fancy-ui
+                        (propertize lborder 'face (if (= row idx) 
'corfu-current 'corfu-background))
+                      (propertize " " 'face (if (= row idx) 'corfu-current 
'corfu-background)))
+                    line
+                    (make-string (- width (string-width line)) 32)
+                    (if fancy-ui
+                        (propertize (if (and lo (<= lo row (+ lo bar))) rbar 
rborder)
+                                    'face (if (= row idx) 'corfu-current 
'corfu-background))
+                      (propertize " " 'face (if (and lo (<= lo row (+ lo 
bar))) 'corfu-bar 'corfu-border))))))
           (add-face-text-property 0 (length str) (if (= row idx) 
'corfu-current 'corfu-background) 'append str)
-          (overlay-put ov 'priority (- 1000 row))
-          (overlay-put ov 'window (selected-window))
-          (overlay-put ov 'invisible t)
-          (overlay-put ov 'after-string (concat prefix str))
-          (push ov corfu--overlays)
-          (setq row (1+ row)))))))
+          (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))
+          (forward-line 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)))))
 
 (defun corfu--move-to-front (elem list)
   "Move ELEM to front of LIST."
@@ -393,7 +395,7 @@
                            (mapcar #'corfu--format-candidate))))
         (when (>= curr 0)
           (let ((ov (make-overlay beg end nil t t)))
-            (overlay-put ov 'priority 2000)
+            (overlay-put ov 'priority 1000)
             (overlay-put ov 'window (selected-window))
             (overlay-put ov 'display (nth curr candidates))
             (push ov corfu--overlays)))