Package: emacs;
Reported by: Brian Malehorn <bmalehorn <at> gmail.com>
Date: Wed, 13 Mar 2013 21:22:02 UTC
Severity: wishlist
Done: Nicolas Richard <theonewiththeevillook <at> yahoo.fr>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Nicolas Richard <theonewiththeevillook <at> yahoo.fr> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: Nicolas Richard <theonewiththeevillook <at> yahoo.fr>, 13948 <at> debbugs.gnu.org, Brian Malehorn <bmalehorn <at> gmail.com> Subject: bug#13948: no key-binding-locus Date: Wed, 11 Jun 2014 13:23:17 +0200
[Message part 1 (text/plain, inline)]
Stefan Monnier <monnier <at> 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.
[0001-describe-key-mention-the-keymap-in-which-the-binding.patch (text/x-diff, inline)]
>From 685224012675c7b608ad67825cb7ff4d88ce8392 Mon Sep 17 00:00:00 2001
From: Nicolas Richard <theonewiththeevillook <at> 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 <at> 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 <at> 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)))))))
(defun describe-mode (&optional buffer)
--
2.0.0
[Message part 3 (text/plain, inline)]
-- Nico.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.