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 06399429E2F for ; Sun, 12 Jun 2011 16:31:39 -0700 (PDT) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: -0.799 X-Spam-Level: X-Spam-Status: No, score=-0.799 tagged_above=-999 required=5 tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.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 SEoq3O0rXGcg for ; Sun, 12 Jun 2011 16:31:35 -0700 (PDT) Received: from mail-fx0-f53.google.com (mail-fx0-f53.google.com [209.85.161.53]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client certificate requested) by olra.theworths.org (Postfix) with ESMTPS id 1ECFE429E26 for ; Sun, 12 Jun 2011 16:31:34 -0700 (PDT) Received: by mail-fx0-f53.google.com with SMTP id 8so2672136fxm.26 for ; Sun, 12 Jun 2011 16:31:34 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=googlemail.com; s=gamma; h=domainkey-signature:from:to:cc:subject:date:message-id:x-mailer :in-reply-to:references; bh=h5E1pB0KvHoQ8M23JdVflKZOhGV6QnEhW8z5X+5lm1A=; b=eS+9NvUp9alL4LM85dSj00/+MUO5AA3+GJ0XIpdEczhNnmkVgIWdro42yCWMSbv/If M3sPXMzbQ0K5cpx/lq1W667YracHnF/vk/MVc7QjTWrKHm06uyYUVkbZ9GaPw1+OoBmt IAXxpWMnW4bO9XgIq92g11ko1y2rUF2y24NfU= DomainKey-Signature: a=rsa-sha1; c=nofws; d=googlemail.com; s=gamma; h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references; b=Vandc9WlerQ2RB5V0gxR8ysjbTMimYC/fnzvR0Gdp+Dindow8YIt/gI5Bskn8tRC60 L9kzjpLp2njhH2cK2ll3OsEvw0PhlQRqlJ6Ncdpdrt9YkXE4TwAhiEY7IV1nn1yCDbXV YJrxPE3Vn/ryl03eUSAYKgZ5xZQulLtr9xwBE= Received: by 10.223.25.201 with SMTP id a9mr4442180fac.141.1307921494722; Sun, 12 Jun 2011 16:31:34 -0700 (PDT) Received: from localhost (dslb-088-068-023-159.pools.arcor-ip.net [88.68.23.159]) by mx.google.com with ESMTPS id g8sm983113fai.44.2011.06.12.16.31.32 (version=TLSv1/SSLv3 cipher=OTHER); Sun, 12 Jun 2011 16:31:33 -0700 (PDT) From: Daniel Schoepe To: notmuch@notmuchmail.org Subject: [PATCH 2/3] emacs: Add thread-outline functionality Date: Mon, 13 Jun 2011 01:31:19 +0200 Message-Id: <1307921480-17130-3-git-send-email-daniel.schoepe@googlemail.com> X-Mailer: git-send-email 1.7.5.4 In-Reply-To: <1307921480-17130-1-git-send-email-daniel.schoepe@googlemail.com> References: <1307921480-17130-1-git-send-email-daniel.schoepe@googlemail.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: Sun, 12 Jun 2011 23:31:39 -0000 This patch adds some functionality to display the outline for threads displayed by notmuch-show. The entries in the outline buffer are links to the corresponding message in the notmuch-show buffer. --- emacs/notmuch-lib.el | 7 +++ emacs/notmuch-show.el | 144 ++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 150 insertions(+), 1 deletions(-) diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index a21dc14..6918218 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -91,9 +91,16 @@ the user hasn't set this variable with the old or new value." "Return the user.primary_email value (as a list) from the notmuch configuration." (split-string (notmuch-config-get "user.other_email") "\n")) +(declare-function notmuch-show-outline-buffer-name "notmuch-show" (&optional buf)) + (defun notmuch-kill-this-buffer () "Kill the current buffer." (interactive) + ;; if we are in a notmuch-show buffer, kill the associated outline buffer, if any + (when (eq major-mode 'notmuch-show-mode) + (let ((outline-buf (get-buffer (notmuch-show-outline-buffer-name)))) + (when outline-buf + (kill-buffer outline-buf)))) (kill-buffer (current-buffer))) ;; diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index aecd35f..4f2a30e 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -107,6 +107,48 @@ same as that of the previous message." :group 'notmuch :type 'boolean) +(defcustom notmuch-always-show-outline nil + "Should an outline of the thread always be opened?" + :group 'notmuch + :type 'boolean) + +(defcustom notmuch-outline-format + '(("author" . "%s") + "-" + ("reldate" . "%s")) + "Format in which thread-outline entries are displayed + +The following fields are supported: date, reldate, author, +subject. The list can also contain strings as elements which +will be printed literally. This variable can also be a function +that will be given the message as returned by +`notmuch-show-get-message-properties' and should return a +string." + :group 'notmuch + :type '(repeat (choice (string :tag "string") + (cons (choice (const :tag "author" "author") + (const :tag "subject" "subject") + (const :tag "date" "date") + (const :tag "reldate" "reldate")) + (string :tag "format specifier"))))) + +(defface notmuch-outline '((t :inherit default)) + "Face used to display (unhighlighted) lines in thread outlines" + :group 'notmuch) + +(defvar notmuch-outline-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "q" 'notmuch-kill-this-buffer) + map)) + +(defvar notmuch-outline-button-map + (let ((map (copy-keymap button-map))) + (define-key map (kbd "") 'push-button) + map) + "Keymap used for buttons in thread outlines.") + (defmacro with-current-notmuch-show-message (&rest body) "Evaluate body with current buffer set to the text of current message" `(save-excursion @@ -787,6 +829,103 @@ current buffer, if possible." (defvar notmuch-show-parent-buffer nil) (make-variable-buffer-local 'notmuch-show-parent-buffer) +(defun notmuch-goto-marker (m) +"Open corresponding buffer and go to marker position in another window." + (switch-to-buffer-other-window (marker-buffer m)) + (goto-char (marker-position m))) + +(defun notmuch-show-message-is-visible () + "Return t if current message is visible." + (plist-get (notmuch-show-get-message-properties) :message-visible)) + +(defun notmuch-outline-render-format (format) + "Render FORMAT, interpreted as described for `notmuch-outline-format'" + (if (functionp format) + (funcall format (notmuch-show-get-message-properties)) + (mapconcat + (lambda (entry) + (if (consp entry) + (let ((key (car entry)) + (fmt (cdr entry))) + (cond + ((equal key "author") (format fmt (notmuch-show-get-from))) + ((equal key "date") (format fmt (notmuch-show-get-date))) + ((equal key "subject") (format fmt (notmuch-show-get-subject))) + ((equal key "reldate") + (format fmt (plist-get (notmuch-show-get-message-properties) + :date_relative))) + (t (concat "Unknown field: " (car entry))))) + entry)) + format + " "))) + +(defun notmuch-show-outline-buffer-name (&optional buf) + "Return the name of the outline buffer for BUF." + (concat (buffer-name buf) " - outline")) + +(defun notmuch-show-has-outline () + "Returns non-nil if there is an outline for the current thread." + (get-buffer (notmuch-show-outline-buffer-name))) + +(defun notmuch-outline-message () + "Outline the message under the point. + +Expects the point to be on the beginning of the first line of the message." + (lexical-let* ((extent (notmuch-show-message-extent)) + (buffer-name (notmuch-show-outline-buffer-name)) + (goto-message (lambda (btn) + (select-window (get-buffer-window buffer-name)) + (when (marker-buffer (car extent)) + (notmuch-goto-marker (car extent)) + (when (not (notmuch-show-message-is-visible)) + (notmuch-show-toggle-message)))))) + (let ((indentation 0) + (button-label (notmuch-outline-render-format + notmuch-outline-format))) + ;; this is not very robust if the output of notmuch-show changes + (while (string-equal (thing-at-point 'char) " ") + (incf indentation) + (forward-char)) + (loop for i from 1 to indentation do + (princ " ")) ;; somewhat ugly + (princ button-label) + (with-current-buffer standard-output + (make-button (line-beginning-position) (line-end-position) + 'action goto-message + 'keymap notmuch-outline-button-map + 'face 'notmuch-outline) + (put-text-property (line-beginning-position) (line-end-position) + :message-start (car extent))) + (princ "\n")))) + +(defun notmuch-show-outline () + "Generate an outline for the current buffer. + +This function must only be called in a notmuch-show buffer." + (interactive) + (let ((buf-name (notmuch-show-outline-buffer-name))) + ;; In the extremly rare case that the user might have been doing + ;; work in a buffer with the exact same name of the outline buffer + ;; we don't want to kill that buffer + (kill-buffer-if-not-modified buf-name) + (save-excursion + (with-output-to-temp-buffer buf-name + (with-current-buffer buf-name + (notmuch-outline-mode)) + (goto-char (point-min)) + (while (not (eobp)) + (notmuch-outline-message) + (goto-char (marker-position (cdr (notmuch-show-message-extent))))) + (with-current-buffer buf-name + (setq buffer-read-only t)))))) + +(defun notmuch-outline-mode () + (interactive) + (kill-all-local-variables) + (use-local-map notmuch-outline-mode-map) + (setq major-mode 'notmuch-show-outline-mode + mode-name "notmuch-show-outline")) + ;;;###autoload (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch) "Run \"notmuch show\" with the given thread ID and display results. @@ -846,7 +985,9 @@ function is used. " ;; Set the header line to the subject of the first open message. (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject))) - (notmuch-show-mark-read))) + (notmuch-show-mark-read) + (when notmuch-always-show-outline + (notmuch-show-outline)))) (defvar notmuch-show-stash-map (let ((map (make-sparse-keymap))) @@ -888,6 +1029,7 @@ function is used. " (define-key map "P" 'notmuch-show-previous-message) (define-key map "n" 'notmuch-show-next-open-message) (define-key map "p" 'notmuch-show-previous-open-message) + (define-key map "o" 'notmuch-show-outline) (define-key map (kbd "DEL") 'notmuch-show-rewind) (define-key map " " 'notmuch-show-advance-and-archive) (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all) -- 1.7.5.4