bug#13948: no key-binding-locus

[Nicolas Richard <theonewiththeevillook@yahoo.fr>]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>> to be honest, I did it because (eq widget-global-map global-map) =>
>> t and I didn't want to see these two results everytime.
>
> Ah, good point.  I think a more general solution would be preferable,
> where we provide a list of "advertized vars" and if the keymap is found
> in this list, don't look via mapatoms.
>
> This list of advertized vars could be built dynamically mimicking
> current-active-maps.

I don't know how to do that. My problem is that when a minor or major
mode is defined, the symbol that holds the keymap is not stored afaics.
Thus when current-active-maps is run, the information is no more
accessible, and mimicking it doesn't bring me much.

I could make a list of (intern (format "%s-map" major-mode)) and (intern
(format "%s-map" minor-mode)) for currently active minor-modes and check
in those. But that will not solve the global map problem, so it still
needs some special casing.

>>> Could you turn it into a self-contained patch (e.g. move the yf/*
>>> functions to help*.el and rename it accordingly)?

My current suggestion is as follows.

--- a/lisp/help.el
+++ b/lisp/help.el
@@ -647,6 +647,48 @@ temporarily enables it to allow getting help on disabled items and buttons."
 	(princ (format "%s%s is undefined" key-desc mouse-msg))
       (princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
 
+(defun 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 (and
+            (not found)
+            (setq map (pop active-maps)))
+      (setq found (lookup-key
+                   map
+                   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))
+          (key-binding-keymap (vector 'remap found))
+        map))))
+
+(defun describe-key--binding-locus (key)
+  "Describe in which keymap KEY is defined.
+Return the description (a string) or nil."
+  (let ((map (key-binding-keymap key t)))
+    (if (eq map (current-global-map))
+        " (found in global map)"
+      (let ((symbols))
+        (mapatoms
+         (lambda (x)
+           (when (and (boundp x)
+                      ;; Avoid let-bound symbols
+                      (special-variable-p x)
+                      (eq (symbol-value x) map))
+             (push x symbols))))
+        (when symbols
+            (format " (found in %s)"
+                    (mapconcat #'symbol-name symbols ", ")))))))
+
 (defun describe-key (&optional key untranslated up-event)
   "Display documentation of the function invoked by KEY.
 KEY can be any kind of a key sequence; it can include keyboard events,
@@ -753,9 +795,8 @@ temporarily enables it to allow getting help on disabled items and buttons."
 	    (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))))))
       (with-help-window (help-buffer)
 	(princ (help-key-description key untranslated))
-	(princ (format "\
-%s runs the command %S, which is "
-		       mouse-msg defn))
+	(princ (format "%s runs the command %S%s, which is "
+		       mouse-msg defn (describe-key--binding-locus key)))
 	(describe-function-1 defn)
 	(when up-event
 	  (unless (or (null defn-up)


-- 
Nico.