[elpa] externals/corfu a60d4b33f6 1/2: Rewrite corfu--in-region without completion-cycling support

[ELPA Syncer]

branch: externals/corfu
commit a60d4b33f6af4f53c3e9b8ce355402a5a9795109
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@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))))