X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=2be409b39a1abe1fee91b514ce9f96347eb15644;hb=caf5514a3692d6ad6be257a24a5b5a44164bb90a;hp=065645c88234d7091e3b256153e6a01110583be9;hpb=141f3813d81bd1de9218007c77e0be1f75fcee27;p=notmuch diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 065645c8..2be409b3 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -231,7 +231,8 @@ depending on the value of `notmuch-poll-script'." "Given a prefix key code, return a human-readable string representation. This is basically just `format-kbd-macro' but we also convert ESC to M-." - (let ((desc (format-kbd-macro (vector key)))) + (let* ((key-vector (if (vectorp key) key (vector key))) + (desc (format-kbd-macro key-vector))) (if (string= desc "ESC") "M-" (concat desc " ")))) @@ -260,7 +261,22 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL." tail))) tail) -(defun notmuch-describe-keymap (keymap ua-keys &optional prefix tail) +(defun notmuch-describe-remaps (remap-keymap ua-keys base-keymap prefix tail) + ;; Remappings are represented as a binding whose first "event" is + ;; 'remap. Hence, if the keymap has any remappings, it will have a + ;; binding whose "key" is 'remap, and whose "binding" is itself a + ;; keymap that maps not from keys to commands, but from old (remapped) + ;; functions to the commands to use in their stead. + (map-keymap + (lambda (command binding) + (mapc + (lambda (actual-key) + (setq tail (notmuch-describe-key actual-key binding prefix ua-keys tail))) + (where-is-internal command base-keymap))) + remap-keymap) + tail) + +(defun notmuch-describe-keymap (keymap ua-keys base-keymap &optional prefix tail) "Return a list of cons cells, each describing one binding in KEYMAP. Each cons cell consists of a string giving a human-readable @@ -276,8 +292,11 @@ prefix argument. PREFIX and TAIL are used internally." (cond ((mouse-event-p key) nil) ((keymapp binding) (setq tail - (notmuch-describe-keymap - binding ua-keys (notmuch-prefix-key-description key) tail))) + (if (eq key 'remap) + (notmuch-describe-remaps + binding ua-keys base-keymap prefix tail) + (notmuch-describe-keymap + binding ua-keys base-keymap (notmuch-prefix-key-description key) tail)))) (binding (setq tail (notmuch-describe-key (vector key) binding prefix ua-keys tail))))) keymap) @@ -292,7 +311,7 @@ prefix argument. PREFIX and TAIL are used internally." (let* ((keymap-name (substring doc (match-beginning 1) (match-end 1))) (keymap (symbol-value (intern keymap-name))) (ua-keys (where-is-internal 'universal-argument keymap t)) - (desc-alist (notmuch-describe-keymap keymap ua-keys)) + (desc-alist (notmuch-describe-keymap keymap ua-keys keymap)) (desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist))) (mapconcat #'identity desc-list "\n"))))) (setq doc (replace-match desc 1 1 doc))) @@ -319,6 +338,28 @@ of its command symbol." (set-buffer-modified-p nil) (view-buffer (current-buffer) 'kill-buffer-if-not-modified)))) +(defun notmuch-subkeymap-help () + "Show help for a subkeymap." + (interactive) + (let* ((key (this-command-keys-vector)) + (prefix (make-vector (1- (length key)) nil)) + (i 0)) + (while (< i (length prefix)) + (aset prefix i (aref key i)) + (setq i (1+ i))) + + (let* ((subkeymap (key-binding prefix)) + (ua-keys (where-is-internal 'universal-argument nil t)) + (prefix-string (notmuch-prefix-key-description prefix)) + (desc-alist (notmuch-describe-keymap subkeymap ua-keys subkeymap prefix-string)) + (desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist)) + (desc (mapconcat #'identity desc-list "\n"))) + (with-help-window (help-buffer) + (with-current-buffer standard-output + (insert "\nPress 'q' to quit this window.\n\n") + (insert desc))) + (pop-to-buffer (help-buffer))))) + (defvar notmuch-buffer-refresh-function nil "Function to call to refresh the current buffer.") (make-variable-buffer-local 'notmuch-buffer-refresh-function)