[PATCH] emacs: thread outlining

[PATCH] emacs: thread outlining

[Daniel Schoepe]

Unfortunately, this implementation does not yet highlight the currently selected
message in the notmuch-show buffer in the corresponding outline buffer. The
point-entered and point-left text properties sound like they should be useful
for implementing this, but behaved somewhat erratically for me and I did not
yet have time to track this down, so any help on this is appreciated.

[PATCH 1/3] emacs: Document notmuch-show-get-message-properties

[Daniel Schoepe]

---
 emacs/notmuch-show.el |    6 ++++++
 1 files changed, 6 insertions(+), 0 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index fb91c83..aecd35f 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1017,6 +1017,12 @@ All currently available key bindings:
     (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
 
 (defun notmuch-show-get-message-properties ()
+  "Return the properties of the current message as a plist.
+
+Some useful entries are:
+:headers - Property list containing the headers :Date, :Subject, :From, etc.
+:body - Body of the message
+:tags - Tags for this message"
   (save-excursion
     (notmuch-show-move-to-message-top)
     (get-text-property (point) :notmuch-message-properties)))
-- 
1.7.5.4

[PATCH 2/3] emacs: Add thread-outline functionality

[Daniel Schoepe]

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 "<mouse-1>") '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

Re: [PATCH 2/3] emacs: Add thread-outline functionality

[Austin Clements]

Have you tried post-command-hook?  It's overkill, but if you can very
quickly check that you don't have to do anything, the overhead should
be negligible.  It doesn't have the strange point-entered behavior,
but still has a marked advantage over zero-duration idle timers
because you can register your hook for just the outline and show
buffers and it won't get called after actions in other buffers.

I do have one overall structural concern with this patch.  This might
be addressed along with better synchronization between the show and
outline buffers, but my concern is what happens when you switch
between buffers (in particular, multiple show buffers).  I think the
behavior I would expect is that if I switch to another show buffer,
the outline would update to reflect that other show buffer.  If I
switch to a non-show buffer, I would probably expect the outline
window to go away.  Thoughts?

 (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)))

Just killing the buffer leads to some strange behavior for me.  If I'm
in a show buffer, then hit 'o' and then 'q', my frame is still split
into two windows, one of which shows where I came from, and the other
shows some other buffer (probably the next furthest back in the LRU;
usually notmuch-hello or another search).

Also, would it work better to store the outline buffer object as a
buffer-local variable in the show buffer?  Then you wouldn't have to
go hunting for it.

+(defvar notmuch-outline-button-map
+  (let ((map (copy-keymap button-map)))
+    (define-key map (kbd "<mouse-1>") 'push-button)
+    map)
+  "Keymap used for buttons in thread outlines.")

I don't think you need this.  Does it work if you just add
'follow-link t to the make-button call?

+(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)))

Overkill?

+(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."

I would recommend a format closer to Emacs' standard format lines like
mode-line-format and header-line-format, or, more likely, some
compatible subset thereof.  In addition to being familiar, those have
the advantage of being recursive, symbolic, and able to embed
arbitrary computations within the convenience of the rest of the
formatter.  One trick I've found works really well in the past is to
let-bind things like `author' and `reldate' in the format function;
this combines naturally with expanding symbols to their values like
mode-line-format does.

+(defun notmuch-show-has-outline ()
+  "Returns non-nil if there is an outline for the current thread."
+  (get-buffer (notmuch-show-outline-buffer-name)))

Unused?

+(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))

This would probably be simpler if you just passed the outline buffer
as an argument to `notmuch-outline-message', rather than
reconstructing the buffer name.

+      ;; this is not very robust if the output of notmuch-show changes
+      (while (string-equal (thing-at-point 'char) " ")
+       (incf indentation)
+       (forward-char))

Rather than parsing the notmuch-show buffer, would it make more sense
for notmuch-show to add some property indicating the reply level,
which this could simply read?  Counting spaces seems like asking for
trouble.

+      (loop for i from 1 to indentation do
+           (princ " ")) ;; somewhat ugly

If you move the "(with-current-buffer standard-output" up, this could
simply be indent-to (and the princ's could be replaced with the less
unusual `insert').

[PATCH 3/3] emacs: Test for thread-outlining

[Daniel Schoepe]

---
 test/emacs                                         |    5 +++++
 .../notmuch-show-thread-outline                    |    7 +++++++
 2 files changed, 12 insertions(+), 0 deletions(-)
 create mode 100644 test/emacs.expected-output/notmuch-show-thread-outline

diff --git a/test/emacs b/test/emacs
index f2e9598..8d3a3c5 100755
--- a/test/emacs
+++ b/test/emacs
@@ -31,6 +31,11 @@ maildir_storage_thread=$(notmuch search --output=threads id:20091117190054.GU316
 test_emacs "(notmuch-show \"$maildir_storage_thread\") (princ (buffer-string))" >OUTPUT
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-maildir-storage
 
+test_begin_subtest "Thread outlining in notmuch-show"
+maildir_storage_thread=$(notmuch search --output=threads id:20091117190054.GU3165@dottiness.seas.harvard.edu)
+test_emacs "(notmuch-show \"$maildir_storage_thread\") (notmuch-show-outline) (switch-to-buffer (notmuch-show-outline-buffer-name)) (princ (buffer-string))" >OUTPUT
+test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-outline
+
 test_begin_subtest "notmuch-show for message with invalid From"
 add_message "[subject]=\"message-with-invalid-from\"" "[from]=\"\\\"Invalid \\\" From\\\" <test_suite@notmuchmail.org>\""
 thread=$(notmuch search --output=threads subject:message-with-invalid-from)
diff --git a/test/emacs.expected-output/notmuch-show-thread-outline b/test/emacs.expected-output/notmuch-show-thread-outline
new file mode 100644
index 0000000..b210ba7
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-show-thread-outline
@@ -0,0 +1,7 @@
+Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
+ Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
+  Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
+   "Mikhail Gusarov" <dottedmag@dottedmag.net> - 2009-11-17
+   "Keith Packard" <keithp@keithp.com> - 2009-11-17
+    Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-18
+ "Carl Worth" <cworth@cworth.org> - 2009-11-18
-- 
1.7.5.4

Re: [PATCH 3/3] emacs: Test for thread-outlining

[Aneesh Kumar K.V]

On Mon, 13 Jun 2011 01:31:20 +0200, Daniel Schoepe <daniel.schoepe@googlemail.com> wrote:
> --- /dev/null
> +++ b/test/emacs.expected-output/notmuch-show-thread-outline
> @@ -0,0 +1,7 @@
> +Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
> + Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
> +  Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
> +   "Mikhail Gusarov" <dottedmag@dottedmag.net> - 2009-11-17
> +   "Keith Packard" <keithp@keithp.com> - 2009-11-17
> +    Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-18
> + "Carl Worth" <cworth@cworth.org> - 2009-11-18
> -- 

It would be nice to have the above as . I guess GNUs does the below

Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
|-> Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
    |-> Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
        |->"Mikhail Gusarov" <dottedmag@dottedmag.net> - 2009-11-17
        |->"Keith Packard" <keithp@keithp.com> - 2009-11-17

-aneesh

Re: [PATCH 3/3] emacs: Test for thread-outlining

[Jameson Graef Rollins]

[-- Attachment #1: Type: text/plain, Size: 921 bytes --]

On Tue, 14 Jun 2011 21:58:48 +0530, "Aneesh Kumar K.V" <aneesh.kumar@linux.vnet.ibm.com> wrote:
> Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
> |-> Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
>     |-> Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
>         |->"Mikhail Gusarov" <dottedmag@dottedmag.net> - 2009-11-17
>         |->"Keith Packard" <keithp@keithp.com> - 2009-11-17

Or better yet:

┬╴ Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
├┬╴ Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
│└┬╴ Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
│ ├╴ Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
│ └╴ Keith Packard <keithp@keithp.com> - 2009-11-17
└-- Foo Bar <foobar@example.com> - 2009-11-18

I actually started working on something like this, but I haven't had
time to finish.

jamie.

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

[PATCH v2 0/3] emacs: Document notmuch-show-get-message-properties

[Daniel Schoepe]

This version fixes the issues mentioned by Austin and highlights the currently
displayed message in the outline buffer. My previous issues with 'point-entered
and 'point-left were caused by linum-mode, so don't enable it for notmuch-show buffers.

I haven't had time yet to implement a more sophisticated thread
structure display as suggested in
id:"87y613vpi6.fsf@servo.factory.finestructure.net" though.

[PATCH v2 1/3] emacs: Document notmuch-show-get-message-properties

[Daniel Schoepe]

---
 emacs/notmuch-show.el |    6 ++++++
 1 files changed, 6 insertions(+), 0 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index f96743b..262addb 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -999,6 +999,12 @@ All currently available key bindings:
     (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
 
 (defun notmuch-show-get-message-properties ()
+  "Return the properties of the current message as a plist.
+
+Some useful entries are:
+:headers - Property list containing the headers :Date, :Subject, :From, etc.
+:body - Body of the message
+:tags - Tags for this message"
   (save-excursion
     (notmuch-show-move-to-message-top)
     (get-text-property (point) :notmuch-message-properties)))
-- 
1.7.5.4

[PATCH v2 2/3] emacs: Add thread-outline functionality

[Daniel Schoepe]

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  |   12 +++
 emacs/notmuch-show.el |  195 ++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 206 insertions(+), 1 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index f93c957..e346571 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -43,6 +43,10 @@
 (defvar notmuch-folders nil
   "Deprecated name for what is now known as `notmuch-saved-searches'.")
 
+(defvar notmuch-show-outline-buffer nil
+  "Outline buffer associated with a notmuch-show buffer.")
+(make-variable-buffer-local 'notmuch-show-outline-buffer)
+
 (defun notmuch-saved-searches ()
   "Common function for querying the notmuch-saved-searches variable.
 
@@ -91,9 +95,17 @@ the user hasn't set this variable with the old or new value."
   "Return the user.other_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 notmuch-show-outline-buffer))
+      (when outline-buf
+	(mapc #'delete-window (get-buffer-window-list outline-buf))
+	(kill-buffer outline-buf))))
   (kill-buffer (current-buffer)))
 
 ;;
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 262addb..cd3eefb 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -96,6 +96,57 @@ any given message."
   :group 'notmuch
   :type 'boolean)
 
+(defcustom notmuch-always-show-outline nil
+  "Always open an outline buffer when viewing a thread?"
+  :group 'notmuch
+  :type 'boolean)
+
+(defcustom notmuch-outline-format
+  (list "%a - %r")
+  "Format used for thread-outline lines.
+
+This is a list supporting the following types of elements:
+For a symbol, its value is used if non-nil.
+A string is inserted verbatim with the exception
+ of the following %-constructs:
+ %a - Author
+ %d - Date
+ %s - Subject
+ %r - Relative date
+For a list of the form `(:eval FORM)', form is evaluated
+ and its result displayed.
+
+The variables author, subject, date and reldate will be bound to
+their respective values when this is interpreted, and can be
+used in (:eval ..)-elements or directly as symbols."
+  :group 'notmuch
+  :type
+  '(repeat (choice (const :tag "Author" author)
+		   (const :tag "Date" date)
+		   (const :tag "Relative date" reldate)
+		   (string :tag "Format string")
+		   (list :tag "Custom expression (will be evaluated when rendering)"
+			 (const :tag "" :eval)
+			 sexp))))
+
+(defface notmuch-outline '((t :inherit default))
+  "Face used to display (unhighlighted) lines in thread outlines"
+  :group 'notmuch)
+
+(defface notmuch-outline-highlighted
+  '((((class color) (background light)) (:background "#f0f0f0"))
+    (((class color) (background dark)) (:background "#303030")))
+  "Face used to display highlight the current message in the outline buffer"
+  :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" 'kill-buffer-and-window)
+    (define-key map "x" 'kill-buffer-and-window)
+    map))
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
@@ -741,12 +792,27 @@ current buffer, if possible."
     ;; message.
     (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
 
+    ;; Save the indentation depth, used by `notmuch-show-outline'
+    (put-text-property message-start message-end :notmuch-depth depth)
+
     (let ((headers-overlay (make-overlay headers-start headers-end))
           (invis-specs (list headers-invis-spec message-invis-spec)))
       (overlay-put headers-overlay 'invisible invis-specs)
       (overlay-put headers-overlay 'priority 10))
     (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
 
+    ;; Add callbacks that update the outline buffer when moving between messages.
+    ;; Due to the mindbogglingly absurd semantics of point-entered and point-left
+    ;; this function will will be run up to _four_ times when moving between messages:
+    (let ((goto-msg-func
+	   `(lambda (before after)
+	      (if (and (>= after (marker-position ,message-start))
+		       (< after (marker-position ,message-end)))
+		  (notmuch-outline-highlight-message ,message-start)))))
+      (add-text-properties message-start message-end
+			   (list 'point-entered goto-msg-func
+				 'point-left goto-msg-func)))
+
     ;; Save the properties for this message. Currently this saves the
     ;; entire message (augmented it with other stuff), which seems
     ;; like overkill. We might save a reduced subset (for example, not
@@ -778,6 +844,130 @@ current buffer, if possible."
 (defvar notmuch-show-parent-buffer nil)
 (make-variable-buffer-local 'notmuch-show-parent-buffer)
 
+(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, as described in `notmuch-outline-format'"
+  (let ((author (notmuch-show-get-from))
+	(date (notmuch-show-get-date))
+	(subject (notmuch-show-get-subject))
+	(reldate (plist-get (notmuch-show-get-message-properties)
+			    :date_relative)))
+    (mapconcat (lambda (elem)
+		 (cond
+		  ((symbolp elem) (or (symbol-value elem) ""))
+		  ((stringp elem)
+		   (let ((str elem))
+		     (mapc (lambda (subst)
+			     (setq str
+				   (replace-regexp-in-string (car subst)
+							     (cdr subst)
+							     str)))
+			   `(("%a" . ,author)
+			     ("%s" . ,subject)
+			     ("%d" . ,date)
+			     ("%r" . ,reldate)))
+		     str))
+		  ((and (listp elem) (eq (car elem) :eval))
+		   (eval (second elem)))
+		  (t (error "Unknown element in `notmuch-outline-format': %S" elem))))
+	       format
+	       "")))
+
+(defun notmuch-outline-highlight-message (msg-start)
+  "Highlight message starting at MSG-START.
+
+The highlighting will take place in the outline buffer, while
+MSG-START refers to a position in the corresponding notmuch-show buffer."
+  (when (buffer-live-p notmuch-show-outline-buffer)
+    (with-current-buffer notmuch-show-outline-buffer
+      (remove-overlays nil nil 'current-message t)
+      (save-excursion
+	(goto-char (point-min))
+	(while (and (not (equal (get-text-property (point) :message-start)
+			    msg-start))
+		  (not (eobp)))
+	  (forward-line))
+	(unless (eobp)
+	  (let ((ovl
+		 (make-overlay (line-beginning-position)
+			       (line-end-position))))
+	  (overlay-put ovl 'face 'notmuch-outline-highlighted)
+	  (overlay-put ovl 'current-message t)))))))
+
+(defun notmuch-show-create-outline-buffer (&optional buf)
+  "Create an outline buffer for show-buffer BUF.
+
+Returns the created buffer."
+
+  (generate-new-buffer (concat (buffer-name buf) " - outline")))
+
+(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*
+      ((msg-start (car (notmuch-show-message-extent)))
+       (outline-buf notmuch-show-outline-buffer)
+       (goto-message
+	(lambda (btn)
+	  (let ((win (get-buffer-window outline-buf)))
+	    (when win
+	      (select-window (get-buffer-window outline-buf))
+	      (when (marker-buffer msg-start)
+		(switch-to-buffer-other-window (marker-buffer msg-start))
+		(notmuch-outline-highlight-message msg-start)
+		(goto-char (marker-position msg-start))
+		(when (not (notmuch-show-message-is-visible))
+		  (notmuch-show-toggle-message))))))))
+    (let ((indentation (or (get-text-property (point) :notmuch-depth) 0))
+	  (button-label (notmuch-outline-render-format
+			 notmuch-outline-format)))
+      (with-current-buffer outline-buf
+	(indent-to indentation)
+	(insert button-label)
+	(make-text-button (line-beginning-position) (line-end-position)
+			  'action goto-message
+			  'follow-link t
+			  'help-echo "mouse-1, RET: show this message"
+			  'face 'notmuch-outline)
+	(put-text-property (line-beginning-position) (line-end-position)
+			   :message-start msg-start)
+	(insert "\n")))))
+
+(defun notmuch-show-outline ()
+  "Generate an outline for the current buffer.
+
+This function must only be called in a notmuch-show buffer."
+  (interactive)
+  (if (buffer-live-p notmuch-show-outline-buffer)
+      (switch-to-buffer-other-window notmuch-show-outline-buffer)
+    (let ((outline-buf (notmuch-show-create-outline-buffer))
+	  (inhibit-point-motion-hooks t))
+      (setq notmuch-show-outline-buffer outline-buf)
+      (save-excursion
+	(with-current-buffer outline-buf
+	  (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 outline-buf
+	  (setq buffer-read-only t)))
+      (notmuch-outline-highlight-message (car (notmuch-show-message-extent)))
+      (let ((win (selected-window)))
+	(switch-to-buffer-other-window outline-buf)
+	(select-window win)))))
+
+(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.
@@ -837,7 +1027,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)))
@@ -879,6 +1071,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

[PATCH v2 3/3] emacs: Test for thread-outlining

[Daniel Schoepe]

---
 test/emacs                                         |    7 +++++++
 .../notmuch-show-thread-outline                    |    7 +++++++
 2 files changed, 14 insertions(+), 0 deletions(-)
 create mode 100644 test/emacs.expected-output/notmuch-show-thread-outline

diff --git a/test/emacs b/test/emacs
index 53f455a..1b14280 100755
--- a/test/emacs
+++ b/test/emacs
@@ -55,6 +55,13 @@ test_emacs "(notmuch-show \"$maildir_storage_thread\")
 	    (test-output)"
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-maildir-storage
 
+test_begin_subtest "Thread outlining in notmuch-show"
+maildir_storage_thread=$(notmuch search --output=threads id:20091117190054.GU3165@dottiness.seas.harvard.edu)
+test_emacs "(notmuch-show \"$maildir_storage_thread\") (notmuch-show-outline)
+ 	   (switch-to-buffer notmuch-show-outline-buffer)
+	   (test-output)"
+test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-outline
+
 test_begin_subtest "notmuch-show for message with invalid From"
 add_message "[subject]=\"message-with-invalid-from\"" \
 	    "[from]=\"\\\"Invalid \\\" From\\\" <test_suite@notmuchmail.org>\""
diff --git a/test/emacs.expected-output/notmuch-show-thread-outline b/test/emacs.expected-output/notmuch-show-thread-outline
new file mode 100644
index 0000000..b210ba7
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-show-thread-outline
@@ -0,0 +1,7 @@
+Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
+ Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
+  Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
+   "Mikhail Gusarov" <dottedmag@dottedmag.net> - 2009-11-17
+   "Keith Packard" <keithp@keithp.com> - 2009-11-17
+    Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-18
+ "Carl Worth" <cworth@cworth.org> - 2009-11-18
-- 
1.7.5.4

Re: [PATCH v2 0/3] emacs: Document notmuch-show-get-message-properties

[David Bremner]

On Fri,  8 Jul 2011 20:46:54 +0200, Daniel Schoepe <daniel.schoepe@googlemail.com> wrote:
> This version fixes the issues mentioned by Austin and highlights the currently
> displayed message in the outline buffer. My previous issues with 'point-entered
> and 'point-left were caused by linum-mode, so don't enable it for notmuch-show buffers.

I have pushed the first (documentation) patch in the series.

The others are (not too surprisingly) stale and need rebasing. I'm also
not clear on whether we have concensus on whether the patches are
suitable for inclusion, so feedback from others would be welcome
(perhaps before Daniel goes to the trouble of rebasing).

d

Re: [PATCH v2 0/3] emacs: Document notmuch-show-get-message-properties

[Jameson Graef Rollins]

[-- Attachment #1: Type: text/plain, Size: 715 bytes --]

On Fri, 16 Dec 2011 09:01:21 -0400, David Bremner <david@tethera.net> wrote:
> The others are (not too surprisingly) stale and need rebasing. I'm also
> not clear on whether we have concensus on whether the patches are
> suitable for inclusion, so feedback from others would be welcome
> (perhaps before Daniel goes to the trouble of rebasing).

I definitely like the idea of thread outlining, but this isn't quite the
implementation that I would personally like to see.  What I would like
requires a bunch of changes to notmuch show, though.  This looks like it
could be kind of interesting to me in the interim, though, and it's not
particular invasive, so if Daniel want's to rebase it I see no problem.

jamie.

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

[PATCH v2 0/2] emacs: Add thread-outline functionality

[Daniel Schoepe]

Rebased to master, only one trivial conflict anyway.

[PATCH v2 1/2] emacs: Add thread-outline functionality

[Daniel Schoepe]

From: Daniel Schoepe <daniel.schoepe@googlemail.com>

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  |   12 +++
 emacs/notmuch-show.el |  195 ++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 206 insertions(+), 1 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 0f856bf..a8be8b1 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -43,6 +43,10 @@
 (defvar notmuch-folders nil
   "Deprecated name for what is now known as `notmuch-saved-searches'.")
 
+(defvar notmuch-show-outline-buffer nil
+  "Outline buffer associated with a notmuch-show buffer.")
+(make-variable-buffer-local 'notmuch-show-outline-buffer)
+
 (defun notmuch-saved-searches ()
   "Common function for querying the notmuch-saved-searches variable.
 
@@ -91,9 +95,17 @@ the user hasn't set this variable with the old or new value."
   "Return the user.other_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 notmuch-show-outline-buffer))
+      (when outline-buf
+	(mapc #'delete-window (get-buffer-window-list outline-buf))
+	(kill-buffer outline-buf))))
   (kill-buffer (current-buffer)))
 
 ;;
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 63b01e5..e7ce811 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -107,6 +107,57 @@ indentation."
   :group 'notmuch
   :type 'boolean)
 
+(defcustom notmuch-always-show-outline nil
+  "Always open an outline buffer when viewing a thread?"
+  :group 'notmuch
+  :type 'boolean)
+
+(defcustom notmuch-outline-format
+  (list "%a - %r")
+  "Format used for thread-outline lines.
+
+This is a list supporting the following types of elements:
+For a symbol, its value is used if non-nil.
+A string is inserted verbatim with the exception
+ of the following %-constructs:
+ %a - Author
+ %d - Date
+ %s - Subject
+ %r - Relative date
+For a list of the form `(:eval FORM)', form is evaluated
+ and its result displayed.
+
+The variables author, subject, date and reldate will be bound to
+their respective values when this is interpreted, and can be
+used in (:eval ..)-elements or directly as symbols."
+  :group 'notmuch
+  :type
+  '(repeat (choice (const :tag "Author" author)
+		   (const :tag "Date" date)
+		   (const :tag "Relative date" reldate)
+		   (string :tag "Format string")
+		   (list :tag "Custom expression (will be evaluated when rendering)"
+			 (const :tag "" :eval)
+			 sexp))))
+
+(defface notmuch-outline '((t :inherit default))
+  "Face used to display (unhighlighted) lines in thread outlines"
+  :group 'notmuch)
+
+(defface notmuch-outline-highlighted
+  '((((class color) (background light)) (:background "#f0f0f0"))
+    (((class color) (background dark)) (:background "#303030")))
+  "Face used to display highlight the current message in the outline buffer"
+  :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" 'kill-buffer-and-window)
+    (define-key map "x" 'kill-buffer-and-window)
+    map))
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
@@ -747,12 +798,27 @@ current buffer, if possible."
     ;; message.
     (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
 
+    ;; Save the indentation depth, used by `notmuch-show-outline'
+    (put-text-property message-start message-end :notmuch-depth depth)
+
     (let ((headers-overlay (make-overlay headers-start headers-end))
           (invis-specs (list headers-invis-spec message-invis-spec)))
       (overlay-put headers-overlay 'invisible invis-specs)
       (overlay-put headers-overlay 'priority 10))
     (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
 
+    ;; Add callbacks that update the outline buffer when moving between messages.
+    ;; Due to the mindbogglingly absurd semantics of point-entered and point-left
+    ;; this function will will be run up to _four_ times when moving between messages:
+    (let ((goto-msg-func
+	   `(lambda (before after)
+	      (if (and (>= after (marker-position ,message-start))
+		       (< after (marker-position ,message-end)))
+		  (notmuch-outline-highlight-message ,message-start)))))
+      (add-text-properties message-start message-end
+			   (list 'point-entered goto-msg-func
+				 'point-left goto-msg-func)))
+
     ;; Save the properties for this message. Currently this saves the
     ;; entire message (augmented it with other stuff), which seems
     ;; like overkill. We might save a reduced subset (for example, not
@@ -808,6 +874,130 @@ a corresponding notmuch search."
 			'help-echo "Mouse-1, RET: search for this message"
 			'face goto-address-mail-face))))
 
+(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, as described in `notmuch-outline-format'"
+  (let ((author (notmuch-show-get-from))
+	(date (notmuch-show-get-date))
+	(subject (notmuch-show-get-subject))
+	(reldate (plist-get (notmuch-show-get-message-properties)
+			    :date_relative)))
+    (mapconcat (lambda (elem)
+		 (cond
+		  ((symbolp elem) (or (symbol-value elem) ""))
+		  ((stringp elem)
+		   (let ((str elem))
+		     (mapc (lambda (subst)
+			     (setq str
+				   (replace-regexp-in-string (car subst)
+							     (cdr subst)
+							     str)))
+			   `(("%a" . ,author)
+			     ("%s" . ,subject)
+			     ("%d" . ,date)
+			     ("%r" . ,reldate)))
+		     str))
+		  ((and (listp elem) (eq (car elem) :eval))
+		   (eval (second elem)))
+		  (t (error "Unknown element in `notmuch-outline-format': %S" elem))))
+	       format
+	       "")))
+
+(defun notmuch-outline-highlight-message (msg-start)
+  "Highlight message starting at MSG-START.
+
+The highlighting will take place in the outline buffer, while
+MSG-START refers to a position in the corresponding notmuch-show buffer."
+  (when (buffer-live-p notmuch-show-outline-buffer)
+    (with-current-buffer notmuch-show-outline-buffer
+      (remove-overlays nil nil 'current-message t)
+      (save-excursion
+	(goto-char (point-min))
+	(while (and (not (equal (get-text-property (point) :message-start)
+			    msg-start))
+		  (not (eobp)))
+	  (forward-line))
+	(unless (eobp)
+	  (let ((ovl
+		 (make-overlay (line-beginning-position)
+			       (line-end-position))))
+	  (overlay-put ovl 'face 'notmuch-outline-highlighted)
+	  (overlay-put ovl 'current-message t)))))))
+
+(defun notmuch-show-create-outline-buffer (&optional buf)
+  "Create an outline buffer for show-buffer BUF.
+
+Returns the created buffer."
+
+  (generate-new-buffer (concat (buffer-name buf) " - outline")))
+
+(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*
+      ((msg-start (car (notmuch-show-message-extent)))
+       (outline-buf notmuch-show-outline-buffer)
+       (goto-message
+	(lambda (btn)
+	  (let ((win (get-buffer-window outline-buf)))
+	    (when win
+	      (select-window (get-buffer-window outline-buf))
+	      (when (marker-buffer msg-start)
+		(switch-to-buffer-other-window (marker-buffer msg-start))
+		(notmuch-outline-highlight-message msg-start)
+		(goto-char (marker-position msg-start))
+		(when (not (notmuch-show-message-is-visible))
+		  (notmuch-show-toggle-message))))))))
+    (let ((indentation (or (get-text-property (point) :notmuch-depth) 0))
+	  (button-label (notmuch-outline-render-format
+			 notmuch-outline-format)))
+      (with-current-buffer outline-buf
+	(indent-to indentation)
+	(insert button-label)
+	(make-text-button (line-beginning-position) (line-end-position)
+			  'action goto-message
+			  'follow-link t
+			  'help-echo "mouse-1, RET: show this message"
+			  'face 'notmuch-outline)
+	(put-text-property (line-beginning-position) (line-end-position)
+			   :message-start msg-start)
+	(insert "\n")))))
+
+(defun notmuch-show-outline ()
+  "Generate an outline for the current buffer.
+
+This function must only be called in a notmuch-show buffer."
+  (interactive)
+  (if (buffer-live-p notmuch-show-outline-buffer)
+      (switch-to-buffer-other-window notmuch-show-outline-buffer)
+    (let ((outline-buf (notmuch-show-create-outline-buffer))
+	  (inhibit-point-motion-hooks t))
+      (setq notmuch-show-outline-buffer outline-buf)
+      (save-excursion
+	(with-current-buffer outline-buf
+	  (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 outline-buf
+	  (setq buffer-read-only t)))
+      (notmuch-outline-highlight-message (car (notmuch-show-message-extent)))
+      (let ((win (selected-window)))
+	(switch-to-buffer-other-window outline-buf)
+	(select-window win)))))
+
+(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.
@@ -881,7 +1071,9 @@ buffer."
     ;; 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))))
 
 (defun notmuch-show-refresh-view (&optional crypto-switch)
   "Refresh the current view (with crypto switch if prefix given).
@@ -941,6 +1133,7 @@ thread id.  If a prefix is given, crypto processing is toggled."
 	(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.7.3

[PATCH v2 2/2] emacs: Test for thread-outlining

[Daniel Schoepe]

From: Daniel Schoepe <daniel.schoepe@googlemail.com>

---
 test/emacs |    7 +++++++
 1 files changed, 7 insertions(+), 0 deletions(-)

diff --git a/test/emacs b/test/emacs
index 6e922de..e706909 100755
--- a/test/emacs
+++ b/test/emacs
@@ -71,6 +71,13 @@ test_emacs "(let ((notmuch-indent-messages-width 4))
 	      (test-output))"
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-maildir-storage-with-fourfold-indentation
 
+test_begin_subtest "Thread outlining in notmuch-show"
+maildir_storage_thread=$(notmuch search --output=threads id:20091117190054.GU3165@dottiness.seas.harvard.edu)
+test_emacs "(notmuch-show \"$maildir_storage_thread\") (notmuch-show-outline)
+ 	   (switch-to-buffer notmuch-show-outline-buffer)
+	   (test-output)"
+test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-outline
+
 test_begin_subtest "notmuch-show for message with invalid From"
 add_message "[subject]=\"message-with-invalid-from\"" \
 	    "[from]=\"\\\"Invalid \\\" From\\\" <test_suite@notmuchmail.org>\""
-- 
1.7.7.3

Re: [PATCH v2 2/2] emacs: Test for thread-outlining

[Jameson Graef Rollins]

[-- Attachment #1: Type: text/plain, Size: 289 bytes --]

fyi this patch applied, but I got the following warning from git:

Applying: emacs: Test for thread-outlining
/home/jrollins/src/notmuch/git/.git/rebase-apply/patch:16: space before tab in indent.
 	   (switch-to-buffer notmuch-show-outline-buffer)
warning: 1 line adds whitespace errors.

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

[PATCH v3 1/2] emacs: Add thread-outline functionality

[Daniel Schoepe]

I somehow managed to forget the actual test file in the previous version...

[PATCH v3 1/2] emacs: Add thread-outline functionality

[Daniel Schoepe]

From: Daniel Schoepe <daniel.schoepe@googlemail.com>

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  |   12 +++
 emacs/notmuch-show.el |  195 ++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 206 insertions(+), 1 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 0f856bf..a8be8b1 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -43,6 +43,10 @@
 (defvar notmuch-folders nil
   "Deprecated name for what is now known as `notmuch-saved-searches'.")
 
+(defvar notmuch-show-outline-buffer nil
+  "Outline buffer associated with a notmuch-show buffer.")
+(make-variable-buffer-local 'notmuch-show-outline-buffer)
+
 (defun notmuch-saved-searches ()
   "Common function for querying the notmuch-saved-searches variable.
 
@@ -91,9 +95,17 @@ the user hasn't set this variable with the old or new value."
   "Return the user.other_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 notmuch-show-outline-buffer))
+      (when outline-buf
+	(mapc #'delete-window (get-buffer-window-list outline-buf))
+	(kill-buffer outline-buf))))
   (kill-buffer (current-buffer)))
 
 ;;
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 63b01e5..e7ce811 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -107,6 +107,57 @@ indentation."
   :group 'notmuch
   :type 'boolean)
 
+(defcustom notmuch-always-show-outline nil
+  "Always open an outline buffer when viewing a thread?"
+  :group 'notmuch
+  :type 'boolean)
+
+(defcustom notmuch-outline-format
+  (list "%a - %r")
+  "Format used for thread-outline lines.
+
+This is a list supporting the following types of elements:
+For a symbol, its value is used if non-nil.
+A string is inserted verbatim with the exception
+ of the following %-constructs:
+ %a - Author
+ %d - Date
+ %s - Subject
+ %r - Relative date
+For a list of the form `(:eval FORM)', form is evaluated
+ and its result displayed.
+
+The variables author, subject, date and reldate will be bound to
+their respective values when this is interpreted, and can be
+used in (:eval ..)-elements or directly as symbols."
+  :group 'notmuch
+  :type
+  '(repeat (choice (const :tag "Author" author)
+		   (const :tag "Date" date)
+		   (const :tag "Relative date" reldate)
+		   (string :tag "Format string")
+		   (list :tag "Custom expression (will be evaluated when rendering)"
+			 (const :tag "" :eval)
+			 sexp))))
+
+(defface notmuch-outline '((t :inherit default))
+  "Face used to display (unhighlighted) lines in thread outlines"
+  :group 'notmuch)
+
+(defface notmuch-outline-highlighted
+  '((((class color) (background light)) (:background "#f0f0f0"))
+    (((class color) (background dark)) (:background "#303030")))
+  "Face used to display highlight the current message in the outline buffer"
+  :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" 'kill-buffer-and-window)
+    (define-key map "x" 'kill-buffer-and-window)
+    map))
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
@@ -747,12 +798,27 @@ current buffer, if possible."
     ;; message.
     (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
 
+    ;; Save the indentation depth, used by `notmuch-show-outline'
+    (put-text-property message-start message-end :notmuch-depth depth)
+
     (let ((headers-overlay (make-overlay headers-start headers-end))
           (invis-specs (list headers-invis-spec message-invis-spec)))
       (overlay-put headers-overlay 'invisible invis-specs)
       (overlay-put headers-overlay 'priority 10))
     (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
 
+    ;; Add callbacks that update the outline buffer when moving between messages.
+    ;; Due to the mindbogglingly absurd semantics of point-entered and point-left
+    ;; this function will will be run up to _four_ times when moving between messages:
+    (let ((goto-msg-func
+	   `(lambda (before after)
+	      (if (and (>= after (marker-position ,message-start))
+		       (< after (marker-position ,message-end)))
+		  (notmuch-outline-highlight-message ,message-start)))))
+      (add-text-properties message-start message-end
+			   (list 'point-entered goto-msg-func
+				 'point-left goto-msg-func)))
+
     ;; Save the properties for this message. Currently this saves the
     ;; entire message (augmented it with other stuff), which seems
     ;; like overkill. We might save a reduced subset (for example, not
@@ -808,6 +874,130 @@ a corresponding notmuch search."
 			'help-echo "Mouse-1, RET: search for this message"
 			'face goto-address-mail-face))))
 
+(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, as described in `notmuch-outline-format'"
+  (let ((author (notmuch-show-get-from))
+	(date (notmuch-show-get-date))
+	(subject (notmuch-show-get-subject))
+	(reldate (plist-get (notmuch-show-get-message-properties)
+			    :date_relative)))
+    (mapconcat (lambda (elem)
+		 (cond
+		  ((symbolp elem) (or (symbol-value elem) ""))
+		  ((stringp elem)
+		   (let ((str elem))
+		     (mapc (lambda (subst)
+			     (setq str
+				   (replace-regexp-in-string (car subst)
+							     (cdr subst)
+							     str)))
+			   `(("%a" . ,author)
+			     ("%s" . ,subject)
+			     ("%d" . ,date)
+			     ("%r" . ,reldate)))
+		     str))
+		  ((and (listp elem) (eq (car elem) :eval))
+		   (eval (second elem)))
+		  (t (error "Unknown element in `notmuch-outline-format': %S" elem))))
+	       format
+	       "")))
+
+(defun notmuch-outline-highlight-message (msg-start)
+  "Highlight message starting at MSG-START.
+
+The highlighting will take place in the outline buffer, while
+MSG-START refers to a position in the corresponding notmuch-show buffer."
+  (when (buffer-live-p notmuch-show-outline-buffer)
+    (with-current-buffer notmuch-show-outline-buffer
+      (remove-overlays nil nil 'current-message t)
+      (save-excursion
+	(goto-char (point-min))
+	(while (and (not (equal (get-text-property (point) :message-start)
+			    msg-start))
+		  (not (eobp)))
+	  (forward-line))
+	(unless (eobp)
+	  (let ((ovl
+		 (make-overlay (line-beginning-position)
+			       (line-end-position))))
+	  (overlay-put ovl 'face 'notmuch-outline-highlighted)
+	  (overlay-put ovl 'current-message t)))))))
+
+(defun notmuch-show-create-outline-buffer (&optional buf)
+  "Create an outline buffer for show-buffer BUF.
+
+Returns the created buffer."
+
+  (generate-new-buffer (concat (buffer-name buf) " - outline")))
+
+(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*
+      ((msg-start (car (notmuch-show-message-extent)))
+       (outline-buf notmuch-show-outline-buffer)
+       (goto-message
+	(lambda (btn)
+	  (let ((win (get-buffer-window outline-buf)))
+	    (when win
+	      (select-window (get-buffer-window outline-buf))
+	      (when (marker-buffer msg-start)
+		(switch-to-buffer-other-window (marker-buffer msg-start))
+		(notmuch-outline-highlight-message msg-start)
+		(goto-char (marker-position msg-start))
+		(when (not (notmuch-show-message-is-visible))
+		  (notmuch-show-toggle-message))))))))
+    (let ((indentation (or (get-text-property (point) :notmuch-depth) 0))
+	  (button-label (notmuch-outline-render-format
+			 notmuch-outline-format)))
+      (with-current-buffer outline-buf
+	(indent-to indentation)
+	(insert button-label)
+	(make-text-button (line-beginning-position) (line-end-position)
+			  'action goto-message
+			  'follow-link t
+			  'help-echo "mouse-1, RET: show this message"
+			  'face 'notmuch-outline)
+	(put-text-property (line-beginning-position) (line-end-position)
+			   :message-start msg-start)
+	(insert "\n")))))
+
+(defun notmuch-show-outline ()
+  "Generate an outline for the current buffer.
+
+This function must only be called in a notmuch-show buffer."
+  (interactive)
+  (if (buffer-live-p notmuch-show-outline-buffer)
+      (switch-to-buffer-other-window notmuch-show-outline-buffer)
+    (let ((outline-buf (notmuch-show-create-outline-buffer))
+	  (inhibit-point-motion-hooks t))
+      (setq notmuch-show-outline-buffer outline-buf)
+      (save-excursion
+	(with-current-buffer outline-buf
+	  (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 outline-buf
+	  (setq buffer-read-only t)))
+      (notmuch-outline-highlight-message (car (notmuch-show-message-extent)))
+      (let ((win (selected-window)))
+	(switch-to-buffer-other-window outline-buf)
+	(select-window win)))))
+
+(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.
@@ -881,7 +1071,9 @@ buffer."
     ;; 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))))
 
 (defun notmuch-show-refresh-view (&optional crypto-switch)
   "Refresh the current view (with crypto switch if prefix given).
@@ -941,6 +1133,7 @@ thread id.  If a prefix is given, crypto processing is toggled."
 	(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.7.3

[PATCH v3 2/2] emacs: Test for thread-outlining

[Daniel Schoepe]

From: Daniel Schoepe <daniel.schoepe@googlemail.com>

---
 test/emacs                                         |    7 +++++++
 .../notmuch-show-thread-outline                    |    7 +++++++
 2 files changed, 14 insertions(+), 0 deletions(-)
 create mode 100644 test/emacs.expected-output/notmuch-show-thread-outline

diff --git a/test/emacs b/test/emacs
index 6e922de..e706909 100755
--- a/test/emacs
+++ b/test/emacs
@@ -71,6 +71,13 @@ test_emacs "(let ((notmuch-indent-messages-width 4))
 	      (test-output))"
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-maildir-storage-with-fourfold-indentation
 
+test_begin_subtest "Thread outlining in notmuch-show"
+maildir_storage_thread=$(notmuch search --output=threads id:20091117190054.GU3165@dottiness.seas.harvard.edu)
+test_emacs "(notmuch-show \"$maildir_storage_thread\") (notmuch-show-outline)
+ 	   (switch-to-buffer notmuch-show-outline-buffer)
+	   (test-output)"
+test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-outline
+
 test_begin_subtest "notmuch-show for message with invalid From"
 add_message "[subject]=\"message-with-invalid-from\"" \
 	    "[from]=\"\\\"Invalid \\\" From\\\" <test_suite@notmuchmail.org>\""
diff --git a/test/emacs.expected-output/notmuch-show-thread-outline b/test/emacs.expected-output/notmuch-show-thread-outline
new file mode 100644
index 0000000..b210ba7
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-show-thread-outline
@@ -0,0 +1,7 @@
+Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
+ Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
+  Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
+   "Mikhail Gusarov" <dottedmag@dottedmag.net> - 2009-11-17
+   "Keith Packard" <keithp@keithp.com> - 2009-11-17
+    Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-18
+ "Carl Worth" <cworth@cworth.org> - 2009-11-18
-- 
1.7.7.3

(no subject)

[Daniel Schoepe]

Fixed whitespace error reported by Jameson.

[PATCH v4 1/2] emacs: Add thread-outline functionality

[Daniel Schoepe]

From: Daniel Schoepe <daniel.schoepe@googlemail.com>

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  |   12 +++
 emacs/notmuch-show.el |  195 ++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 206 insertions(+), 1 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 0f856bf..a8be8b1 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -43,6 +43,10 @@
 (defvar notmuch-folders nil
   "Deprecated name for what is now known as `notmuch-saved-searches'.")
 
+(defvar notmuch-show-outline-buffer nil
+  "Outline buffer associated with a notmuch-show buffer.")
+(make-variable-buffer-local 'notmuch-show-outline-buffer)
+
 (defun notmuch-saved-searches ()
   "Common function for querying the notmuch-saved-searches variable.
 
@@ -91,9 +95,17 @@ the user hasn't set this variable with the old or new value."
   "Return the user.other_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 notmuch-show-outline-buffer))
+      (when outline-buf
+	(mapc #'delete-window (get-buffer-window-list outline-buf))
+	(kill-buffer outline-buf))))
   (kill-buffer (current-buffer)))
 
 ;;
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 63b01e5..e7ce811 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -107,6 +107,57 @@ indentation."
   :group 'notmuch
   :type 'boolean)
 
+(defcustom notmuch-always-show-outline nil
+  "Always open an outline buffer when viewing a thread?"
+  :group 'notmuch
+  :type 'boolean)
+
+(defcustom notmuch-outline-format
+  (list "%a - %r")
+  "Format used for thread-outline lines.
+
+This is a list supporting the following types of elements:
+For a symbol, its value is used if non-nil.
+A string is inserted verbatim with the exception
+ of the following %-constructs:
+ %a - Author
+ %d - Date
+ %s - Subject
+ %r - Relative date
+For a list of the form `(:eval FORM)', form is evaluated
+ and its result displayed.
+
+The variables author, subject, date and reldate will be bound to
+their respective values when this is interpreted, and can be
+used in (:eval ..)-elements or directly as symbols."
+  :group 'notmuch
+  :type
+  '(repeat (choice (const :tag "Author" author)
+		   (const :tag "Date" date)
+		   (const :tag "Relative date" reldate)
+		   (string :tag "Format string")
+		   (list :tag "Custom expression (will be evaluated when rendering)"
+			 (const :tag "" :eval)
+			 sexp))))
+
+(defface notmuch-outline '((t :inherit default))
+  "Face used to display (unhighlighted) lines in thread outlines"
+  :group 'notmuch)
+
+(defface notmuch-outline-highlighted
+  '((((class color) (background light)) (:background "#f0f0f0"))
+    (((class color) (background dark)) (:background "#303030")))
+  "Face used to display highlight the current message in the outline buffer"
+  :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" 'kill-buffer-and-window)
+    (define-key map "x" 'kill-buffer-and-window)
+    map))
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
@@ -747,12 +798,27 @@ current buffer, if possible."
     ;; message.
     (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
 
+    ;; Save the indentation depth, used by `notmuch-show-outline'
+    (put-text-property message-start message-end :notmuch-depth depth)
+
     (let ((headers-overlay (make-overlay headers-start headers-end))
           (invis-specs (list headers-invis-spec message-invis-spec)))
       (overlay-put headers-overlay 'invisible invis-specs)
       (overlay-put headers-overlay 'priority 10))
     (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)
 
+    ;; Add callbacks that update the outline buffer when moving between messages.
+    ;; Due to the mindbogglingly absurd semantics of point-entered and point-left
+    ;; this function will will be run up to _four_ times when moving between messages:
+    (let ((goto-msg-func
+	   `(lambda (before after)
+	      (if (and (>= after (marker-position ,message-start))
+		       (< after (marker-position ,message-end)))
+		  (notmuch-outline-highlight-message ,message-start)))))
+      (add-text-properties message-start message-end
+			   (list 'point-entered goto-msg-func
+				 'point-left goto-msg-func)))
+
     ;; Save the properties for this message. Currently this saves the
     ;; entire message (augmented it with other stuff), which seems
     ;; like overkill. We might save a reduced subset (for example, not
@@ -808,6 +874,130 @@ a corresponding notmuch search."
 			'help-echo "Mouse-1, RET: search for this message"
 			'face goto-address-mail-face))))
 
+(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, as described in `notmuch-outline-format'"
+  (let ((author (notmuch-show-get-from))
+	(date (notmuch-show-get-date))
+	(subject (notmuch-show-get-subject))
+	(reldate (plist-get (notmuch-show-get-message-properties)
+			    :date_relative)))
+    (mapconcat (lambda (elem)
+		 (cond
+		  ((symbolp elem) (or (symbol-value elem) ""))
+		  ((stringp elem)
+		   (let ((str elem))
+		     (mapc (lambda (subst)
+			     (setq str
+				   (replace-regexp-in-string (car subst)
+							     (cdr subst)
+							     str)))
+			   `(("%a" . ,author)
+			     ("%s" . ,subject)
+			     ("%d" . ,date)
+			     ("%r" . ,reldate)))
+		     str))
+		  ((and (listp elem) (eq (car elem) :eval))
+		   (eval (second elem)))
+		  (t (error "Unknown element in `notmuch-outline-format': %S" elem))))
+	       format
+	       "")))
+
+(defun notmuch-outline-highlight-message (msg-start)
+  "Highlight message starting at MSG-START.
+
+The highlighting will take place in the outline buffer, while
+MSG-START refers to a position in the corresponding notmuch-show buffer."
+  (when (buffer-live-p notmuch-show-outline-buffer)
+    (with-current-buffer notmuch-show-outline-buffer
+      (remove-overlays nil nil 'current-message t)
+      (save-excursion
+	(goto-char (point-min))
+	(while (and (not (equal (get-text-property (point) :message-start)
+			    msg-start))
+		  (not (eobp)))
+	  (forward-line))
+	(unless (eobp)
+	  (let ((ovl
+		 (make-overlay (line-beginning-position)
+			       (line-end-position))))
+	  (overlay-put ovl 'face 'notmuch-outline-highlighted)
+	  (overlay-put ovl 'current-message t)))))))
+
+(defun notmuch-show-create-outline-buffer (&optional buf)
+  "Create an outline buffer for show-buffer BUF.
+
+Returns the created buffer."
+
+  (generate-new-buffer (concat (buffer-name buf) " - outline")))
+
+(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*
+      ((msg-start (car (notmuch-show-message-extent)))
+       (outline-buf notmuch-show-outline-buffer)
+       (goto-message
+	(lambda (btn)
+	  (let ((win (get-buffer-window outline-buf)))
+	    (when win
+	      (select-window (get-buffer-window outline-buf))
+	      (when (marker-buffer msg-start)
+		(switch-to-buffer-other-window (marker-buffer msg-start))
+		(notmuch-outline-highlight-message msg-start)
+		(goto-char (marker-position msg-start))
+		(when (not (notmuch-show-message-is-visible))
+		  (notmuch-show-toggle-message))))))))
+    (let ((indentation (or (get-text-property (point) :notmuch-depth) 0))
+	  (button-label (notmuch-outline-render-format
+			 notmuch-outline-format)))
+      (with-current-buffer outline-buf
+	(indent-to indentation)
+	(insert button-label)
+	(make-text-button (line-beginning-position) (line-end-position)
+			  'action goto-message
+			  'follow-link t
+			  'help-echo "mouse-1, RET: show this message"
+			  'face 'notmuch-outline)
+	(put-text-property (line-beginning-position) (line-end-position)
+			   :message-start msg-start)
+	(insert "\n")))))
+
+(defun notmuch-show-outline ()
+  "Generate an outline for the current buffer.
+
+This function must only be called in a notmuch-show buffer."
+  (interactive)
+  (if (buffer-live-p notmuch-show-outline-buffer)
+      (switch-to-buffer-other-window notmuch-show-outline-buffer)
+    (let ((outline-buf (notmuch-show-create-outline-buffer))
+	  (inhibit-point-motion-hooks t))
+      (setq notmuch-show-outline-buffer outline-buf)
+      (save-excursion
+	(with-current-buffer outline-buf
+	  (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 outline-buf
+	  (setq buffer-read-only t)))
+      (notmuch-outline-highlight-message (car (notmuch-show-message-extent)))
+      (let ((win (selected-window)))
+	(switch-to-buffer-other-window outline-buf)
+	(select-window win)))))
+
+(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.
@@ -881,7 +1071,9 @@ buffer."
     ;; 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))))
 
 (defun notmuch-show-refresh-view (&optional crypto-switch)
   "Refresh the current view (with crypto switch if prefix given).
@@ -941,6 +1133,7 @@ thread id.  If a prefix is given, crypto processing is toggled."
 	(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.7.3

Re: [PATCH v4 1/2] emacs: Add thread-outline functionality

[Daniel Schoepe]

[-- Attachment #1: Type: text/plain, Size: 175 bytes --]

I think notmuch-pick [1] is a better approach and also provides
thread-outlining, so these patches should be obsolete now.

[1] id:"87d39k1gvi.fsf@qmul.ac.uk"

Cheers,
Daniel

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]

[PATCH v4 2/2] emacs: Test for thread-outlining

[Daniel Schoepe]

From: Daniel Schoepe <daniel.schoepe@googlemail.com>

---
 test/emacs                                         |    7 +++++++
 .../notmuch-show-thread-outline                    |    7 +++++++
 2 files changed, 14 insertions(+), 0 deletions(-)
 create mode 100644 test/emacs.expected-output/notmuch-show-thread-outline

diff --git a/test/emacs b/test/emacs
index 6e922de..f986d3c 100755
--- a/test/emacs
+++ b/test/emacs
@@ -71,6 +71,13 @@ test_emacs "(let ((notmuch-indent-messages-width 4))
 	      (test-output))"
 test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-maildir-storage-with-fourfold-indentation
 
+test_begin_subtest "Thread outlining in notmuch-show"
+maildir_storage_thread=$(notmuch search --output=threads id:20091117190054.GU3165@dottiness.seas.harvard.edu)
+test_emacs "(notmuch-show \"$maildir_storage_thread\") (notmuch-show-outline)
+	    (switch-to-buffer notmuch-show-outline-buffer)
+	    (test-output)"
+test_expect_equal_file OUTPUT $EXPECTED/notmuch-show-thread-outline
+
 test_begin_subtest "notmuch-show for message with invalid From"
 add_message "[subject]=\"message-with-invalid-from\"" \
 	    "[from]=\"\\\"Invalid \\\" From\\\" <test_suite@notmuchmail.org>\""
diff --git a/test/emacs.expected-output/notmuch-show-thread-outline b/test/emacs.expected-output/notmuch-show-thread-outline
new file mode 100644
index 0000000..b210ba7
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-show-thread-outline
@@ -0,0 +1,7 @@
+Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
+ Mikhail Gusarov <dottedmag@dottedmag.net> - 2009-11-17
+  Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-17
+   "Mikhail Gusarov" <dottedmag@dottedmag.net> - 2009-11-17
+   "Keith Packard" <keithp@keithp.com> - 2009-11-17
+    Lars Kellogg-Stedman <lars@seas.harvard.edu> - 2009-11-18
+ "Carl Worth" <cworth@cworth.org> - 2009-11-18
-- 
1.7.7.3