Return-Path: X-Original-To: notmuch@notmuchmail.org Delivered-To: notmuch@notmuchmail.org Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id 03A7A431FDA for ; Tue, 3 Sep 2013 14:45:53 -0700 (PDT) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: -0.7 X-Spam-Level: X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5 tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled Received: from olra.theworths.org ([127.0.0.1]) by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id lRayjVe1V9xl for ; Tue, 3 Sep 2013 14:45:48 -0700 (PDT) Received: from dmz-mailsec-scanner-4.mit.edu (dmz-mailsec-scanner-4.mit.edu [18.9.25.15]) by olra.theworths.org (Postfix) with ESMTP id 84802431FDB for ; Tue, 3 Sep 2013 14:45:33 -0700 (PDT) X-AuditID: 1209190f-b7fa58e000000953-7a-5226587c7b59 Received: from mailhub-auth-2.mit.edu ( [18.7.62.36]) by dmz-mailsec-scanner-4.mit.edu (Symantec Messaging Gateway) with SMTP id 16.F3.02387.C7856225; Tue, 3 Sep 2013 17:45:32 -0400 (EDT) Received: from outgoing.mit.edu (outgoing-auth-1.mit.edu [18.9.28.11]) by mailhub-auth-2.mit.edu (8.13.8/8.9.2) with ESMTP id r83LjUlV019873; Tue, 3 Sep 2013 17:45:30 -0400 Received: from drake.dyndns.org (26-4-182.dynamic.csail.mit.edu [18.26.4.182]) (authenticated bits=0) (User authenticated as amdragon@ATHENA.MIT.EDU) by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id r83LjRTO026859 (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT); Tue, 3 Sep 2013 17:45:28 -0400 Received: from amthrax by drake.dyndns.org with local (Exim 4.77) (envelope-from ) id 1VGyPe-0004y3-VT; Tue, 03 Sep 2013 17:45:26 -0400 From: Austin Clements To: notmuch@notmuchmail.org Subject: [PATCH v2 7/9] emacs: Make notmuch-help work with arbitrary keymaps Date: Tue, 3 Sep 2013 17:45:23 -0400 Message-Id: <1378244725-18846-8-git-send-email-amdragon@mit.edu> X-Mailer: git-send-email 1.7.10.4 In-Reply-To: <1378244725-18846-1-git-send-email-amdragon@mit.edu> References: <1378244725-18846-1-git-send-email-amdragon@mit.edu> X-Brightmail-Tracker: H4sIAAAAAAAAA+NgFjrKIsWRmVeSWpSXmKPExsUixG6nolsToRZksH6voUXTdGeL1XN5LK7f nMnswOyxc9Zddo9b91+zezxbdYs5gDmKyyYlNSezLLVI3y6BK+PKar6C+1IVGybdYmtg3Cba xcjJISFgIrG36R8LhC0mceHeerYuRi4OIYF9jBJdfw8xQTgbGCXmTj7MAuEcZpLo+HiVEcKZ yyjx/f8JJpB+NgENiW37lzOC2CIC0hI7785mBbGZBaIljlyewQZiCwv4SMxpuwpWzyKgKrHq 3jKw3bwCDhLtt2YyQtyhKNH9bAJYPaeAo0TvgkXsILYQUE3TysvsExj5FzAyrGKUTcmt0s1N zMwpTk3WLU5OzMtLLdI10cvNLNFLTSndxAgKLU5J/h2M3w4qHWIU4GBU4uFdcV81SIg1say4 MvcQoyQHk5Io75FQtSAhvqT8lMqMxOKM+KLSnNTiQ4wSHMxKIrwJPkA53pTEyqrUonyYlDQH i5I477OnZwOFBNITS1KzU1MLUotgsjIcHEoSvOXhQI2CRanpqRVpmTklCGkmDk6Q4TxAw3+G gQwvLkjMLc5Mh8ifYlSUEudNB2kWAElklObB9cJi/xWjONArwrz+IFU8wLQB1/0KaDAT0OC0 z6ogg0sSEVJSDYztKx43J36RWJmwQLn3kuY5ydyPrXGB3Vc6Lmd9uL8sffOCDVtSGJ5lJdQm PlItnRJw5fVPPeWpunksm/of+9W8mCEntrdFwLHzwqyjPh8X5Mqz7Z7jtYAzJ1TkWvwLL2ad tTttnZnv26S1fZuksUkid7tNZ4fO28YTfqaRYR6T2450fpu/Q0KJpTgj0VCLuag4EQAOyyc1 2AIAAA== X-BeenThere: notmuch@notmuchmail.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 03 Sep 2013 21:45:53 -0000 This converts notmuch-help to use map-keymap for all keymap traversal. This generally cleans up and simplifies construction of keymap documentation, and also makes notmuch-help support anything that can be in a keymap, including more esoteric stuff like multiple inheritance. --- emacs/notmuch.el | 58 +++++++++++++++++++++--------------------------------- 1 file changed, 22 insertions(+), 36 deletions(-) diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 80446be..0304096 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -140,48 +140,34 @@ This is basically just `format-kbd-macro' but we also convert ESC to M-." "M-" (concat desc " ")))) -;; I would think that emacs would have code handy for walking a keymap -;; and generating strings for each key, and I would prefer to just call -;; that. But I couldn't find any (could be all implemented in C I -;; suppose), so I wrote my own here. -(defun notmuch-substitute-one-command-key-with-prefix (prefix binding) - "For a key binding, return a string showing a human-readable -representation of the prefixed key as well as the first line of -documentation from the bound function. - -For a mouse binding, return nil." - (let ((key (car binding)) - (action (cdr binding))) - (if (mouse-event-p key) - nil - (if (keymapp action) - (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key))) - (as-list)) - (map-keymap (lambda (a b) - (push (cons a b) as-list)) - action) - (mapconcat substitute as-list "\n")) - (concat prefix (format-kbd-macro (vector key)) - "\t" - (notmuch-documentation-first-line action)))))) - -(defun notmuch-substitute-command-keys-one (key) - ;; A `keymap' key indicates inheritance from a parent keymap - the - ;; inherited mappings follow, so there is nothing to print for - ;; `keymap' itself. - (when (not (eq key 'keymap)) - (notmuch-substitute-one-command-key-with-prefix nil key))) +(defun notmuch-describe-keymap (keymap &optional prefix tail) + "Return a list of strings, each describing one key in KEYMAP. + +Each string gives a human-readable description of the key and the +first line of documentation for the bound function." + (map-keymap + (lambda (key binding) + (cond ((mouse-event-p key) nil) + ((keymapp binding) + (setq tail + (notmuch-describe-keymap + binding (notmuch-prefix-key-description key) tail))) + (t + (push (concat prefix (format-kbd-macro (vector key)) "\t" + (notmuch-documentation-first-line binding)) + tail)))) + keymap) + tail) (defun notmuch-substitute-command-keys (doc) "Like `substitute-command-keys' but with documentation, not function names." (let ((beg 0)) (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg) (let* ((keymap-name (substring doc (match-beginning 1) (match-end 1))) - (keymap (symbol-value (intern keymap-name)))) - (setq doc (replace-match - (mapconcat #'notmuch-substitute-command-keys-one - (cdr keymap) "\n") - 1 1 doc))) + (keymap (symbol-value (intern keymap-name))) + (desc-list (notmuch-describe-keymap keymap)) + (desc (mapconcat #'identity desc-list "\n"))) + (setq doc (replace-match desc 1 1 doc))) (setq beg (match-end 0))) doc)) -- 1.7.10.4