branch: externals/hotfuzz
commit 5ccab77f7bfb1d4246aa01639e151ec9509c64bb
Author: Axel Forsman <[email protected]>
Commit: GitHub <[email protected]>
Add compatibility mode for Vertico (#3)
---
hotfuzz.el | 73 +++++++++++++++++++++++++++++++++++++++++------------------
test/tests.el | 16 +++++++++++++
2 files changed, 67 insertions(+), 22 deletions(-)
diff --git a/hotfuzz.el b/hotfuzz.el
index 7445128958..720c2809a2 100644
--- a/hotfuzz.el
+++ b/hotfuzz.el
@@ -236,28 +236,57 @@ list before passing it to `display-sort-function' or
"Previous values of the Selectrum sort/filter/highlight API endpoints.")
;;;###autoload
-(progn
- (define-minor-mode hotfuzz-selectrum-mode
- "Minor mode that enables hotfuzz in Selectrum menus."
- :group 'hotfuzz
- :global t
- (if hotfuzz-selectrum-mode
- (setq hotfuzz--prev-selectrum-functions
- `(,(when (boundp 'selectrum-refine-candidates-function)
- selectrum-refine-candidates-function)
- . ,(when (boundp 'selectrum-highlight-candidates-function)
- selectrum-highlight-candidates-function))
- selectrum-refine-candidates-function #'hotfuzz-filter
- selectrum-highlight-candidates-function #'hotfuzz--highlight-all)
- (cl-flet ((restore
- (sym old our &aux (standard (car-safe (get sym
'standard-value))))
- (cond ((not (eq (symbol-value sym) our)))
- (old (set sym old))
- (standard (set sym (eval standard t)))
- (t (makunbound sym)))))
- (cl-destructuring-bind (old-rcf . old-hcf)
hotfuzz--prev-selectrum-functions
- (restore 'selectrum-refine-candidates-function old-rcf
#'hotfuzz-filter)
- (restore 'selectrum-highlight-candidates-function old-hcf
#'hotfuzz--highlight-all))))))
+(define-minor-mode hotfuzz-selectrum-mode
+ "Minor mode that enables hotfuzz in Selectrum menus."
+ :group 'hotfuzz
+ :global t
+ (if hotfuzz-selectrum-mode
+ (setq hotfuzz--prev-selectrum-functions
+ `(,(when (boundp 'selectrum-refine-candidates-function)
+ selectrum-refine-candidates-function)
+ . ,(when (boundp 'selectrum-highlight-candidates-function)
+ selectrum-highlight-candidates-function))
+ selectrum-refine-candidates-function #'hotfuzz-filter
+ selectrum-highlight-candidates-function #'hotfuzz--highlight-all)
+ (cl-flet ((restore
+ (sym old our &aux (standard (car-safe (get sym
'standard-value))))
+ (cond ((not (eq (symbol-value sym) our)))
+ (old (set sym old))
+ (standard (set sym (eval standard t)))
+ (t (makunbound sym)))))
+ (cl-destructuring-bind (old-rcf . old-hcf)
hotfuzz--prev-selectrum-functions
+ (restore 'selectrum-refine-candidates-function old-rcf
#'hotfuzz-filter)
+ (restore 'selectrum-highlight-candidates-function old-hcf
#'hotfuzz--highlight-all)))))
+
+;;; Vertico integration
+
+(declare-function vertico--all-completions "ext:vertico")
+
+(defun hotfuzz--vertico--all-completions-advice (fun &rest args)
+ "Advice for FUN `vertico--all-completions' to defer hotfuzz highlighting."
+ (cl-letf* ((hl nil)
+ ((symbol-function #'hotfuzz-highlight)
+ (lambda (pattern cand)
+ (setq hl (apply-partially
+ #'mapcar
+ (lambda (x) (hotfuzz-highlight pattern
(copy-sequence x)))))
+ cand))
+ (hotfuzz-max-highlighted-completions 1)
+ (result (apply fun args)))
+ (when hl (setcdr result hl))
+ result))
+
+;;;###autoload
+(define-minor-mode hotfuzz-vertico-mode
+ "Toggle Hotfuzz compatibility code for the Vertico completion system.
+Contrary to what the name might suggest, this mode does not
+automatically enable Hotfuzz. You still have to choose when it gets
+used by customizing e.g. `completion-styles'."
+ :global t
+ :group 'hotfuzz
+ (if hotfuzz-vertico-mode
+ (advice-add #'vertico--all-completions :around
#'hotfuzz--vertico--all-completions-advice)
+ (advice-remove #'vertico--all-completions
#'hotfuzz--vertico--all-completions-advice)))
(provide 'hotfuzz)
;;; hotfuzz.el ends here
diff --git a/test/tests.el b/test/tests.el
index e31b6c844f..def5817e15 100644
--- a/test/tests.el
+++ b/test/tests.el
@@ -89,3 +89,19 @@
nil
6) ; Point as in "/usr/s|/man"
'("share/" . 5)))))
+
+;;; Vertico integration
+
+(ert-deftest vertico--all-completions-advice-test ()
+ (cl-flet ((f (apply-partially
+ #'hotfuzz--vertico--all-completions-advice
+ (lambda (&rest args) (cons (apply #'completion-all-completions
args) nil)))))
+ ;; If hotfuzz was not tried or produced no matches: Do not set
highlighting fn
+ (let ((completion-styles '(basic hotfuzz)))
+ (should (equal (f "x" '("x") nil 1) '(("x" . 0) . nil))))
+ (let ((completion-styles '(hotfuzz)))
+ (should (equal (f "y" '("x") nil 1) '(nil . nil)))
+ (cl-destructuring-bind (xs . hl) (f "x" '("x") nil 1)
+ ;; Highlighting should not yet have been applied
+ (should (equal-including-properties xs '(#("x" 0 1 (completion-sorted
t)))))
+ (should-not (null hl))))))
