bug#13948: no key-binding-locus

[Nicolas Richard]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> I'd welcome a change in C-h k to try and show where the binding comes
> from, and it'd be OK to implement it with the kind of code you showed
> (i.e. something not 100% reliable).

Here's an update which covers more cases.

I also provide a rough patch for help-fns--key-bindings to show the
keymap in C-h k.

(defun yf/find-object-in-variables (object &optional pred)
  "Find all symbols (variables) whose content is the same as OBJECT.
PRED defaults to `eq'"
  (unless pred (setq pred #'eq))
  (let ((result))
    (mapatoms (lambda (x)
                (when (and (boundp x)
                           (funcall pred (symbol-value x) object))
                  (push x result))))
    result))

(defun yf/key-binding-keymap (key &optional accept-default no-remap _position)
  "Determine in which keymap KEY is defined.
When the key was found, return an active keymap in which it was
found."
  (let ((active-maps (current-active-maps t))
        map found)
    ;; we loop over active maps like key-binding does.
    (while (not found)
      (setq found (lookup-key
                   (setq map (pop active-maps))
                   key
                   accept-default))
      (when (integerp found)
        ;; prefix was found but not the whole sequence
        (setq found nil)))
    (when found
      (if (and (symbolp found)
               (not no-remap)
               (command-remapping found))
          (yf/key-binding-keymap (vector 'remap found))
        map))))

(defun yf/key-binding-locus (key)
  "Determine in which keymap KEY is defined.
Return value is :
- nil if KEY was not found or we couldn't determine
  which symbols holds the keymap that defines it.
- t if KEY was found in the current global map
- a list of symbols whose value cell holds a keymap in which the
  binding was found when searching the active keymaps. "
  (let ((map (yf/key-binding-keymap key t)))
    (if (eq map (current-global-map))
        t
      (yf/find-object-in-variables map))))



--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -314,7 +314,16 @@ suitable file is found, return nil."
               ;; If lots of ordinary text characters run this command,
               ;; don't mention them one by one.
               (if (< (length non-modified-keys) 10)
-                  (princ (mapconcat 'key-description keys ", "))
+                  (princ (mapconcat
+                          (lambda (k)
+                            "Describe key and its originating keymap"
+                            (let ((keymaps (yf/key-binding-locus k)))
+                              (concat
+                               (key-description k)
+                               (when (and keymaps
+                                          (listp keymaps))
+                                 (format " %S" keymaps)))))
+                          keys ", "))
                 (dolist (key non-modified-keys)
                   (setq keys (delq key keys)))
                 (if keys

-- 
Nico.