master 86d1b4d: (completion-all-sorted-completions): Fix history use with boundaries

[Stefan Monnier]

branch: master
commit 86d1b4d88f2999d2b0f94619dc53092bddfa0ec0
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    (completion-all-sorted-completions): Fix history use with boundaries
    
    Preprocess the history (and the default) through the new function
    `minibuffer--sort-preprocess-history` to filter out the completion
    base for completion tables with boundaries (in particular the file
    completion table).
    
    * lisp/minibuffer.el (minibuffer--sort-preprocess-history_: New function.
    (completion-all-sorted-completions): Use it.
    * test/lisp/minibuffer-tests.el (completion-all-sorted-completions):
    Add tests for various combinations of with/without history/base/default.
---
 lisp/minibuffer.el            | 36 +++++++++++++++++++++---------
 test/lisp/minibuffer-tests.el | 52 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+), 10 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 51e0519..98691c2 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1381,6 +1381,26 @@ KEYFUN takes an element of ELEMS and should return a 
numerical value."
                     (and (= (length c1) (length c2))
                          (string< c1 c2))))))
 
+(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 completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1410,21 +1430,17 @@ KEYFUN takes an element of ELEMS and should return a 
numerical value."
           (setq all (delete-dups all))
           (setq last (last all))
 
-          (cond
-           (sort-fun
-            (setq all (funcall sort-fun all)))
-           (t
+          (if sort-fun
+              (setq all (funcall sort-fun all))
             ;; Sort first by length and alphabetically.
             (setq all (minibuffer--sort-by-length-alpha all))
-
             ;; Sort by history position, put the default, if it
             ;; exists, on top.
-            (when (and (minibufferp) (not (eq minibuffer-history-variable t)))
-              (let ((def (car-safe minibuffer-default))
-                    (hist (symbol-value minibuffer-history-variable)))
+            (when (minibufferp)
               (setq all (minibuffer--sort-by-position
-                         (if def (cons def hist) hist)
-                         all))))))
+                         (minibuffer--sort-preprocess-history
+                          (substring string 0 base-size))
+                         all))))
 
           ;; Cache the result.  This is not just for speed, but also so that
           ;; repeated calls to minibuffer-force-complete can cycle through
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 027711c..6ab5f57 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -136,5 +136,57 @@
   (should (equal (completion-pcm--optimize-pattern '(any "" any))
                  '(any))))
 
+(defun test-completion-all-sorted-completions (base def history-var 
history-list)
+  (with-temp-buffer
+    (insert base)
+    (cl-letf (((symbol-function #'minibufferp) (lambda (&rest _) t)))
+      (let ((completion-styles '(basic))
+            (completion-category-defaults nil)
+            (completion-category-overrides nil)
+            (minibuffer-history-variable history-var)
+            (minibuffer-history history-list)
+            (minibuffer-default def)
+            (minibuffer-completion-table
+             (lambda (str pred action)
+               (pcase action
+                 (`(boundaries . ,_) `(boundaries ,(length base) . 0))
+                 (_ (complete-with-action
+                     action
+                     '("epsilon" "alpha" "gamma" "beta" "delta")
+                     (substring str (length base)) pred))))))
+        (completion-all-sorted-completions)))))
+
+(ert-deftest completion-all-sorted-completions ()
+  ;; No base, disabled history, no default
+  (should (equal (test-completion-all-sorted-completions
+                  "" nil t nil)
+                 `("beta" "alpha" "delta" "gamma" "epsilon" . 0)))
+  ;; No base, disabled history, default string
+  (should (equal (test-completion-all-sorted-completions
+                  "" "gamma" t nil)
+                 `("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
+  ;; No base, empty history, default string
+  (should (equal (test-completion-all-sorted-completions
+                  "" "gamma" 'minibuffer-history nil)
+                 `("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
+  ;; No base, empty history, default list
+  (should (equal (test-completion-all-sorted-completions
+                  "" '("gamma" "zeta") 'minibuffer-history nil)
+                 `("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
+  ;; No base, history, default string
+  (should (equal (test-completion-all-sorted-completions
+                  "" "gamma" 'minibuffer-history '("other" "epsilon" "delta"))
+                 `("gamma" "epsilon" "delta" "beta" "alpha"  . 0)))
+  ;; Base, history, default string
+  (should (equal (test-completion-all-sorted-completions
+                  "base/" "base/gamma" 'minibuffer-history
+                  '("some/alpha" "base/epsilon" "base/delta"))
+                 `("gamma" "epsilon" "delta" "beta" "alpha"  . 5)))
+  ;; Base, history, default string
+  (should (equal (test-completion-all-sorted-completions
+                  "base/" "gamma" 'minibuffer-history
+                  '("some/alpha" "base/epsilon" "base/delta"))
+                 `("epsilon" "delta" "beta" "alpha" "gamma"  . 5))))
+
 (provide 'minibuffer-tests)
 ;;; minibuffer-tests.el ends here