bug#13948: no key-binding-locus

bug#13948: no key-binding-locus

[Brian Malehorn]

[-- Attachment #1: Type: text/plain, Size: 1281 bytes --]

Why isn't there a key equivalent to variable-binding-locus? As
in, a way to figure out where a particular keybinding is coming
from. For example,

    M-x key-binding-locus C-j

would evaluate to 'lisp-interaction-mode-map, which is the first
map in which C-j was found.


In terms of implementation, the process for finding a binding is
described in (info "(elisp) Searching Keymaps"):

    ...Here is a pseudo-Lisp description of the order and
    conditions for searching them:

     (or (cond
          (overriding-terminal-local-map
           (FIND-IN overriding-terminal-local-map))
          (overriding-local-map
           (FIND-IN overriding-local-map))
          ((or (FIND-IN (get-char-property (point) 'keymap))
       (FIND-IN-ANY emulation-mode-map-alists)
       (FIND-IN-ANY minor-mode-overriding-map-alist)
       (FIND-IN-ANY minor-mode-map-alist)
       (if (get-text-property (point) 'local-map)
           (FIND-IN (get-char-property (point) 'local-map))
         (FIND-IN (current-local-map))))))
         (FIND-IN (current-global-map)))

So implementing key-binding-locus would only be a small tweak of
the key lookup code: the first time you find the key, just return
the map you found it in, rather than the command it's supposed to
call.

Thanks,
Brian

[-- Attachment #2: Type: text/html, Size: 2069 bytes --]

bug#13948: no key-binding-locus

[Josh]

On Wed, Mar 13, 2013 at 1:34 PM, Brian Malehorn <bmalehorn@gmail.com> wrote:
> Why isn't there a key equivalent to variable-binding-locus? As
> in, a way to figure out where a particular keybinding is coming
> from. For example,
>
>     M-x key-binding-locus C-j
>
> would evaluate to 'lisp-interaction-mode-map, which is the first
> map in which C-j was found.

+1.  The hierarchy, search order, and precedence of Emacs' various
keymaps and key translation mechanisms is complex and in my experience
seldom well understood by users.  This often manifests as confusion
about why global-set-key or local-set-key forms that users have added
to their init files do not have the expected effects.

The documentation that Brian quoted below doesn't seem very useful to
a typical Emacs user trying to troubleshoot key binding problems.  One
reason is that while the mechanisms for binding keys are described in
the Emacs manual[0], the key binding lookup procedure is not described
therein, but instead in the Elisp manual[1] where it is likely to be
overlooked.  A second reason is that even for those users who do
manage to find that info node, perhaps with info-apropos for example,
a "pseudo Lisp" description is not very helpful to users who don't
know Lisp.

I think the command Brian suggested would help average users with
little to no Elisp knowledge to debug key binding problems, especially
if it supported optionally showing all of the keymaps that were
searched in the process.

It would also be helpful for describe-key to show the governing keymap
and to disclose the existence and location of any shadowed key
bindings, something like this:

  C-c { runs the command some-foo-mode-command, which is an interactive
  autoloaded compiled Lisp function bound by `foo-mode.el' in `foo-mode-map'.

  It is bound to C-c {[, any other non-shadowed bindings]

  Shadowed C-c { bindings in other keymaps:
    bar-minor-mode-command (bound by `bar-mode.el' in `bar-mode-map'.
    my-func (bound by `init.el' in `global-map')

  [remainder of standard describe-key output follows]

Josh

[0] (info "(emacs) Key Bindings")
[1] (info "(elisp) Searching Keymaps")

> In terms of implementation, the process for finding a binding is
> described in (info "(elisp) Searching Keymaps"):
>
>     ...Here is a pseudo-Lisp description of the order and
>     conditions for searching them:
>
>      (or (cond
>           (overriding-terminal-local-map
>            (FIND-IN overriding-terminal-local-map))
>           (overriding-local-map
>            (FIND-IN overriding-local-map))
>           ((or (FIND-IN (get-char-property (point) 'keymap))
>        (FIND-IN-ANY emulation-mode-map-alists)
>        (FIND-IN-ANY minor-mode-overriding-map-alist)
>        (FIND-IN-ANY minor-mode-map-alist)
>        (if (get-text-property (point) 'local-map)
>            (FIND-IN (get-char-property (point) 'local-map))
>          (FIND-IN (current-local-map))))))
>          (FIND-IN (current-global-map)))

bug#13948: no key-binding-locus

[Nicolas Richard]

Brian Malehorn <bmalehorn@gmail.com> writes:
> Why isn't there a key equivalent to variable-binding-locus? As
> in, a way to figure out where a particular keybinding is coming
> from. For example,

> So implementing key-binding-locus would only be a small tweak of
> the key lookup code: the first time you find the key, just return
> the map you found it in, rather than the command it's supposed to
> call.

IIUC, it's slightly more complicated than just modifying the return
value of a function. One reason is that "finding active keymaps" and
"looking up keys in keymaps" are done by different bits of the code. By
the time keys are being looked up, we don't know where they keymaps came
from anymore. Another reason is that some keymaps might not even be
stored in any variable (symbol's value cell) at all.

Anyway, here's some code that seems to work in some cases (but not when
the command was remapped, and not for finding where a mouse event is
bound). First is a helper function, then the actual function. Not the
cleanest code, but good enough for my .emacs.

(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-locus (key)
  "Return a list of symbols whose value is the active keymap
which holds a binding for the given KEY."
  (interactive "KKey seq: ")
  (let ((active-maps (current-active-maps t))
        map found)
    ;; we loop over active-maps like key-binding does.
    (while (not
            (setq found
                  (lookup-key
                   (setq map
                         (pop active-maps))
                   key
                   t)))
      ;; do nothing
      )
    (if (not found)
        (message "Key not found (which is weird, if you want my opinion).")
      (if (and (symbolp found) (command-remapping found))
          ;; fixme. We should mimic command-remapping ?
          (message "Found key but it got remapped and I don't know how to search that.")
        (let ((res (yf/find-object-in-variables map)))
          (if res
              (message "Found key (bound to %s) in a keymap bound to: %S"
                       found
                       res)
            (message "Found key (bound to %s) in a keymap which isn't in any variable."
                     found)))))))

-- 
Nico.

bug#13948: no key-binding-locus

[Stefan Monnier]

>> So implementing key-binding-locus would only be a small tweak of
>> the key lookup code: the first time you find the key, just return
>> the map you found it in, rather than the command it's supposed to
>> call.
> IIUC, it's slightly more complicated than just modifying the return
> value of a function.

Indeed, the code was not written with this in mind.  E.g. looking up
"C-c C-s" first looks up "C-c" which returns a new keymap which combines
the C-c part of all the active keymaps, and then we lookup C-s in that
"composed" map.

Tracking the origin would require changing the data representation
(which is visible to ELisp), so it could be tricky to do without
breaking compatibility (tho we do such risky changes on a regular
basis ;-)

> Another reason is that some keymaps might not even be stored in any
> variable (symbol's value cell) at all.

Yes, keeping track of the original keymap in which the binding is found
is one thing, but keeping track of where that keymap is coming from is
yet another.

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).


        Stefan

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.

bug#13948: no key-binding-locus

[Stefan Monnier]

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

Thanks.  But I think this is too wordy.  We only want to show the locus
for C-h k and not for C-h f (and only show it for the particular key
sequence used).

>   (let ((map (yf/key-binding-keymap key t)))
>     (if (eq map (current-global-map))
>         t
>       (yf/find-object-in-variables map))))

Why do we need to treat the global map specially?

> +                            "Describe key and its originating keymap"

Please punctuate your docstrings.

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


        Stefan

bug#13948: no key-binding-locus

[Nicolas Richard]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:
>>   (let ((map (yf/key-binding-keymap key t)))
>>     (if (eq map (current-global-map))
>>         t
>>       (yf/find-object-in-variables map))))
>
> Why do we need to treat the global map specially?

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.

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

Will do.

-- 
Nico.

bug#13948: no key-binding-locus

[Stefan Monnier]

> 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.

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

Thanks,


        Stefan

bug#13948: no key-binding-locus

[Nicolas Richard]

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.

bug#13948: no key-binding-locus

[Stefan Monnier]

>> This list of advertized vars could be built dynamically mimicking
>> current-active-maps.
> I don't know how to do that.

You need to do it heuristically.
E.g. the list would look like

    (list 'global-map (intern (format "%s-map" major-mode)) ...)

> 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.

That's right.

> But that will not solve the global map problem, so it still
> needs some special casing.

The global map should be in `global-map'.


        Stefan

bug#13948: no key-binding-locus

[Nicolas Richard]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> This list of advertized vars could be built dynamically mimicking
>>> current-active-maps.

Here's another attempt. Like the previous patch, I define
key-binding-keymap which finds the keymap by mimicking key-binding, and
describe-key--binding-locus which matches the keymap to a symbol and
makes a description suitable for describe-key.

Sorry it is a bit lengthy but I'm afraid I don't know better.

diff --git a/lisp/help.el b/lisp/help.el
index 72a9524..9721fcf 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -647,6 +647,74 @@ 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)
+  "Return a keymap holding a binding for KEY within current keymaps.
+The effect of the arguments KEY, ACCEPT-DEFAULT, NO-REMAP and
+POSITION is as documented in the function `key-binding'."
+  (let* ((active-maps (current-active-maps t position))
+         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 position)
+  "Describe in which keymap KEY is defined.
+Return the description (a string)."
+  (or
+   (let ((map (key-binding-keymap key t nil position)))
+     (when map
+       (let ((advertised-syms (nconc
+                               (list 'overriding-terminal-local-map
+                                     'overriding-local-map)
+                               (delq nil
+                                     (mapcar
+                                      (lambda (mode)
+                                        (when
+                                            (symbol-value mode)
+                                          (intern
+                                           (format "%s-map" mode))))
+                                      minor-mode-list)) 
+                               (list 'global-map
+                                     (intern (format "%s-map" major-mode)))))
+             found)
+         ;; look into these advertised symbols first
+         (while (and (not found) advertised-syms)
+           (let ((sym (pop advertised-syms)))
+             (setq found
+                   (when (and
+                          (boundp sym)
+                          (eq map (symbol-value sym)))
+                     sym))))
+         ;; only look in other symbols otherwise
+         (when (not found)
+           (mapatoms
+            (lambda (x)
+              (when (and (boundp x)
+                         ;; avoid let-bound symbols
+                         (special-variable-p x)
+                         (eq (symbol-value x) map))
+                (push x found))))
+           (when (and (consp found)
+                      (null (cdr found)))
+             (setq found (car found))))
+         (when found
+           (format " (found in %s)" found)))))
+   ""))
+
 (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,
@@ -709,6 +777,7 @@ temporarily enables it to allow getting help on disabled items and buttons."
 	 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
 			    (memq 'drag modifiers)) " at that spot" ""))
 	 (defn (key-binding key t))
+         key-locus key-locus-up key-locus-up-tricky
 	 defn-up defn-up-tricky ev-type
 	 mouse-1-remapped mouse-1-tricky)
 
@@ -747,15 +816,17 @@ temporarily enables it to allow getting help on disabled items and buttons."
 		   (setcar up-event (elt mouse-1-remapped 0)))
 		  (t (setcar up-event 'mouse-2))))
 	  (setq defn-up (key-binding sequence nil nil (event-start up-event)))
+          (setq key-locus-up (describe-key--binding-locus sequence (event-start up-event)))
 	  (when mouse-1-tricky
 	    (setq sequence (vector up-event))
 	    (aset sequence 0 'mouse-1)
-	    (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))))))
+	    (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))
+            (setq key-locus-up-tricky (describe-key--binding-locus sequence (event-start up-event))))))
+      (setq key-locus (describe-key--binding-locus key (event-start 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 key-locus))
 	(describe-function-1 defn)
 	(when up-event
 	  (unless (or (null defn-up)
@@ -765,13 +836,13 @@ temporarily enables it to allow getting help on disabled items and buttons."
 
 ----------------- up-event %s----------------
 
-%s%s%s runs the command %S, which is "
+%s%s%s runs the command %S%s, which is "
 			   (if mouse-1-tricky "(short click) " "")
 			   (key-description (vector up-event))
 			   mouse-msg
 			   (if mouse-1-remapped
                                " is remapped to <mouse-2>, which" "")
-			   defn-up))
+			   defn-up key-locus-up))
 	    (describe-function-1 defn-up))
 	  (unless (or (null defn-up-tricky)
 		      (integerp defn-up-tricky)
@@ -781,10 +852,10 @@ temporarily enables it to allow getting help on disabled items and buttons."
 ----------------- up-event (long click) ----------------
 
 Pressing <%S>%s for longer than %d milli-seconds
-runs the command %S, which is "
+runs the command %S%s, which is "
 			   ev-type mouse-msg
 			   mouse-1-click-follows-link
-			   defn-up-tricky))
+			   defn-up-tricky key-locus-up-tricky))
 	    (describe-function-1 defn-up-tricky)))))))
 \f
 (defun describe-mode (&optional buffer)

-- 
Nico.

bug#13948: no key-binding-locus

[Stefan Monnier]

> Here's another attempt. Like the previous patch, I define
> key-binding-keymap which finds the keymap by mimicking key-binding, and
> describe-key--binding-locus which matches the keymap to a symbol and
> makes a description suitable for describe-key.

Looks pretty good.  Feel free to install it into `trunk'.
See some nitpicks below.

> +(defun key-binding-keymap (key &optional accept-default no-remap position)

Please name it (and all the functions/vars you add in help*.el) with
a leading "help-".  I'd name it help--key-binding-keymap.

> +  "Return a keymap holding a binding for KEY within current keymaps.
> +The effect of the arguments KEY, ACCEPT-DEFAULT, NO-REMAP and
> +POSITION is as documented in the function `key-binding'."
> +  (let* ((active-maps (current-active-maps t position))
> +         map found)
> +    ;; we loop over active maps like key-binding does.

Please capitalize your comments.

> +      (setq found (lookup-key
> +                   map
> +                   key
> +                   accept-default))

I think this all fits on a single line.

> +      (when (integerp found)
> +        ;; prefix was found but not the whole sequence
> +        (setq found nil)))

If key-binding returned a command, then we should never hit this case.
It's OK to keep the code, but you might like to add a comment mentioning
that we don't expect this case to happen.

> +    (when found
> +      (if (and (symbolp found)
> +               (not no-remap)
> +               (command-remapping found))
> +          (key-binding-keymap (vector 'remap found))

Please add a comment here mentioning that to be really thorough, in the
remap case the use would like to know in which map the final command was
found but also in which map the remapping was found.

> +                                     (mapcar
> +                                      (lambda (mode)
> +                                        (when
> +                                            (symbol-value mode)
> +                                          (intern
> +                                           (format "%s-map" mode))))
> +                                      minor-mode-list))

Use minor-mode-map-alist instead (which requires a tweak to the body
of the mapcar, of course).

Also I'd use intern-soft here (tho it probably doesn't make any
difference in practice, here).

> +         ;; look into these advertised symbols first
> +         (while (and (not found) advertised-syms)
> +           (let ((sym (pop advertised-syms)))
> +             (setq found
> +                   (when (and
> +                          (boundp sym)
> +                          (eq map (symbol-value sym)))
> +                     sym))))
> +         ;; only look in other symbols otherwise
> +         (when (not found)
> +           (mapatoms
> +            (lambda (x)
> +              (when (and (boundp x)
> +                         ;; avoid let-bound symbols
> +                         (special-variable-p x)
> +                         (eq (symbol-value x) map))
> +                (push x found))))
> +           (when (and (consp found)
> +                      (null (cdr found)))
> +             (setq found (car found))))

I think this code will be simpler if you use catch/throw (you can then
use dolist over advertised-syms, for example and you don't need `found').

> +         (when found
> +           (format " (found in %s)" found)))))
> +   ""))

I think it's better to make this function return the symbol rather than
a string, and let the caller turn it into a string.


        Stefan

bug#13948: no key-binding-locus

[Nicolas Richard]

[-- Attachment #1: Type: text/plain, Size: 2229 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Here's another attempt. Like the previous patch, I define
>> key-binding-keymap which finds the keymap by mimicking key-binding, and
>> describe-key--binding-locus which matches the keymap to a symbol and
>> makes a description suitable for describe-key.
>
> Looks pretty good.  Feel free to install it into `trunk'.

I can send a patch, including a ChangeLog entry, but I don't have
permission to commit.

>> +      (when (integerp found)
>> +        ;; prefix was found but not the whole sequence
>> +        (setq found nil)))
>
> If key-binding returned a command, then we should never hit this case.
> It's OK to keep the code, but you might like to add a comment mentioning
> that we don't expect this case to happen.

We do hit the case, because we look in active keymaps one by one,
instead of using the keymap (cons 'keymap active-keymaps) like
key-binding does.

>> +         ;; look into these advertised symbols first
>> +         (while (and (not found) advertised-syms)
>> +           (let ((sym (pop advertised-syms)))
>> +             (setq found
>> +                   (when (and
>> +                          (boundp sym)
>> +                          (eq map (symbol-value sym)))
>> +                     sym))))
>> +         ;; only look in other symbols otherwise
>> +         (when (not found)
>> +           (mapatoms
>> +            (lambda (x)
>> +              (when (and (boundp x)
>> +                         ;; avoid let-bound symbols
>> +                         (special-variable-p x)
>> +                         (eq (symbol-value x) map))
>> +                (push x found))))
>> +           (when (and (consp found)
>> +                      (null (cdr found)))
>> +             (setq found (car found))))
>
> I think this code will be simpler if you use catch/throw (you can then
> use dolist over advertised-syms, for example and you don't need
> `found').

Shall I return only the first symbol that matches, also in the mapatoms
case ? I assume yes because of your next suggestion :

> I think it's better to make this function return the symbol rather than
> a string, and let the caller turn it into a string.

Ok.

Here's the patch.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-describe-key-mention-the-keymap-in-which-the-binding.patch --]
[-- Type: text/x-diff, Size: 7274 bytes --]

>From 685224012675c7b608ad67825cb7ff4d88ce8392 Mon Sep 17 00:00:00 2001
From: Nicolas Richard <theonewiththeevillook@yahoo.fr>
Date: Tue, 10 Jun 2014 20:06:27 +0200
Subject: [PATCH] describe-key: mention the keymap in which the binding was
 found.

* help.el (help--key-binding-keymap): New function.
(help--binding-locus): New function.
(describe-key): Mention the keymap in which the binding was found.
---
 lisp/ChangeLog |  6 ++++
 lisp/help.el   | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++++------
 2 files changed, 84 insertions(+), 8 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2f40577..9912407 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2014-06-11  Nicolas Richard  <theonewiththeevillook@yahoo.fr>
+
+	* help.el (help--key-binding-keymap): New function.
+	(help--binding-locus): New function.
+	(describe-key): Mention the keymap in which the binding was found.
+
 2014-05-26  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Include sources used to create macuvs.h.
diff --git a/lisp/help.el b/lisp/help.el
index 72a9524..0effdfa 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -647,6 +647,67 @@ 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 help--key-binding-keymap (key &optional accept-default no-remap position)
+  "Return a keymap holding a binding for KEY within current keymaps.
+The effect of the arguments KEY, ACCEPT-DEFAULT, NO-REMAP and
+POSITION is as documented in the function `key-binding'."
+  (let* ((active-maps (current-active-maps t position))
+         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))
+          ;; The user might want to know in which map the binding is
+          ;; found, or in which map the remapping is found. The
+          ;; default is to show where the remapping is done.
+          (key-binding-keymap (vector 'remap found))
+        map))))
+
+(defun help--binding-locus (key position)
+  "Describe in which keymap KEY is defined.
+Return a symbol pointing to that keymap if one exists ; otherwise
+return nil."
+  (let ((map (key-binding-keymap key t nil position)))
+    (when map
+      (catch 'found
+        (let ((advertised-syms (nconc
+                                (list 'overriding-terminal-local-map
+                                      'overriding-local-map)
+                                (delq nil
+                                      (mapcar
+                                       (lambda (mode-and-map)
+                                         (let ((mode (car mode-and-map)))
+                                           (when (symbol-value mode)
+                                             (intern-soft
+                                              (format "%s-map" mode)))))
+                                       minor-mode-map-alist))
+                                (list 'global-map
+                                      (intern-soft (format "%s-map" major-mode)))))
+              found)
+          ;; Look into these advertised symbols first.
+          (dolist (sym advertised-syms)
+            (when (and
+                   (boundp sym)
+                   (eq map (symbol-value sym)))
+              (throw 'found sym)))
+          ;; Only look in other symbols otherwise.
+          (mapatoms
+           (lambda (x)
+             (when (and (boundp x)
+                        ;; Avoid let-bound symbols.
+                        (special-variable-p x)
+                        (eq (symbol-value x) map))
+               (throw 'found x))))
+          nil)))))
+
 (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,
@@ -709,6 +770,7 @@ temporarily enables it to allow getting help on disabled items and buttons."
 	 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
 			    (memq 'drag modifiers)) " at that spot" ""))
 	 (defn (key-binding key t))
+         key-locus key-locus-up key-locus-up-tricky
 	 defn-up defn-up-tricky ev-type
 	 mouse-1-remapped mouse-1-tricky)
 
@@ -747,15 +809,19 @@ temporarily enables it to allow getting help on disabled items and buttons."
 		   (setcar up-event (elt mouse-1-remapped 0)))
 		  (t (setcar up-event 'mouse-2))))
 	  (setq defn-up (key-binding sequence nil nil (event-start up-event)))
+          (setq key-locus-up (help--binding-locus sequence (event-start up-event)))
 	  (when mouse-1-tricky
 	    (setq sequence (vector up-event))
 	    (aset sequence 0 'mouse-1)
-	    (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))))))
+	    (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))
+            (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event))))))
+      (setq key-locus (help--binding-locus key (event-start 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 (if key-locus
+                                          (format " (found in %s)" key-locus)
+                                        "")))
 	(describe-function-1 defn)
 	(when up-event
 	  (unless (or (null defn-up)
@@ -765,13 +831,15 @@ temporarily enables it to allow getting help on disabled items and buttons."
 
 ----------------- up-event %s----------------
 
-%s%s%s runs the command %S, which is "
+%s%s%s runs the command %S%s, which is "
 			   (if mouse-1-tricky "(short click) " "")
 			   (key-description (vector up-event))
 			   mouse-msg
 			   (if mouse-1-remapped
                                " is remapped to <mouse-2>, which" "")
-			   defn-up))
+			   defn-up (if key-locus-up
+                                       (format " (found in %s)" key-locus-up)
+                                     "")))
 	    (describe-function-1 defn-up))
 	  (unless (or (null defn-up-tricky)
 		      (integerp defn-up-tricky)
@@ -781,10 +849,12 @@ temporarily enables it to allow getting help on disabled items and buttons."
 ----------------- up-event (long click) ----------------
 
 Pressing <%S>%s for longer than %d milli-seconds
-runs the command %S, which is "
+runs the command %S%s, which is "
 			   ev-type mouse-msg
 			   mouse-1-click-follows-link
-			   defn-up-tricky))
+			   defn-up-tricky (if key-locus-up-tricky
+                                              (format " (found in %s)" key-locus-up-tricky)
+                                            "")))
 	    (describe-function-1 defn-up-tricky)))))))
 \f
 (defun describe-mode (&optional buffer)
-- 
2.0.0



[-- Attachment #3: Type: text/plain, Size: 11 bytes --]


-- 
Nico.

bug#13948: no key-binding-locus

[Stefan Monnier]

>> Looks pretty good.  Feel free to install it into `trunk'.
> I can send a patch, including a ChangeLog entry, but I don't have
> permission to commit.

Hmm... any hope we could fix this problem?  E.g. request membership in
the "emacs" group from your savannah account?

>>> +      (when (integerp found)
>>> +        ;; prefix was found but not the whole sequence
>>> +        (setq found nil)))
>> If key-binding returned a command, then we should never hit this case.
>> It's OK to keep the code, but you might like to add a comment mentioning
>> that we don't expect this case to happen.
> We do hit the case, because we look in active keymaps one by one,
> instead of using the keymap (cons 'keymap active-keymaps) like
> key-binding does.

Hmm... I know the two are very slightly different, so there are odd
corner cases, but I'd be curious to know in which circumstance you
bumped into it.  Might actually point to a bug somewhere.

> Shall I return only the first symbol that matches, also in the mapatoms
> case ? I assume yes because of your next suggestion :

Yes.

> Here's the patch.

Thanks,


        Stefan

bug#13948: no key-binding-locus

[Nicolas Richard]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> Looks pretty good.  Feel free to install it into `trunk'.
>> I can send a patch, including a ChangeLog entry, but I don't have
>> permission to commit.
>
> Hmm... any hope we could fix this problem?  E.g. request membership in
> the "emacs" group from your savannah account?

I have now done that.

> Hmm... I know the two are very slightly different, so there are odd
> corner cases, but I'd be curious to know in which circumstance you
> bumped into it.

Sure.
(lookup-key lisp-interaction-mode-map (kbd "C-x C-f") t)
=> 1
I'm a bit surprised, I thought that in this situation this would return
non-nil, but I'm wrong :
(lookup-key lisp-interaction-mode-map (kbd "C-x") t)
=> nil

-- 
Nico.

bug#13948: no key-binding-locus

[Stefan Monnier]

> (lookup-key lisp-interaction-mode-map (kbd "C-x C-f") t)
> => 1

Duh!  Right!  Sorry, I was completely confused, this integer is used
when we're past nil, so yes it can happen very often.  Thanks.


        Stefan

bug#13948: no key-binding-locus

[Nicolas Richard]

Nicolas Richard <theonewiththeevillook@yahoo.fr> writes:
> (lookup-key lisp-interaction-mode-map (kbd "C-x C-f") t)
> => 1
> I'm a bit surprised, I thought that in this situation this would return
> non-nil, but I'm wrong :
> (lookup-key lisp-interaction-mode-map (kbd "C-x") t)
> => nil

For the record, my surprise is gone : the return value 1 means that
"C-x" is not a prefix in the given keymap. I thought it meant "C-x" was
bound to something. I'll amend my comment : I think using the word
"prefix" was misleading.

-- 
Nico.

bug#13948: no key-binding-locus

[Nicolas Richard]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> Here's another attempt. Like the previous patch, I define
>> key-binding-keymap which finds the keymap by mimicking key-binding, and
>> describe-key--binding-locus which matches the keymap to a symbol and
>> makes a description suitable for describe-key.
>
> Looks pretty good.  Feel free to install it into `trunk'.

It seems I have done that in revision 117324 (thanks to vc.el)

-- 
Nico.