branch: externals/which-key
commit 90d10a8fb335a21008084ab8b4ba722347ec6c74
Author: Justin Burkett <jus...@burkett.cc>
Commit: Justin Burkett <jus...@burkett.cc>
Fix sorting of keys and add test
Fixes #233
---
which-key-tests.el | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
which-key.el | 26 +++++++++++++++-------
2 files changed, 83 insertions(+), 8 deletions(-)
diff --git a/which-key-tests.el b/which-key-tests.el
index cff7fab..8179797 100644
--- a/which-key-tests.el
+++ b/which-key-tests.el
@@ -148,5 +148,70 @@
("e e e" . "eee")
("f" . "{ - C-f"))))))
+(ert-deftest which-key-test--key-sorting ()
+ (let ((keys '(("a" . "z")
+ ("A" . "Z")
+ ("b" . "y")
+ ("B" . "Y")
+ ("p" . "Prefix")
+ ("SPC" . "x")
+ ("C-a" . "w"))))
+ (let ((which-key-sort-uppercase-first t))
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order))
+ '("SPC" "A" "B" "a" "b" "p" "C-a"))))
+ (let (which-key-sort-uppercase-first)
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order))
+ '("SPC" "a" "b" "p" "A" "B" "C-a"))))
+ (let ((which-key-sort-uppercase-first t))
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha))
+ '("SPC" "a" "A" "b" "B" "p" "C-a"))))
+ (let (which-key-sort-uppercase-first)
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys) 'which-key-key-order-alpha))
+ '("SPC" "A" "a" "B" "b" "p" "C-a"))))
+ (let ((which-key-sort-uppercase-first t))
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys)
+ 'which-key-prefix-then-key-order))
+ '("SPC" "A" "B" "a" "b" "C-a" "p"))))
+ (let (which-key-sort-uppercase-first)
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys)
+ 'which-key-prefix-then-key-order))
+ '("SPC" "a" "b" "A" "B" "C-a" "p"))))
+ (let ((which-key-sort-uppercase-first t))
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys)
+ 'which-key-prefix-then-key-order-reverse))
+ '("p" "SPC" "A" "B" "a" "b" "C-a"))))
+ (let (which-key-sort-uppercase-first)
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys)
+ 'which-key-prefix-then-key-order-reverse))
+ '("p" "SPC" "a" "b" "A" "B" "C-a"))))
+ (let ((which-key-sort-uppercase-first t))
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys)
+ 'which-key-description-order))
+ '("p" "C-a" "SPC" "b" "B" "a" "A"))))
+ (let (which-key-sort-uppercase-first)
+ (should
+ (equal
+ (mapcar 'car (sort (copy-sequence keys)
+ 'which-key-description-order))
+ '("p" "C-a" "SPC" "b" "B" "a" "A"))))))
+
(provide 'which-key-tests)
;;; which-key-tests.el ends here
diff --git a/which-key.el b/which-key.el
index 09f5041..f7bab55 100644
--- a/which-key.el
+++ b/which-key.el
@@ -1315,14 +1315,24 @@ width) in lines and characters respectively."
;;; Sorting functions
(defun which-key--string< (a b &optional alpha)
- (let* ((da (downcase a))
- (db (downcase b)))
- (cond ((string-equal da db)
- (if which-key-sort-uppercase-first
- (string-lessp a b)
- (not (string-lessp a b))))
- (alpha (string-lessp da db))
- (t (string-lessp a b)))))
+ (let ((da (downcase a))
+ (db (downcase b)))
+ (cond
+ ((and alpha (not which-key-sort-uppercase-first))
+ (if (string-equal da db)
+ (string-lessp a b)
+ (string-lessp da db)))
+ ((and alpha which-key-sort-uppercase-first)
+ (if (string-equal da db)
+ (not (string-lessp a b))
+ (string-lessp da db)))
+ ((not which-key-sort-uppercase-first)
+ (let ((aup (not (string-equal da a)))
+ (bup (not (string-equal db b))))
+ (if (not (xor aup bup))
+ (string-lessp a b)
+ bup)))
+ (t (string-lessp a b)))))
(defun which-key--key-description< (a b &optional alpha)
"Sorting function used for `which-key-key-order' and
