From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id F259B431FC4 for ; Tue, 29 Oct 2013 16:02:53 -0700 (PDT) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: 0.201 X-Spam-Level: X-Spam-Status: No, score=0.201 tagged_above=-999 required=5 tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001, 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 uKK46l5ZZacI for ; Tue, 29 Oct 2013 16:02:48 -0700 (PDT) Received: from mail-wi0-f169.google.com (mail-wi0-f169.google.com [209.85.212.169]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client certificate requested) by olra.theworths.org (Postfix) with ESMTPS id 37392431FBC for ; Tue, 29 Oct 2013 16:02:48 -0700 (PDT) Received: by mail-wi0-f169.google.com with SMTP id cb5so5641612wib.0 for ; Tue, 29 Oct 2013 16:02:47 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:date:message-id:in-reply-to:references; bh=dAGdcOL9ak6gHjE5+BlGzwNTN6FNdZDfF18l7E+Otiw=; b=doLREtvg4rQjkNTJMs7WhithPZS1WeKbcBsWBo7ocf6FB3UUCDO+uJZCDJwJmfd2y2 Jb+KTUizhHR+kiwFxeyzr51uL1uzCTXIoHjshuKfqye8hFztqhPbmUORlP+INuKLJBer 7cxKrh5enJ8pCV87bQQeuRefxZ7qr7CyhpdPcQdSk/8qtFI7fWPneSMu1wlJtUBSvoRk qZefZ5onuEfdP9yR5WuV3aaQpaMTa35aX3Ofme5knx4oIeL9VPjxzh28crUETuQaMnV3 TU97fuy4IvMj8wY7l4RuhTwtQ2Rw5pgBbPf1b5ab5FtFGL+fP+HU5/CLCIji9iz23J6Z o+qA== X-Received: by 10.180.13.142 with SMTP id h14mr110696wic.3.1383087344398; Tue, 29 Oct 2013 15:55:44 -0700 (PDT) Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31]) by mx.google.com with ESMTPSA id b7sm9537512wiz.8.2013.10.29.15.55.43 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Tue, 29 Oct 2013 15:55:44 -0700 (PDT) From: Mark Walters To: notmuch@notmuchmail.org Subject: [PATCH 01/11] emacs: move notmuch-help to lib Date: Tue, 29 Oct 2013 22:55:28 +0000 Message-Id: <1383087338-10220-2-git-send-email-markwalters1009@gmail.com> X-Mailer: git-send-email 1.7.9.1 In-Reply-To: <1383087338-10220-1-git-send-email-markwalters1009@gmail.com> References: <1383087338-10220-1-git-send-email-markwalters1009@gmail.com> 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, 29 Oct 2013 23:02:54 -0000 notmuch-help is in notmuch.el not notmuch-lib.el and this is incovenient for the way pick/tree uses it. I think lib makes more sense anyway so move it there. --- emacs/notmuch-lib.el | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++ emacs/notmuch.el | 87 -------------------------------------------------- 2 files changed, 87 insertions(+), 87 deletions(-) diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index 6541282..e7c5c97 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -215,6 +215,93 @@ depending on the value of `notmuch-poll-script'." (interactive) (kill-buffer (current-buffer))) +(defun notmuch-documentation-first-line (symbol) + "Return the first line of the documentation string for SYMBOL." + (let ((doc (documentation symbol))) + (if doc + (with-temp-buffer + (insert (documentation symbol t)) + (goto-char (point-min)) + (let ((beg (point))) + (end-of-line) + (buffer-substring beg (point)))) + ""))) + +(defun notmuch-prefix-key-description (key) + "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)))) + (if (string= desc "ESC") + "M-" + (concat desc " ")))) + +(defun notmuch-describe-keymap (keymap ua-keys &optional prefix tail) + "Return a list of strings, each describing one binding in KEYMAP. + +Each string gives a human-readable description of the key and a +one-line description of the bound function. See `notmuch-help' +for an overview of how this documentation is extracted. + +UA-KEYS should be a key sequence bound to `universal-argument'. +It will be used to describe bindings of commands that support a +prefix argument. PREFIX and TAIL are used internally." + (map-keymap + (lambda (key binding) + (cond ((mouse-event-p key) nil) + ((keymapp binding) + (setq tail + (notmuch-describe-keymap + binding ua-keys (notmuch-prefix-key-description key) tail))) + (t + (when (and ua-keys (symbolp binding) + (get binding 'notmuch-prefix-doc)) + ;; Documentation for prefixed command + (let ((ua-desc (key-description ua-keys))) + (push (concat ua-desc " " prefix (format-kbd-macro (vector key)) + "\t" (get binding 'notmuch-prefix-doc)) + tail))) + ;; Documentation for command + (push (concat prefix (format-kbd-macro (vector key)) "\t" + (or (and (symbolp binding) (get binding 'notmuch-doc)) + (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))) + (ua-keys (where-is-internal 'universal-argument keymap t)) + (desc-list (notmuch-describe-keymap keymap ua-keys)) + (desc (mapconcat #'identity desc-list "\n"))) + (setq doc (replace-match desc 1 1 doc))) + (setq beg (match-end 0))) + doc)) + +(defun notmuch-help () + "Display help for the current notmuch mode. + +This is similar to `describe-function' for the current major +mode, but bindings tables are shown with documentation strings +rather than command names. By default, this uses the first line +of each command's documentation string. A command can override +this by setting the 'notmuch-doc property of its command symbol. +A command that supports a prefix argument can explicitly document +its prefixed behavior by setting the 'notmuch-prefix-doc property +of its command symbol." + (interactive) + (let* ((mode major-mode) + (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t))))) + (with-current-buffer (generate-new-buffer "*notmuch-help*") + (insert doc) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (view-buffer (current-buffer) 'kill-buffer-if-not-modified)))) + (defvar notmuch-buffer-refresh-function nil "Function to call to refresh the current buffer.") (make-variable-buffer-local 'notmuch-buffer-refresh-function) diff --git a/emacs/notmuch.el b/emacs/notmuch.el index d0cd906..19210cb 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -119,93 +119,6 @@ To enter a line break in customize, press \\[quoted-insert] C-j." (mm-save-part p)))) mm-handle)) -(defun notmuch-documentation-first-line (symbol) - "Return the first line of the documentation string for SYMBOL." - (let ((doc (documentation symbol))) - (if doc - (with-temp-buffer - (insert (documentation symbol t)) - (goto-char (point-min)) - (let ((beg (point))) - (end-of-line) - (buffer-substring beg (point)))) - ""))) - -(defun notmuch-prefix-key-description (key) - "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)))) - (if (string= desc "ESC") - "M-" - (concat desc " ")))) - -(defun notmuch-describe-keymap (keymap ua-keys &optional prefix tail) - "Return a list of strings, each describing one binding in KEYMAP. - -Each string gives a human-readable description of the key and a -one-line description of the bound function. See `notmuch-help' -for an overview of how this documentation is extracted. - -UA-KEYS should be a key sequence bound to `universal-argument'. -It will be used to describe bindings of commands that support a -prefix argument. PREFIX and TAIL are used internally." - (map-keymap - (lambda (key binding) - (cond ((mouse-event-p key) nil) - ((keymapp binding) - (setq tail - (notmuch-describe-keymap - binding ua-keys (notmuch-prefix-key-description key) tail))) - (t - (when (and ua-keys (symbolp binding) - (get binding 'notmuch-prefix-doc)) - ;; Documentation for prefixed command - (let ((ua-desc (key-description ua-keys))) - (push (concat ua-desc " " prefix (format-kbd-macro (vector key)) - "\t" (get binding 'notmuch-prefix-doc)) - tail))) - ;; Documentation for command - (push (concat prefix (format-kbd-macro (vector key)) "\t" - (or (and (symbolp binding) (get binding 'notmuch-doc)) - (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))) - (ua-keys (where-is-internal 'universal-argument keymap t)) - (desc-list (notmuch-describe-keymap keymap ua-keys)) - (desc (mapconcat #'identity desc-list "\n"))) - (setq doc (replace-match desc 1 1 doc))) - (setq beg (match-end 0))) - doc)) - -(defun notmuch-help () - "Display help for the current notmuch mode. - -This is similar to `describe-function' for the current major -mode, but bindings tables are shown with documentation strings -rather than command names. By default, this uses the first line -of each command's documentation string. A command can override -this by setting the 'notmuch-doc property of its command symbol. -A command that supports a prefix argument can explicitly document -its prefixed behavior by setting the 'notmuch-prefix-doc property -of its command symbol." - (interactive) - (let* ((mode major-mode) - (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t))))) - (with-current-buffer (generate-new-buffer "*notmuch-help*") - (insert doc) - (goto-char (point-min)) - (set-buffer-modified-p nil) - (view-buffer (current-buffer) 'kill-buffer-if-not-modified)))) - (require 'hl-line) (defun notmuch-hl-line-mode () -- 1.7.9.1