--- /dev/null
+Return-Path: <daniel@schoepe.org>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id AC827429E21\r
+ for <notmuch@notmuchmail.org>; Fri, 16 Dec 2011 16:16:44 -0800 (PST)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -0.8\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-0.8 tagged_above=-999 required=5\r
+ tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
+ RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id ZMjumJamEOYQ for <notmuch@notmuchmail.org>;\r
+ Fri, 16 Dec 2011 16:16:43 -0800 (PST)\r
+Received: from mail-ee0-f53.google.com (mail-ee0-f53.google.com\r
+ [74.125.83.53]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client\r
+ certificate requested) by olra.theworths.org (Postfix) with ESMTPS id\r
+ 42355431FB6 for <notmuch@notmuchmail.org>; Fri, 16 Dec 2011 16:16:43 -0800\r
+ (PST)\r
+Received: by mail-ee0-f53.google.com with SMTP id d41so4339652eek.26\r
+ for <notmuch@notmuchmail.org>; Fri, 16 Dec 2011 16:16:42 -0800 (PST)\r
+DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=schoepe.org; s=google;\r
+ h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references;\r
+ bh=6WLk3lB0KgzEPW/HdNJ7zzRC/n8KncJo6WJZbcWxzRQ=;\r
+ b=GtL22qpiG1RlOUXZWmz3pHFNp55phNifwqjcwmS2HRNCQKTNB59fVjIfor5UO/30X9\r
+ uQNUOY5tDF54D3wXWwCKqoCH53MFfDmw32Pgz8PvpYcHOJvsUK2tIgodYSqr4SLG2Wey\r
+ lyg0lVkLxAs4xZG/py0tBlSWotEmdli8qGcNQ=\r
+Received: by 10.14.3.167 with SMTP id 39mr328477eeh.6.1324081002702;\r
+ Fri, 16 Dec 2011 16:16:42 -0800 (PST)\r
+Received: from localhost (dslb-088-069-153-158.pools.arcor-ip.net.\r
+ [88.69.153.158])\r
+ by mx.google.com with ESMTPS id z54sm3932898eeh.5.2011.12.16.16.16.40\r
+ (version=TLSv1/SSLv3 cipher=OTHER);\r
+ Fri, 16 Dec 2011 16:16:41 -0800 (PST)\r
+From: Daniel Schoepe <daniel@schoepe.org>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH v2 1/2] emacs: Add thread-outline functionality\r
+Date: Sat, 17 Dec 2011 01:16:33 +0100\r
+Message-Id: <1324080994-18146-2-git-send-email-daniel@schoepe.org>\r
+X-Mailer: git-send-email 1.7.7.3\r
+In-Reply-To: <1324080994-18146-1-git-send-email-daniel@schoepe.org>\r
+References: <1307921480-17130-1-git-send-email-daniel.schoepe@googlemail.com>\r
+ <1324080994-18146-1-git-send-email-daniel@schoepe.org>\r
+Cc: Daniel Schoepe <daniel.schoepe@googlemail.com>\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Sat, 17 Dec 2011 00:16:44 -0000\r
+\r
+From: Daniel Schoepe <daniel.schoepe@googlemail.com>\r
+\r
+This patch adds some functionality to display the outline for threads\r
+displayed by notmuch-show. The entries in the outline buffer are\r
+links to the corresponding message in the notmuch-show buffer.\r
+---\r
+ emacs/notmuch-lib.el | 12 +++\r
+ emacs/notmuch-show.el | 195 ++++++++++++++++++++++++++++++++++++++++++++++++-\r
+ 2 files changed, 206 insertions(+), 1 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index 0f856bf..a8be8b1 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -43,6 +43,10 @@\r
+ (defvar notmuch-folders nil\r
+ "Deprecated name for what is now known as `notmuch-saved-searches'.")\r
+ \r
++(defvar notmuch-show-outline-buffer nil\r
++ "Outline buffer associated with a notmuch-show buffer.")\r
++(make-variable-buffer-local 'notmuch-show-outline-buffer)\r
++\r
+ (defun notmuch-saved-searches ()\r
+ "Common function for querying the notmuch-saved-searches variable.\r
+ \r
+@@ -91,9 +95,17 @@ the user hasn't set this variable with the old or new value."\r
+ "Return the user.other_email value (as a list) from the notmuch configuration."\r
+ (split-string (notmuch-config-get "user.other_email") "\n"))\r
+ \r
++(declare-function notmuch-show-outline-buffer-name "notmuch-show" (&optional buf))\r
++\r
+ (defun notmuch-kill-this-buffer ()\r
+ "Kill the current buffer."\r
+ (interactive)\r
++ ;; if we are in a notmuch-show buffer, kill the associated outline buffer, if any\r
++ (when (eq major-mode 'notmuch-show-mode)\r
++ (let ((outline-buf notmuch-show-outline-buffer))\r
++ (when outline-buf\r
++ (mapc #'delete-window (get-buffer-window-list outline-buf))\r
++ (kill-buffer outline-buf))))\r
+ (kill-buffer (current-buffer)))\r
+ \r
+ ;;\r
+diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+index 63b01e5..e7ce811 100644\r
+--- a/emacs/notmuch-show.el\r
++++ b/emacs/notmuch-show.el\r
+@@ -107,6 +107,57 @@ indentation."\r
+ :group 'notmuch\r
+ :type 'boolean)\r
+ \r
++(defcustom notmuch-always-show-outline nil\r
++ "Always open an outline buffer when viewing a thread?"\r
++ :group 'notmuch\r
++ :type 'boolean)\r
++\r
++(defcustom notmuch-outline-format\r
++ (list "%a - %r")\r
++ "Format used for thread-outline lines.\r
++\r
++This is a list supporting the following types of elements:\r
++For a symbol, its value is used if non-nil.\r
++A string is inserted verbatim with the exception\r
++ of the following %-constructs:\r
++ %a - Author\r
++ %d - Date\r
++ %s - Subject\r
++ %r - Relative date\r
++For a list of the form `(:eval FORM)', form is evaluated\r
++ and its result displayed.\r
++\r
++The variables author, subject, date and reldate will be bound to\r
++their respective values when this is interpreted, and can be\r
++used in (:eval ..)-elements or directly as symbols."\r
++ :group 'notmuch\r
++ :type\r
++ '(repeat (choice (const :tag "Author" author)\r
++ (const :tag "Date" date)\r
++ (const :tag "Relative date" reldate)\r
++ (string :tag "Format string")\r
++ (list :tag "Custom expression (will be evaluated when rendering)"\r
++ (const :tag "" :eval)\r
++ sexp))))\r
++\r
++(defface notmuch-outline '((t :inherit default))\r
++ "Face used to display (unhighlighted) lines in thread outlines"\r
++ :group 'notmuch)\r
++\r
++(defface notmuch-outline-highlighted\r
++ '((((class color) (background light)) (:background "#f0f0f0"))\r
++ (((class color) (background dark)) (:background "#303030")))\r
++ "Face used to display highlight the current message in the outline buffer"\r
++ :group 'notmuch)\r
++\r
++(defvar notmuch-outline-mode-map\r
++ (let ((map (make-sparse-keymap)))\r
++ (define-key map "n" 'next-line)\r
++ (define-key map "p" 'previous-line)\r
++ (define-key map "q" 'kill-buffer-and-window)\r
++ (define-key map "x" 'kill-buffer-and-window)\r
++ map))\r
++\r
+ (defmacro with-current-notmuch-show-message (&rest body)\r
+ "Evaluate body with current buffer set to the text of current message"\r
+ `(save-excursion\r
+@@ -747,12 +798,27 @@ current buffer, if possible."\r
+ ;; message.\r
+ (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))\r
+ \r
++ ;; Save the indentation depth, used by `notmuch-show-outline'\r
++ (put-text-property message-start message-end :notmuch-depth depth)\r
++\r
+ (let ((headers-overlay (make-overlay headers-start headers-end))\r
+ (invis-specs (list headers-invis-spec message-invis-spec)))\r
+ (overlay-put headers-overlay 'invisible invis-specs)\r
+ (overlay-put headers-overlay 'priority 10))\r
+ (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)\r
+ \r
++ ;; Add callbacks that update the outline buffer when moving between messages.\r
++ ;; Due to the mindbogglingly absurd semantics of point-entered and point-left\r
++ ;; this function will will be run up to _four_ times when moving between messages:\r
++ (let ((goto-msg-func\r
++ `(lambda (before after)\r
++ (if (and (>= after (marker-position ,message-start))\r
++ (< after (marker-position ,message-end)))\r
++ (notmuch-outline-highlight-message ,message-start)))))\r
++ (add-text-properties message-start message-end\r
++ (list 'point-entered goto-msg-func\r
++ 'point-left goto-msg-func)))\r
++\r
+ ;; Save the properties for this message. Currently this saves the\r
+ ;; entire message (augmented it with other stuff), which seems\r
+ ;; like overkill. We might save a reduced subset (for example, not\r
+@@ -808,6 +874,130 @@ a corresponding notmuch search."\r
+ 'help-echo "Mouse-1, RET: search for this message"\r
+ 'face goto-address-mail-face))))\r
+ \r
++(defun notmuch-show-message-is-visible ()\r
++ "Return t if current message is visible."\r
++ (plist-get (notmuch-show-get-message-properties) :message-visible))\r
++\r
++(defun notmuch-outline-render-format (format)\r
++ "Render FORMAT, as described in `notmuch-outline-format'"\r
++ (let ((author (notmuch-show-get-from))\r
++ (date (notmuch-show-get-date))\r
++ (subject (notmuch-show-get-subject))\r
++ (reldate (plist-get (notmuch-show-get-message-properties)\r
++ :date_relative)))\r
++ (mapconcat (lambda (elem)\r
++ (cond\r
++ ((symbolp elem) (or (symbol-value elem) ""))\r
++ ((stringp elem)\r
++ (let ((str elem))\r
++ (mapc (lambda (subst)\r
++ (setq str\r
++ (replace-regexp-in-string (car subst)\r
++ (cdr subst)\r
++ str)))\r
++ `(("%a" . ,author)\r
++ ("%s" . ,subject)\r
++ ("%d" . ,date)\r
++ ("%r" . ,reldate)))\r
++ str))\r
++ ((and (listp elem) (eq (car elem) :eval))\r
++ (eval (second elem)))\r
++ (t (error "Unknown element in `notmuch-outline-format': %S" elem))))\r
++ format\r
++ "")))\r
++\r
++(defun notmuch-outline-highlight-message (msg-start)\r
++ "Highlight message starting at MSG-START.\r
++\r
++The highlighting will take place in the outline buffer, while\r
++MSG-START refers to a position in the corresponding notmuch-show buffer."\r
++ (when (buffer-live-p notmuch-show-outline-buffer)\r
++ (with-current-buffer notmuch-show-outline-buffer\r
++ (remove-overlays nil nil 'current-message t)\r
++ (save-excursion\r
++ (goto-char (point-min))\r
++ (while (and (not (equal (get-text-property (point) :message-start)\r
++ msg-start))\r
++ (not (eobp)))\r
++ (forward-line))\r
++ (unless (eobp)\r
++ (let ((ovl\r
++ (make-overlay (line-beginning-position)\r
++ (line-end-position))))\r
++ (overlay-put ovl 'face 'notmuch-outline-highlighted)\r
++ (overlay-put ovl 'current-message t)))))))\r
++\r
++(defun notmuch-show-create-outline-buffer (&optional buf)\r
++ "Create an outline buffer for show-buffer BUF.\r
++\r
++Returns the created buffer."\r
++\r
++ (generate-new-buffer (concat (buffer-name buf) " - outline")))\r
++\r
++(defun notmuch-outline-message ()\r
++ "Outline the message under the point.\r
++\r
++Expects the point to be on the beginning of the first line of the message."\r
++ (lexical-let*\r
++ ((msg-start (car (notmuch-show-message-extent)))\r
++ (outline-buf notmuch-show-outline-buffer)\r
++ (goto-message\r
++ (lambda (btn)\r
++ (let ((win (get-buffer-window outline-buf)))\r
++ (when win\r
++ (select-window (get-buffer-window outline-buf))\r
++ (when (marker-buffer msg-start)\r
++ (switch-to-buffer-other-window (marker-buffer msg-start))\r
++ (notmuch-outline-highlight-message msg-start)\r
++ (goto-char (marker-position msg-start))\r
++ (when (not (notmuch-show-message-is-visible))\r
++ (notmuch-show-toggle-message))))))))\r
++ (let ((indentation (or (get-text-property (point) :notmuch-depth) 0))\r
++ (button-label (notmuch-outline-render-format\r
++ notmuch-outline-format)))\r
++ (with-current-buffer outline-buf\r
++ (indent-to indentation)\r
++ (insert button-label)\r
++ (make-text-button (line-beginning-position) (line-end-position)\r
++ 'action goto-message\r
++ 'follow-link t\r
++ 'help-echo "mouse-1, RET: show this message"\r
++ 'face 'notmuch-outline)\r
++ (put-text-property (line-beginning-position) (line-end-position)\r
++ :message-start msg-start)\r
++ (insert "\n")))))\r
++\r
++(defun notmuch-show-outline ()\r
++ "Generate an outline for the current buffer.\r
++\r
++This function must only be called in a notmuch-show buffer."\r
++ (interactive)\r
++ (if (buffer-live-p notmuch-show-outline-buffer)\r
++ (switch-to-buffer-other-window notmuch-show-outline-buffer)\r
++ (let ((outline-buf (notmuch-show-create-outline-buffer))\r
++ (inhibit-point-motion-hooks t))\r
++ (setq notmuch-show-outline-buffer outline-buf)\r
++ (save-excursion\r
++ (with-current-buffer outline-buf\r
++ (notmuch-outline-mode))\r
++ (goto-char (point-min))\r
++ (while (not (eobp))\r
++ (notmuch-outline-message)\r
++ (goto-char (marker-position (cdr (notmuch-show-message-extent)))))\r
++ (with-current-buffer outline-buf\r
++ (setq buffer-read-only t)))\r
++ (notmuch-outline-highlight-message (car (notmuch-show-message-extent)))\r
++ (let ((win (selected-window)))\r
++ (switch-to-buffer-other-window outline-buf)\r
++ (select-window win)))))\r
++\r
++(defun notmuch-outline-mode ()\r
++ (interactive)\r
++ (kill-all-local-variables)\r
++ (use-local-map notmuch-outline-mode-map)\r
++ (setq major-mode 'notmuch-show-outline-mode\r
++ mode-name "notmuch-show-outline"))\r
++\r
+ ;;;###autoload\r
+ (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)\r
+ "Run \"notmuch show\" with the given thread ID and display results.\r
+@@ -881,7 +1071,9 @@ buffer."\r
+ ;; Set the header line to the subject of the first open message.\r
+ (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))\r
+ \r
+- (notmuch-show-mark-read)))\r
++ (notmuch-show-mark-read)\r
++ (when notmuch-always-show-outline\r
++ (notmuch-show-outline))))\r
+ \r
+ (defun notmuch-show-refresh-view (&optional crypto-switch)\r
+ "Refresh the current view (with crypto switch if prefix given).\r
+@@ -941,6 +1133,7 @@ thread id. If a prefix is given, crypto processing is toggled."\r
+ (define-key map "P" 'notmuch-show-previous-message)\r
+ (define-key map "n" 'notmuch-show-next-open-message)\r
+ (define-key map "p" 'notmuch-show-previous-open-message)\r
++ (define-key map "o" 'notmuch-show-outline)\r
+ (define-key map (kbd "DEL") 'notmuch-show-rewind)\r
+ (define-key map " " 'notmuch-show-advance-and-archive)\r
+ (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)\r
+-- \r
+1.7.7.3\r
+\r
projects / notmuch-archives.git / commitdiff