branch: externals/hotfuzz
commit aa6bf3620f43b14df3ef6046c7f827ce03f667e7
Author: Axel Forsman <[email protected]>
Commit: Axel Forsman <[email protected]>
Set display-sort-function only when filtering
Completion frontends would forgo their default sorting when the
completion--adjust-metadata function added a display-sort-function
property even if it did nothing, e.g. due to an empty search string.
This commit conditionally omits the sort function properties, allowing
candidates to be sorted by minibuffer history, such as with Vertico's
default sorting function, vertico-sort-history-length-alpha.
Closes #18
Co-authored-by: Oliver Nikolas Winspear <[email protected]>
---
hotfuzz.el | 34 +++++++++++++---------------------
test/tests.el | 5 ++---
2 files changed, 15 insertions(+), 24 deletions(-)
diff --git a/hotfuzz.el b/hotfuzz.el
index 50ceaa5c6a..b25c4c9a81 100644
--- a/hotfuzz.el
+++ b/hotfuzz.el
@@ -43,6 +43,8 @@ Large values will decrease performance."
(defvar hotfuzz--d (make-vector hotfuzz--max-needle-len 0))
(defvar hotfuzz--bonus (make-vector hotfuzz--max-haystack-len 0))
+(defvar hotfuzz--filtering-p)
+
(defconst hotfuzz--bonus-lut
(eval-when-compile
(let ((state-special (make-char-table 'hotfuzz-bonus-lut 0))
@@ -153,31 +155,21 @@ will lead to inaccuracies."
((> (length needle) hotfuzz--max-needle-len))
(t (cl-loop for x in-ref all do (setf x (cons (hotfuzz--cost needle x) x))
finally (setq all (mapcar #'cdr (sort all
#'car-less-than-car))))))
- (when all
- (unless (string= needle "")
- (defvar completion-lazy-hilit-fn) ; Introduced in Emacs 30 (bug#47711)
- (if (bound-and-true-p completion-lazy-hilit)
- (setq completion-lazy-hilit-fn (apply-partially
#'hotfuzz-highlight needle))
- (cl-loop repeat hotfuzz-max-highlighted-completions and for x in-ref
all
- do (setf x (hotfuzz-highlight needle (copy-sequence x)))))
- (setcar all (propertize (car all) 'completion-sorted t)))
- (if (string= prefix "") all (nconc all (length prefix))))))
+ (setq hotfuzz--filtering-p (not (string= needle "")))
+ (defvar completion-lazy-hilit-fn) ; Introduced in Emacs 30 (bug#47711)
+ (if (bound-and-true-p completion-lazy-hilit)
+ (setq completion-lazy-hilit-fn (apply-partially #'hotfuzz-highlight
needle))
+ (cl-loop repeat hotfuzz-max-highlighted-completions and for x in-ref all
+ do (setf x (hotfuzz-highlight needle (copy-sequence x)))))
+ (and all (if (string= prefix "") all (nconc all (length prefix))))))
;;;###autoload
(defun hotfuzz--adjust-metadata (metadata)
"Adjust completion METADATA for hotfuzz sorting."
- (let ((existing-dsf (completion-metadata-get metadata
'display-sort-function))
- (existing-csf (completion-metadata-get metadata 'cycle-sort-function)))
- (cl-flet ((compose-sort-fn (existing-sort-fn)
- (lambda (completions)
- (if (or (null completions)
- (get-text-property 0 'completion-sorted (car
completions)))
- completions
- (funcall existing-sort-fn completions)))))
- `(metadata
- (display-sort-function . ,(compose-sort-fn (or existing-dsf
#'identity)))
- (cycle-sort-function . ,(compose-sort-fn (or existing-csf #'identity)))
- . ,(cdr metadata)))))
+ (if hotfuzz--filtering-p
+ `(metadata (display-sort-function . identity) (cycle-sort-function .
identity)
+ . ,(cdr metadata))
+ metadata))
;;;###autoload
(progn
diff --git a/test/tests.el b/test/tests.el
index 238593bbc3..b56eccc649 100644
--- a/test/tests.el
+++ b/test/tests.el
@@ -79,7 +79,7 @@
;; Completions should be eagerly fontified by default
(should (equal-including-properties
candidates
- '(#("fb" 0 2 (completion-sorted t face completions-common-part))
+ '(#("fb" 0 2 (face completions-common-part))
#("foo-baz" 0 1 (face completions-common-part) 4 5 (face
completions-common-part))
#("foobar" 0 1 (face completions-common-part) 3 4 (face
completions-common-part)))))))
@@ -118,7 +118,6 @@
(ert-deftest lazy-hilit-test ()
"Test lazy fontification."
(let ((completion-lazy-hilit t) completion-lazy-hilit-fn)
- (should (equal-including-properties (hotfuzz-all-completions "x" '("x"))
- '(#("x" 0 1 (completion-sorted t)))))
+ (should (equal-including-properties (hotfuzz-all-completions "x" '("x"))
'("x")))
(should (equal-including-properties (funcall completion-lazy-hilit-fn "x")
#("x" 0 1 (face
completions-common-part))))))
