From e645290cc3bc39b08e1c179fa1644fe7768e283b Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 4 Nov 2023 20:51:57 +0100 Subject: [PATCH] Improve handling of slow completion tables and exit functions --- completion-preview.el | 44 ++++++++++++++++++++++++++++--------------- 1 file changed, 29 insertions(+), 15 deletions(-) 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 -- 2.39.2