From: Eshel Yaron <me@eshelyaron.com>
Date: Sat, 4 Nov 2023 16:35:02 +0000 (+0100)
Subject: Improve handling of input during completion
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a4ff2b2e73dea457a286ec12f11c465b9fc0b352;p=completion-preview.git

Improve handling of input during completion
---

diff --git a/completion-preview.el b/completion-preview.el
index 683d59f..60d13bb 100644
--- a/completion-preview.el
+++ b/completion-preview.el
@@ -106,49 +106,13 @@ Compatibility definition for `minibuffer--sort-by-length-alpha'."
     (delete-overlay completion-preview--overlay)
     (setq completion-preview--overlay nil)))
 
-(defun completion-preview-show ()
-  "Show completion preview with inline overlay after point."
-  (let ((res (run-hook-wrapped 'completion-at-point-functions
-                               #'completion--capf-wrapper 'all)))
-    (pcase res
-      (`(,_ ,beg ,end ,table . ,plist)
-       (let* ((pred (plist-get plist :predicate))
-              (exit-fn (plist-get plist :exit-function))
-              (string (buffer-substring beg end))
-              (md (completion-metadata string table pred))
-              (sort-fn (or (completion-metadata-get md 'cycle-sort-function)
-                           (completion-metadata-get md 'display-sort-function)
-                           completion-preview-sort-function))
-              (all (completion-all-completions string table pred
-                                               (- (point) beg) md))
-              (last (last all))
-              (base (or (cdr last) 0))
-              (prefix (substring string base)))
-         (when last
-           (setcdr last nil)
-           (let* ((filtered
-                   (seq-filter (apply-partially #'string-prefix-p prefix) all))
-                  (sorted (funcall sort-fn filtered))
-                  (multi (cadr sorted)) ; multiple candidates
-                  (cand (car sorted)))
-             (when (and cand (not (and multi completion-preview-exact-match-only)))
-               (let* ((face (if multi 'completion-preview 'completion-preview-exact))
-                      (after (propertize (substring cand (length prefix)) 'face face)))
-                 (unless (string-empty-p after)
-                   (add-text-properties 0 1 '(cursor 1) after)
-                   (setq completion-preview--overlay (make-overlay end end))
-                   (overlay-put completion-preview--overlay 'after-string after)
-                   (overlay-put completion-preview--overlay 'completion-preview-data
-                                (list (+ beg base) end (list cand)
-                                      :exit-function exit-fn))
-                   (completion-preview-active-mode)))))))))))
-
-(defun completion-preview--post-command ()
-  "Delete the previous completion preview overlay, and maybe show a new one."
-  (completion-preview-active-mode -1)
-  (when (run-hook-with-args-until-failure 'completion-preview-hook)
-    (while-no-input
-      (completion-preview-show))))
+(defun completion-preview--make-overlay (pos string)
+  "Make a new completion preview overlay at POS showing STRING."
+  (completion-preview-hide)
+  (add-text-properties 0 1 '(cursor 1) string)
+  (setq completion-preview--overlay (make-overlay pos pos))
+  (overlay-put completion-preview--overlay 'after-string string)
+  completion-preview--overlay)
 
 (define-minor-mode completion-preview-active-mode
   "Mode for when the completion preview is active."
@@ -158,6 +122,62 @@ Compatibility definition for `minibuffer--sort-by-length-alpha'."
     (remove-hook 'completion-at-point-functions #'completion-preview-insert t)
     (completion-preview-hide)))
 
+(defun completion-preview--update ()
+  "Update completion preview."
+  (pcase (run-hook-with-args-until-success 'completion-at-point-functions)
+    (`(,beg ,end ,table . ,plist)
+     (let* ((pred (plist-get plist :predicate))
+            (exit-fn (plist-get plist :exit-function))
+            (string (buffer-substring beg end))
+            (md (completion-metadata string table pred))
+            (sort-fn (or (completion-metadata-get md 'cycle-sort-function)
+                         (completion-metadata-get md 'display-sort-function)
+                         completion-preview-sort-function))
+            (all (completion-all-completions string table pred
+                                             (- (point) beg) md))
+            (last (last all))
+            (base (or (cdr last) 0))
+            (bbeg (+ beg base))
+            (prefix (substring string base)))
+       (when last
+         (setcdr last nil)
+         (let* ((filtered
+                 (seq-filter (apply-partially #'string-prefix-p prefix) all))
+                (sorted (funcall sort-fn filtered))
+                (multi (cadr sorted))   ; multiple candidates
+                (cand (car sorted)))
+           (when (and cand (not (and multi completion-preview-exact-match-only)))
+             (let* ((face (if multi 'completion-preview 'completion-preview-exact))
+                    (after (propertize (substring cand (length prefix)) 'face face)))
+               (unless (string-empty-p after)
+                 (overlay-put (completion-preview--make-overlay end after)
+                              'completion-preview-data
+                              (list bbeg end (list cand)
+                                    :exit-function exit-fn))
+                 (completion-preview-active-mode))))))))))
+
+(defun completion-preview--show ()
+  "Show completion preview."
+  (when completion-preview-active-mode
+    (let ((beg (overlay-start completion-preview--overlay))
+          (end (point))
+          (after (overlay-get completion-preview--overlay 'after-string))
+          (data (overlay-get completion-preview--overlay 'completion-preview-data)))
+      (if (and (< beg end (+ beg (length after)))
+               (string-prefix-p (buffer-substring beg end) after))
+          (overlay-put (completion-preview--make-overlay end (substring after (- end beg)))
+                       'completion-preview-data
+                       (append (list (nth 0 data) end (nth 2 data))
+                               (nthcdr 3 data)))
+        (completion-preview-active-mode -1))))
+  (while-no-input (completion-preview--update)))
+
+(defun completion-preview--post-command ()
+  "Create, update or delete completion preview post last command."
+  (unless (and (run-hook-with-args-until-failure 'completion-preview-hook)
+               (completion-preview--show))
+    (completion-preview-active-mode -1)))
+
 (defun completion-preview-insert ()
   "Completion at point function for inserting the current preview."
   (when completion-preview-active-mode