From 86d1b4d88f2999d2b0f94619dc53092bddfa0ec0 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 20 Apr 2021 00:01:44 +0200 Subject: [PATCH] (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 51e0519d489..98691c2ede5 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 027711c21e6..6ab5f57eff9 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 -- 2.39.5