master 2fa8fd1: Improve sorting of flex completion style with non-nil minibuffer-default

[João Távora]

branch: master
commit 2fa8fd18dfb0dc673ea82491de952a45b84c6667
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    Improve sorting of flex completion style with non-nil minibuffer-default
    
    This affects the behaviour of flex completion when there is a default
    completion and the user hasn't entered any input pattern to flex-match
    against.  It is most visible when icomplete-mode or fido-mode are
    being used in conjunctio.
    
    When using M-x man, for instance, the default completion is picked
    from text around point.  Say it is "emacs" (for Emacs's man page).  It
    will not match the intended completion, "emacs(1)", exactly.  If the
    user hasn't yet given any input to the completion prompt, that
    completion should bubble to top so that
    icomplete-force-complete-and-exit will select it, but it didn't.
    
    This new approach uses 'string-prefix-p' instead of 'equal' to find
    the default to bubble to the top.  This strategy could eventually be
    improved, most naturally by flex-matching the default string to all
    the candidates and picking the highest scoring one.
    
    Additionally, the new strategy only considers minibuffer-default if
    there is no input in the minibuffer, which seems sensible and produces
    a small but noticeable speedup.
    
    * lisp/minibuffer.el (completion--flex-adjust-metadata):
    Reformulate sorting strategy.
---
 lisp/minibuffer.el | 38 +++++++++++++++++++++++++++-----------
 1 file changed, 27 insertions(+), 11 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 5dc753f..9693116 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3585,17 +3585,33 @@ that is non-nil."
   (cl-flet ((compose-flex-sort-fn
              (existing-sort-fn) ; wish `cl-flet' had proper indentation...
              (lambda (completions)
-               (let ((res
-                      (if existing-sort-fn
-                          (funcall existing-sort-fn completions)
-                        completions)))
-                 (sort
-                  res
-                  (lambda (c1 c2)
-                    (or (equal c1 minibuffer-default)
-                        (let ((s1 (get-text-property 0 'completion-score c1))
-                              (s2 (get-text-property 0 'completion-score c2)))
-                          (> (or s1 0) (or s2 0))))))))))
+               (let* ((by-score
+                       (sort
+                        (if existing-sort-fn
+                            (funcall existing-sort-fn completions)
+                          completions)
+                        (lambda (c1 c2)
+                          (let ((s1 (get-text-property 0 'completion-score c1))
+                                (s2 (get-text-property 0 'completion-score 
c2)))
+                            (> (or s1 0) (or s2 0))))))
+                      (promoted-default
+                       (and minibuffer-default
+                            (and (window-minibuffer-p)
+                                 (= (point-max)
+                                    (minibuffer-prompt-end)))
+                            ;; If we have an empty pattern and a
+                            ;; non-nil default we probably want to
+                            ;; make sure that default is bubbled to
+                            ;; the top even if it doesn't match the
+                            ;; completion perfectly (like in M-x man
+                            ;; case)
+                            (cl-loop
+                             for l on by-score
+                             for comp = (cadr l)
+                             when (string-prefix-p minibuffer-default comp)
+                             do (setf (cdr l) (cddr l))
+                             and return (cons comp by-score)))))
+                 (or promoted-default by-score)))))
     `(metadata
       (display-sort-function
        . ,(compose-flex-sort-fn