From 4c07a388e49bc26edc01c867a87c16c7af9ab3fd Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Fri, 12 Jul 2024 19:46:07 +0200
Subject: [PATCH] (completion-all-sorted-completions): Sync with *Completions*

---
 lisp/minibuffer.el | 85 ++++++++++++++++++++++------------------------
 1 file changed, 41 insertions(+), 44 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index d4570d36a5a..7f043c8bd92 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1855,49 +1855,46 @@ include as `sort-function' in completion metadata."
 (defun completion-all-sorted-completions (&optional start end)
   (let* ((start (or start (minibuffer-prompt-end)))
          (end (or end (point-max)))
-         (string (buffer-substring start end))
-         (md (completion--field-metadata start))
-         (all (completion-all-completions
-               string
-               minibuffer-completion-table
-               minibuffer-completion-predicate
-               (- (point) start)
-               md))
-         (last (last all))
-         (base-size (or (cdr last) 0))
-         (all-md (completion--metadata (buffer-substring-no-properties
-                                        start (point))
-                                       base-size md
-                                       minibuffer-completion-table
-                                       minibuffer-completion-predicate))
-         (sort-fun
-          (or minibuffer-completions-sort-function
-              (completion-metadata-get all-md 'sort-function)
-              (pcase completions-sort
-                ('nil #'identity)
-                ('alphabetical #'minibuffer-sort-alphabetically)
-                ('historical #'minibuffer-sort-by-history)
-                (_ completions-sort))))
-         (full-base (substring string 0 base-size))
-         (minibuffer-completion-base
-          (funcall (or (alist-get 'adjust-base-function all-md) #'identity)
-                   full-base)))
-    (when last
-      (setcdr last nil)
-
-      ;; Delete duplicates: do it after setting last's cdr to nil (so
-      ;; it's a proper list), and be careful to reset `last' since it
-      ;; may be a different cons-cell.
-      (setq all (delete-dups all))
-      (setq last (last all))
-
-      (when sort-fun (setq all (funcall sort-fun all)))
-
-      (let ((result (nconc all base-size)))
-        ;; Cache the result.  This is not just for speed, but also so that
-        ;; repeated calls to minibuffer-force-complete can cycle through
-        ;; all possibilities.
-        (setq completion-all-sorted-completions result)))))
+         all base-size)
+    (unless (and (get-buffer-window completions-buffer-name 0)
+                 (with-current-buffer completions-buffer-name
+                   (when-let ((cur (get-text-property (point) 'completion--string)))
+                     (let ((tail nil))
+                       (while (and completions-candidates
+                                   (not (eq cur (car completions-candidates))))
+                         (push (pop completions-candidates) tail))
+                       (setq base-size (- (car completion-base-position) start)
+                             completions-candidates
+                             (nconc completions-candidates
+                                    (nreverse tail))
+                             all (copy-sequence completions-candidates))))))
+      (let* ((string (buffer-substring start end))
+             (md (completion--field-metadata start))
+             (sub (completion-all-completions
+                   (buffer-substring start end)
+                   minibuffer-completion-table
+                   minibuffer-completion-predicate
+                   (- (point) start)
+                   (completion--field-metadata start)))
+             (last (last sub))
+             (size (or (cdr last) 0))
+             (sort-fun
+              (or minibuffer-completions-sort-function
+                  (completion-metadata-get md 'sort-function)
+                  (pcase completions-sort
+                    ('nil #'identity)
+                    ('alphabetical #'minibuffer-sort-alphabetically)
+                    ('historical #'minibuffer-sort-by-history)
+                    (_ completions-sort))))
+             (full-base (substring string 0 size))
+             (minibuffer-completion-base
+              (funcall (or (alist-get 'adjust-base-function md) #'identity)
+                       full-base)))
+        (when last
+          (setcdr last nil)
+          (when sort-fun (setq sub (funcall sort-fun sub)))
+          (setq all sub base-size size))))
+    (setq completion-all-sorted-completions (nconc all base-size))))
 
 (defun minibuffer-toggle-completion-ignore-case ()
   "Toggle completion case-sensitively for the current minibuffer."
@@ -3166,7 +3163,7 @@ PLIST is a property list with optional extra information about COMPLETIONS."
         (set-window-point (get-buffer-window) (prop-match-beginning pm)))
       (setq-local
        completion-reference-buffer mainbuf
-       completions-candidates completions
+       completions-candidates (mapcar (lambda (c) (if (atom c) c (car c))) completions)
        completions-group-function group-fun
        completions-annotations (plist-get plist :annotations)
        completions-style (plist-get plist :style)
-- 
2.39.2