From: Eshel Yaron <me@eshelyaron.com>
Date: Sat, 4 Nov 2023 19:51:57 +0000 (+0100)
Subject: Improve handling of slow completion tables and exit functions
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;ds=sidebyside;p=completion-preview.git

Improve handling of slow completion tables and exit functions
---

diff --git a/completion-preview.el b/completion-preview.el
index 60d13bb..e8fd521 100644
--- a/completion-preview.el
+++ b/completion-preview.el
@@ -80,6 +80,8 @@ all of the functions return non-nil."
 
 (defvar-local completion-preview--overlay nil)
 
+(defvar-local completion-preview--skip nil)
+
 (defun completion-preview--sort-by-length-alpha (elems)
   "Sort ELEMS first by length, then alphabetically.
 
@@ -122,12 +124,19 @@ Compatibility definition for `minibuffer--sort-by-length-alpha'."
     (remove-hook 'completion-at-point-functions #'completion-preview-insert t)
     (completion-preview-hide)))
 
+(defun completion-preview--exit-function (func)
+  (lambda (&rest args)
+    (completion-preview-active-mode -1)
+    (when func (apply func args))))
+
 (defun completion-preview--update ()
   "Update completion preview."
-  (pcase (run-hook-with-args-until-success 'completion-at-point-functions)
+  (pcase (let ((completion-preview--skip t))
+           (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))
+            (exit-fn (completion-preview--exit-function
+                      (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)
@@ -159,28 +168,33 @@ Compatibility definition for `minibuffer--sort-by-length-alpha'."
 (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)))
+    (let* ((data (overlay-get completion-preview--overlay 'completion-preview-data))
+           (beg (car data))
+           (cands (caddr data))
+           (cand (car cands))
+           (plist (cdddr data))
+           (len (length cand))
+           (end (+ beg len))
+           (after (overlay-get completion-preview--overlay 'after-string))
+           (face (get-text-property 0 'face after)))
+      (if (and (< beg (point) end)
+               (string-prefix-p (buffer-substring beg (point)) cand))
+          (overlay-put
+           (completion-preview--make-overlay
+            (point) (propertize (substring cand (- (point) beg)) 'face face))
+           'completion-preview-data (append (list beg (point) cands) plist))
         (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))
+  (if (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
+  (when (and completion-preview-active-mode (not completion-preview--skip))
     (overlay-get completion-preview--overlay 'completion-preview-data)))
 
 ;;;###autoload