branch: externals/corfu
commit a60d4b33f6af4f53c3e9b8ce355402a5a9795109
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Rewrite corfu--in-region without completion-cycling support
---
corfu.el | 148 ++++++++++++++++++++++++---------------------------------------
1 file changed, 57 insertions(+), 91 deletions(-)
diff --git a/corfu.el b/corfu.el
index 39dae84457..04e70fc62d 100644
--- a/corfu.el
+++ b/corfu.el
@@ -952,29 +952,26 @@ there hasn't been any input, then quit."
"Try to complete current input."
(interactive)
(pcase-let ((`(,beg ,end ,table ,pred) completion-in-region--data))
- (if completion-cycling
- ;; Proceed with cycling
- (let ((completion-extra-properties corfu--extra))
- (corfu--completion-in-region beg end table pred))
- (if (>= corfu--index 0)
- ;; Continue completion with selected candidate
- (corfu--insert nil)
- ;; Try to complete the current input string
- (let* ((pt (max 0 (- (point) beg)))
- (str (buffer-substring-no-properties beg end))
- (metadata (completion-metadata (substring str 0 pt) table
pred)))
- (pcase (completion-try-completion str table pred pt metadata)
- (`(,newstr . ,newpt)
- (completion--replace beg end newstr)
- (goto-char (+ beg newpt))))))
- ;; No further completion is possible and the current string is a valid
- ;; match, exit with status 'finished.
+ (if (>= corfu--index 0)
+ ;; Continue completion with selected candidate
+ (corfu--insert nil)
+ ;; Try to complete the current input string
(let* ((pt (max 0 (- (point) beg)))
(str (buffer-substring-no-properties beg end))
(metadata (completion-metadata (substring str 0 pt) table pred)))
- (when (and (not (consp (completion-try-completion str table pred pt
metadata)))
- (test-completion str table pred))
- (corfu--done str 'finished))))))
+ (pcase (completion-try-completion str table pred pt metadata)
+ (`(,newstr . ,newpt)
+ (unless (equal str newstr)
+ (completion--replace beg end newstr))
+ (goto-char (+ beg newpt))))))
+ ;; No further completion is possible and the current string is a valid
+ ;; match, exit with status 'finished.
+ (let* ((pt (max 0 (- (point) beg)))
+ (str (buffer-substring-no-properties beg end))
+ (metadata (completion-metadata (substring str 0 pt) table pred)))
+ (when (and (not (consp (completion-try-completion str table pred pt
metadata)))
+ (test-completion str table pred))
+ (corfu--done str 'finished)))))
(defun corfu--insert (status)
"Insert current candidate, exit with STATUS if non-nil."
@@ -1016,6 +1013,8 @@ there hasn't been any input, then quit."
(defun corfu--setup ()
"Setup Corfu completion state."
(setq corfu--extra completion-extra-properties)
+ (completion-in-region-mode 1)
+ (undo-boundary) ;; Necessary to support `corfu-reset'
(activate-change-group (setq corfu--change-group (prepare-change-group)))
(setcdr (assq #'completion-in-region-mode minor-mode-overriding-map-alist)
corfu-map)
(add-hook 'pre-command-hook #'corfu--pre-command nil 'local)
@@ -1031,7 +1030,8 @@ there hasn't been any input, then quit."
(remove-hook 'completion-in-region-mode-hook sym)
(with-current-buffer (if (buffer-live-p buf) buf
(current-buffer))
(corfu--teardown)))))
- (add-hook 'completion-in-region-mode-hook sym)))
+ (add-hook 'completion-in-region-mode-hook sym))
+ (corfu--update))
(defun corfu--teardown ()
"Teardown Corfu."
@@ -1048,70 +1048,38 @@ there hasn't been any input, then quit."
(accept-change-group corfu--change-group)
(mapc #'kill-local-variable corfu--state-vars))
-(defun corfu--completion-message (msg)
- "Print completion MSG, do not hang like `completion--message'."
- (when (and completion-show-inline-help
- (member msg '("No match" "Sole completion")))
- (message msg)))
-
-(defun corfu--all-sorted-completions (&optional beg end)
- "Compute all sorted completions for string between BEG and END."
- (or completion-all-sorted-completions
- (pcase-let ((`(,base ,all . ,_) (corfu--recompute-candidates
- (buffer-substring-no-properties beg end)
- (max 0 (- (point) beg))
- minibuffer-completion-table
- minibuffer-completion-predicate)))
- (when all
- (completion--cache-all-sorted-completions
- beg end (nconc all base))))))
-
-;; TODO Rewrite this with a clean reimplementation. We have to use way
-;; too many advices and overrides to adjust default completion to our
-;; needs. The original idea was to initiate completion via
-;; `completion--in-region' and proceed with the Corfu popup.
-(defun corfu--completion-in-region (&rest args)
- "Corfu completion in region function passing ARGS to
`completion--in-region'."
+(defun corfu--in-region (beg end table &optional pred)
+ "Corfu completion in region function.
+See `completion-in-region' for the arguments BEG, END, TABLE, PRED."
(barf-if-buffer-read-only)
(if (not (display-graphic-p))
;; XXX Warning this can result in an endless loop when
`completion-in-region-function'
- ;; is set *globally* to `corfu--completion-in-region'. This should never
happen.
- (apply (default-value 'completion-in-region-function) args)
+ ;; is set *globally* to `corfu--in-region'. This should never happen.
+ (funcall (default-value 'completion-in-region-function) beg end table
pred)
;; Restart the completion. This can happen for example if C-M-/
;; (`dabbrev-completion') is pressed while the Corfu popup is already open.
- (when (and completion-in-region-mode (not completion-cycling))
- (corfu-quit))
- (prog1
- (cl-letf* ((completion-auto-help nil)
- ;; Set the predicate to ensure that
`completion-in-region-mode' is enabled.
- (completion-in-region-mode-predicate
- (or completion-in-region-mode-predicate (lambda () t)))
- ;; Disable completion-in-region-mode after exit!
- (exit-fun (plist-get completion-extra-properties
:exit-function))
- (completion-extra-properties
- `(:exit-function
- ,(lambda (str status)
- (when exit-fun (funcall exit-fun str status))
- (when (eq status 'finished)
(completion-in-region-mode -1)))
- ,@completion-extra-properties))
- ;; Overwrite to avoid hanging.
- ((symbol-function #'completion--message)
- #'corfu--completion-message)
- ;; Overwrite for performance and consistency.
- ((symbol-function #'completion-all-sorted-completions)
- #'corfu--all-sorted-completions))
- (apply #'completion--in-region args))
- (when (and completion-in-region-mode
- ;; Do not show Corfu when "trivially" cycling, i.e.,
- ;; when the completion is finished after the candidate.
- (not (and completion-cycling
- (pcase-let* ((`(,beg ,end ,table ,pred)
completion-in-region--data)
- (pt (max 0 (- (point) beg)))
- (str (buffer-substring-no-properties
beg end))
- (before (substring str 0 pt))
- (after (substring str pt)))
- (equal (completion-boundaries before table pred
after) '(0 . 0))))))
- (corfu--setup)))))
+ (when completion-in-region-mode (corfu-quit))
+ (let* ((pt (max 0 (- (point) beg)))
+ (str (buffer-substring-no-properties beg end))
+ (before (substring str 0 pt))
+ (metadata (completion-metadata before table pred))
+ (exit (plist-get completion-extra-properties :exit-function))
+ (completion-in-region-mode-predicate
+ (or completion-in-region-mode-predicate (lambda () t))))
+ (pcase (completion-try-completion str table pred pt metadata)
+ ('nil (message "No match") nil)
+ ('t
+ (goto-char end)
+ (message "Sole match")
+ (when exit (funcall exit str 'finished))
+ t)
+ (`(,newstr . ,newpt)
+ (setq completion-in-region--data
+ (list (copy-marker beg) (copy-marker end t) table pred))
+ (unless (equal str newstr)
+ (completion--replace beg end newstr))
+ (goto-char (+ beg newpt))
+ (corfu--setup))))))
(defun corfu--auto-complete (buf tick pt)
"Initiate auto completion if BUF, TICK and PT did not change."
@@ -1126,16 +1094,14 @@ there hasn't been any input, then quit."
(guard
(let ((len (or (plist-get plist :company-prefix-length) (-
(point) beg))))
(or (eq len t) (>= len corfu-auto-prefix)))))
- (let ((completion-extra-properties plist)
- (completion-in-region-mode-predicate
- (lambda () (eq beg (car-safe (funcall fun))))))
- (setq completion-in-region--data `(,(copy-marker beg) ,(copy-marker
end t)
- ,table ,(plist-get plist
:predicate))
- corfu--auto-start (float-time))
- (undo-boundary) ;; Necessary to support `corfu-reset'
- (completion-in-region-mode 1)
- (corfu--setup)
- (corfu--update))))))
+ (let ((completion-in-region-mode-predicate
+ (lambda () (eq beg (car-safe (funcall fun)))))
+ (completion-extra-properties plist))
+ (setq corfu--auto-start (float-time)
+ completion-in-region--data
+ (list (copy-marker beg) (copy-marker end t) table
+ (plist-get plist :predicate)))
+ (corfu--setup))))))
(defun corfu--auto-post-command ()
"Post command hook which initiates auto completion."
@@ -1167,7 +1133,7 @@ there hasn't been any input, then quit."
(advice-add #'completion--capf-wrapper :around
#'corfu--capf-wrapper-advice)
(advice-add #'eldoc-display-message-no-interference-p :before-while
#'corfu--allow-eldoc)
(and corfu-auto (add-hook 'post-command-hook #'corfu--auto-post-command
nil 'local))
- (setq-local completion-in-region-function #'corfu--completion-in-region))
+ (setq-local completion-in-region-function #'corfu--in-region))
(t
(remove-hook 'post-command-hook #'corfu--auto-post-command 'local)
(kill-local-variable 'completion-in-region-function))))
