From a4ff2b2e73dea457a286ec12f11c465b9fc0b352 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 4 Nov 2023 17:35:02 +0100 Subject: [PATCH] Improve handling of input during completion --- completion-preview.el | 106 +++++++++++++++++++++++++----------------- 1 file changed, 63 insertions(+), 43 deletions(-) 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 -- 2.39.2