From 9f9a38ca4c6970b0e23100987331cc56e00bb3d2 Mon Sep 17 00:00:00 2001 From: Axel Forsman Date: Sat, 7 Sep 2024 16:02:22 +0200 Subject: [PATCH] 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 --- hotfuzz.el | 34 +++++++++++++--------------------- test/tests.el | 5 ++--- 2 files changed, 15 insertions(+), 24 deletions(-) diff --git a/hotfuzz.el b/hotfuzz.el index 50ceaa5..b25c4c9 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 238593b..b56eccc 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))))))