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

@@ -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

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))))))