Improve file name sorting by history position

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index d9ce8c89065cfffa1b4598575482f73ba1cbc20b..c0fed064347da8e8f838327f13a4b114594ad62e 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1426,7 +1426,9 @@ Moves point to the end of the new text."
   ;; `completions-first-difference' face, which we don't want to
   ;; include upon insertion.
   (setq newtext (copy-sequence newtext))
-  (remove-text-properties 0 (length newtext) '(face nil display nil) newtext)
+  (remove-text-properties 0 (length newtext)
+                          '(face nil display nil completion--unquoted nil)
+                          newtext)
   ;; Maybe this should be in subr.el.
   ;; You'd think this is trivial to do, but details matter if you want
   ;; to keep markers "at the right place" and be robust in the face of
@@ -1871,41 +1873,10 @@ scroll the window of possible completions."
     (if (eq (car bounds) base) md-at-point
       (completion-metadata (substring string 0 base) table pred))))
 
-(defun minibuffer--sort-by-position (hist elems)
-  "Sort ELEMS by their position in HIST."
-  (let ((hash (make-hash-table :test #'equal :size (length hist)))
-        (index 0))
-    ;; Record positions in hash
-    (dolist (c hist)
-      (unless (gethash c hash)
-        (puthash c index hash))
-      (cl-incf index))
-    (sort elems :key (lambda (x) (gethash x hash most-positive-fixnum)))))
-
 (defun minibuffer--sort-by-length-alpha (elems)
   "Sort ELEMS first by length, then alphabetically."
   (sort elems :key (lambda (c) (cons (length c) c))))
 
-(defun minibuffer--sort-preprocess-history (base)
-  "Preprocess history.
-Remove completion BASE prefix string from history elements."
-  (let* ((def (if (stringp minibuffer-default)
-                  minibuffer-default
-                (car-safe minibuffer-default)))
-         (hist (and (not (eq minibuffer-history-variable t))
-                    (symbol-value minibuffer-history-variable)))
-         (base-size (length base)))
-    ;; Default comes first.
-    (setq hist (if def (cons def hist) hist))
-    ;; Drop base string from the history elements.
-    (if (= base-size 0)
-        hist
-      (delq nil (mapcar
-                 (lambda (c)
-                   (when (string-prefix-p base c)
-                     (substring c base-size)))
-                 hist)))))
-
 (defun minibuffer-sort-by-length (completions)
   "Sort COMPLETIONS by length."
   (sort completions :key #'length))
@@ -1927,26 +1898,27 @@ before the current completion field, as determined by
 `completion-boundaries'.  This is primarily relevant for file
 names, where this is the directory component of the file name.")
 
-(defun minibuffer-sort-by-history (completions)
-  "Sort COMPLETIONS by their position in `minibuffer-history-variable'.
+(defun minibuffer--sort-by-history-key-default (hist)
+  (let ((hash (make-hash-table :test #'equal :size (length hist)))
+        (index 0))
+    (dolist (c hist)
+      (unless (gethash c hash)
+        (puthash c index hash))
+      (cl-incf index))
+    (lambda (x) (list (gethash x hash most-positive-fixnum) x))))
+
+(defvar minibuffer-sort-by-history-key-function
+  #'minibuffer--sort-by-history-key-default)
 
-COMPLETIONS are sorted first by `minibuffer-sort-alphbetically',
-then any elements occurring in the minibuffer history list are
-moved to the front based on the chronological order they occur in
-the history.  If a history variable hasn't been specified for
-this call of `completing-read', COMPLETIONS are sorted only by
-`minibuffer-sort-alphbetically'.
+(defun minibuffer-sort-by-history (completions)
+  "Sort COMPLETIONS by their position in the minibuffer history.
 
 This is a suitable function to use for `completions-sort' or to
 include as `sort-function' in completion metadata."
-  (let ((alphabetized (sort completions)))
-    ;; Only use history when it's specific to these completions.
-    (if (eq minibuffer-history-variable
-            (default-value minibuffer-history-variable))
-        alphabetized
-      (minibuffer--sort-by-position
-       (minibuffer--sort-preprocess-history minibuffer-completion-base)
-       alphabetized))))
+  (sort completions
+        :key (funcall minibuffer-sort-by-history-key-function
+                      (and (not (eq minibuffer-history-variable t))
+                           (symbol-value minibuffer-history-variable)))))
 
 (defun minibuffer--group-by (group-fun sort-fun elems)
   "Group ELEMS by GROUP-FUN and sort groups by SORT-FUN."
@@ -4063,6 +4035,18 @@ and `read-file-name-function'."
                      f))
         :reverse t))
 
+(defun minibuffer--file-name-sort-by-history-key (hist)
+  (let ((expanded-hist (mapcar #'expand-file-name hist)))
+    (lambda (f)
+      (list (or (seq-position expanded-hist
+                              (expand-file-name f minibuffer-completion-base)
+                              (lambda (h c)
+                                (or (and (string= (file-name-directory c) c)
+                                         (string-prefix-p c h))
+                                    (string= h c))))
+                most-positive-fixnum)
+            f))))
+
 (defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
   "Default method for reading file names.
 See `read-file-name' for the meaning of the arguments."
@@ -4134,13 +4118,15 @@ See `read-file-name' for the meaning of the arguments."
                                (lambda ()
                                  (with-current-buffer
                                      (window-buffer (minibuffer-selected-window))
-                                  (read-file-name--defaults dir initial))))
+                                   (read-file-name--defaults dir initial))))
                           (setq-local
                            minibuffer-completions-sort-orders
                            (cons '(?m "modified" "Sort by last modified time"
                                       minibuffer--sort-file-names-by-last-modified-time
                                       "latest modified first")
-                                 minibuffer-completions-sort-orders))
+                                 minibuffer-completions-sort-orders)
+                           minibuffer-sort-by-history-key-function
+                           #'minibuffer--file-name-sort-by-history-key)
                          (set-syntax-table minibuffer-local-filename-syntax))
                       (completing-read prompt 'read-file-name-internal
                                        pred require-match insdef