[elpa] externals/which-key 3b184d6 6/8: Simplify finding and matching replacements

[Stefan Monnier]

branch: externals/which-key
commit 3b184d6f0c78231f9e6c2ed95c2e8d218ae56fb8
Author: Justin Burkett <justin@burkett.cc>
Commit: Justin Burkett <justin@burkett.cc>

    Simplify finding and matching replacements
    
    Don't try to grab all matching replacements ahead of time, because later 
ones
    may not match if earlier ones make deletions.
    
    Fixes #202
---
 which-key.el | 82 ++++++++++++++++++++++++++++--------------------------------
 1 file changed, 38 insertions(+), 44 deletions(-)

diff --git a/which-key.el b/which-key.el
index 6661f76..21d159a 100644
--- a/which-key.el
+++ b/which-key.el
@@ -1401,29 +1401,18 @@ local bindings coming first. Within these categories 
order using
 (defsubst which-key--butlast-string (str)
   (mapconcat #'identity (butlast (split-string str)) " "))
 
-(defun which-key--get-replacements (key-binding &optional use-major-mode)
-  (let ((alist (or (and use-major-mode
-                        (cdr-safe
-                         (assq major-mode which-key-replacement-alist)))
-                   which-key-replacement-alist))
-        res case-fold-search)
-    (catch 'res
-      (dolist (replacement alist)
-        ;; these are mode specific ones to ignore. The mode specific case is
-        ;; handled in the selection of alist
-        (unless (symbolp (car replacement))
-          (let ((key-regexp (caar replacement))
-                (binding-regexp (cdar replacement)))
-            (when (and (or (null key-regexp)
-                           (string-match-p key-regexp
-                                           (car key-binding)))
-                       (or (null binding-regexp)
-                           (string-match-p binding-regexp
-                                           (cdr key-binding))))
-              (push replacement res)
-              (when (not which-key-allow-multiple-replacements)
-                (throw 'res res)))))))
-    (nreverse res)))
+(defun which-key--match-replacement (key-binding replacement)
+  ;; these are mode specific ones to ignore. The mode specific case is
+  ;; handled in the selection of alist
+  (when (and (consp key-binding) (not (symbolp (car replacement))))
+    (let ((key-regexp (caar replacement))
+          (binding-regexp (cdar replacement)))
+      (and (or (null key-regexp)
+               (string-match-p key-regexp
+                               (car key-binding)))
+           (or (null binding-regexp)
+               (string-match-p binding-regexp
+                               (cdr key-binding)))))))
 
 (defun which-key--get-pseudo-binding (key-binding &optional prefix)
   (let* ((pseudo-binding
@@ -1444,30 +1433,35 @@ local bindings coming first. Within these categories 
order using
   "Use `which-key--replacement-alist' to maybe replace KEY-BINDING.
 KEY-BINDING is a cons cell of the form \(KEY . BINDING\) each of
 which are strings. KEY is of the form produced by `key-binding'."
-  (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix)))
+  (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix))
+         one-match)
     (if pseudo-binding
         pseudo-binding
-      (let* ((mode-res (which-key--get-replacements key-binding t))
-             (all-repls (or mode-res
-                            (which-key--get-replacements key-binding))))
+      (let* ((all-repls (or (cdr-safe
+                             (assq major-mode which-key-replacement-alist))
+                            which-key-replacement-alist)))
         (dolist (repl all-repls key-binding)
-          (setq key-binding
-                (cond ((or (not (consp repl)) (null (cdr repl)))
-                       key-binding)
-                      ((functionp (cdr repl))
-                       (funcall (cdr repl) key-binding))
-                      ((consp (cdr repl))
-                       (cons
-                        (cond ((and (caar repl) (cadr repl))
-                               (replace-regexp-in-string
-                                (caar repl) (cadr repl) (car key-binding) t))
-                              ((cadr repl) (cadr repl))
-                              (t (car key-binding)))
-                        (cond ((and (cdar repl) (cddr repl))
-                               (replace-regexp-in-string
-                                (cdar repl) (cddr repl) (cdr key-binding) t))
-                              ((cddr repl) (cddr repl))
-                              (t (cdr key-binding))))))))))))
+          (when (and (or which-key-allow-multiple-replacements
+                         (not one-match))
+                     (which-key--match-replacement key-binding repl))
+            (setq one-match t)
+            (setq key-binding
+                  (cond ((or (not (consp repl)) (null (cdr repl)))
+                         key-binding)
+                        ((functionp (cdr repl))
+                         (funcall (cdr repl) key-binding))
+                        ((consp (cdr repl))
+                         (cons
+                          (cond ((and (caar repl) (cadr repl))
+                                 (replace-regexp-in-string
+                                  (caar repl) (cadr repl) (car key-binding) t))
+                                ((cadr repl) (cadr repl))
+                                (t (car key-binding)))
+                          (cond ((and (cdar repl) (cddr repl))
+                                 (replace-regexp-in-string
+                                  (cdar repl) (cddr repl) (cdr key-binding) t))
+                                ((cddr repl) (cddr repl))
+                                (t (cdr key-binding)))))))))))))
 
 (defsubst which-key--current-key-list (&optional key-str)
   (append (listify-key-sequence (which-key--current-prefix))