Add which-key-add-keymap-based-replacements

This is an alternative to advising define-key using
which-key-enable-extended-define-key, but functions the same beneath the
surface.

Ref #226 #261

2 files changed, 74 insertions, 14 deletions

diff --git a/README.org b/README.org
index cb31655237b..c335e457b30 100644
--- a/README.org
+++ b/README.org
@@ -4,6 +4,11 @@
 
 ** Recent Changes
 
+*** 2020-08-28: Added =which-key-add-keymap-based-replacements=
+    This function provides an alternative interface allowing replacements to be
+    stored directly in keymaps, allowing one to avoid using
+    =which-key-replacement-alist=, which may cause performance issues when it
+    gets very big.
 *** 2019-08-01: Added =which-key-show-early-on-C-h=
     Allows one to trigger =which-key= on demand, rather than automatically. See
     the docstring and [[#manual-activation][Manual Activation]].
@@ -29,6 +34,7 @@
 ** Table of Contents                                                  :TOC_3:
 - [[#which-key][which-key]]
   - [[#recent-changes][Recent Changes]]
+    - [[#2020-08-28-added-which-key-add-keymap-based-replacements][2020-08-28: Added =which-key-add-keymap-based-replacements=]]
     - [[#2019-08-01-added-which-key-show-early-on-c-h][2019-08-01: Added =which-key-show-early-on-C-h=]]
     - [[#2017-12-13-added-which-key-enable-extended-define-key][2017-12-13: Added =which-key-enable-extended-define-key=]]
     - [[#2017-11-13-added-which-key-show-major-mode][2017-11-13: Added =which-key-show-major-mode=]]
@@ -255,7 +261,7 @@
     idea of behind each alist is that you specify a selection string in the
     =car= of each cons cell and the replacement string in the =cdr=.
 
-**** Automatic
+**** Automatic ("keymap-based") replacement
      A newer option is to set =which-key-enable-extended-define-key= which
      advises =define-key= to allow which-key to pre-process its arguments. The
      statement
@@ -273,6 +279,26 @@
      (define-key some-map "b" '("bar-prefix"))
      #+END_SRC
 
+     If you do not want to enable the advise on =define-key=, you may also use
+     =which-key-add-keymap-based-replacements=. The above examples can be
+     alternatively written as
+
+     #+BEGIN_SRC emacs-lisp
+     (which-key-add-keymap-based-replacements some-map
+       "f" '("foo" . long-name-for-command-foo)
+       ;; or
+       ;; "f" "foo"
+       "b" '("bar-prefix")
+       ;; or
+       ;; "b" "bar-prefix"
+     )
+     #+END_SRC
+
+     Note that while the alternative methods below use
+     =which-key-replacement-alist=, the "keymap-based" replacements store
+     replacements in the keymaps themselves, so should avoid performance issues
+     when =which-key-replacement-alist= becomes very large.
+
 **** "Key-Based" replacement
      Using this method, the description of a key is replaced using a string that
      you provide. Here's an example
diff --git a/which-key.el b/which-key.el
index 766c8f1f86a..6eb8e359959 100644
--- a/which-key.el
+++ b/which-key.el
@@ -913,6 +913,41 @@ but more functional."
 ;;; Helper functions to modify replacement lists.
 
 ;;;###autoload
+(defun which-key-add-keymap-based-replacements (keymap key replacement &rest more)
+  "Replace the description of KEY using REPLACEMENT in KEYMAP.
+KEY should take a format suitable for use in
+`kbd'. REPLACEMENT is the string to use to describe the
+command associated with KEY in the KEYMAP. You may also use a
+cons cell of the form \(STRING . COMMAND\) for each REPLACEMENT,
+where STRING is the replacement string and COMMAND is a symbol
+corresponding to the intended command to be replaced. In the
+latter case, which-key will verify the intended command before
+performing the replacement. COMMAND should be nil if the binding
+corresponds to a key prefix. For example,
+
+\(which-key-add-keymap-based-replacements global-map
+  \"C-x w\" \"Save as\"\)
+
+and
+
+\(which-key-add-keymap-based-replacements global-map
+  \"C-x w\" '\(\"Save as\" . write-file\)\)
+
+both have the same effect for the \"C-x C-w\" key binding, but
+the latter causes which-key to verify that the key sequence is
+actually bound to write-file before performing the replacement."
+  (while key
+    (let ((string (if (stringp replacement)
+                      replacement
+                    (car-safe replacement)))
+          (command (cdr-safe replacement)))
+      (define-key keymap (which-key--pseudo-key (kbd key))
+        `(which-key ,(cons string command))))
+    (setq key (pop more)
+          replacement (pop more))))
+(put 'which-key-add-keymap-based-replacements 'lisp-indent-function 'defun)
+
+;;;###autoload
 (defun which-key-add-key-based-replacements
     (key-sequence replacement &rest more)
   "Replace the description of KEY-SEQUENCE with REPLACEMENT.
@@ -1462,19 +1497,18 @@ local bindings coming first. Within these categories order using
                                (cdr key-binding)))))))
 
 (defun which-key--get-pseudo-binding (key-binding &optional prefix)
-  (let* ((pseudo-binding
-          (key-binding (which-key--pseudo-key (kbd (car key-binding)) prefix)))
-         (pseudo-binding (when pseudo-binding (cadr pseudo-binding)))
-         (pseudo-desc (when pseudo-binding (car pseudo-binding)))
-         (pseudo-def (when pseudo-binding (cdr pseudo-binding)))
-         (real-def (key-binding (kbd (car key-binding))))
-         ;; treat keymaps as if they're nil bindings. This creates the
-         ;; possibility that we rename the wrong binding but this seems
-         ;; unlikely.
-         (real-def (unless (keymapp real-def) real-def)))
-    (when (and pseudo-binding
-               (eq pseudo-def real-def))
-      (cons (car key-binding) pseudo-desc))))
+  (let* ((key (kbd (car key-binding)))
+         (pseudo-binding (key-binding (which-key--pseudo-key key prefix))))
+    (when pseudo-binding
+      (let* ((command-replacement (cadr pseudo-binding))
+             (pseudo-desc (car command-replacement))
+             (pseudo-def (cdr command-replacement)))
+        (when (and (stringp pseudo-desc)
+                   (or (null pseudo-def)
+                       ;; don't verify keymaps
+                       (keymapp pseudo-def)
+                       (eq pseudo-def (key-binding key))))
+          (cons (car key-binding) pseudo-desc))))))
 
 (defsubst which-key--replace-in-binding (key-binding repl)
   (cond ((or (not (consp repl)) (null (cdr repl)))