(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."
(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