[elpa] externals/which-key 90d10a8 33/51: Fix sorting of keys and add test

[Stefan Monnier]

branch: externals/which-key
commit 90d10a8fb335a21008084ab8b4ba722347ec6c74
Author: Justin Burkett <justin@burkett.cc>
Commit: Justin Burkett <justin@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