[PATCH] emacs: Add more functions to clean up text/plain parts

[PATCH] emacs: Add more functions to clean up text/plain parts

[David Edmondson]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 11665 bytes --]

Add:
- notmuch-wash-wrap-long-lines: Wrap lines longer than the width of
  the current window whilst maintaining any citation prefix.
- notmuch-wash-tidy-citations: Tidy up citations by:
  - compress repeated otherwise blank citation lines,
  - remove otherwise blank citation lines at the head and tail of a
    citation and remove blank lines between attribution statements and
    the citation,
- notmuch-wash-compress-blanks: Compress repeated blank lines and
  remove leading and trailing blank lines.

Enable `notmuch-wash-tidy-citations' and
`notmuch-wash-compress-blanks' by default by adding them to
`notmuch-show-insert-text/plain-hook'. `notmuch-wash-wrap-long-lines'
is not enabled by default.

If `notmuch-wash-wrap-long-lines' is enabled, word wrapping of the
buffer leads to an unappealing display of text, so provide a function
to disable it and add it to the list of `notmuch-show-mode' hook
functions.
---

This is a small variant on the previous version of the patch. The
wrapping of long lines is not enabled by default - it's simply an
option in the customise interface.

 emacs/Makefile.local  |    3 +-
 emacs/coolj.el        |  145 +++++++++++++++++++++++++++++++++++++++++++++++++
 emacs/notmuch-show.el |   25 +++++++--
 emacs/notmuch-wash.el |   72 ++++++++++++++++++++++++-
 4 files changed, 239 insertions(+), 6 deletions(-)
 create mode 100644 emacs/coolj.el

diff --git a/emacs/Makefile.local b/emacs/Makefile.local
index 7537c3d..ce37ca2 100644
--- a/emacs/Makefile.local
+++ b/emacs/Makefile.local
@@ -9,7 +9,8 @@ emacs_sources := \
 	$(dir)/notmuch-wash.el \
 	$(dir)/notmuch-hello.el \
 	$(dir)/notmuch-mua.el \
-	$(dir)/notmuch-address.el
+	$(dir)/notmuch-address.el \
+	$(dir)/coolj.el
 
 emacs_images := \
 	$(dir)/notmuch-logo.png
diff --git a/emacs/coolj.el b/emacs/coolj.el
new file mode 100644
index 0000000..60af60a
--- /dev/null
+++ b/emacs/coolj.el
@@ -0,0 +1,145 @@
+;;; coolj.el --- automatically wrap long lines  -*- coding:utf-8 -*-
+
+;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Authors:    Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+;;             Alex Schroeder <alex@gnu.org>
+;;             Chong Yidong <cyd@stupidchicken.com>
+;; Maintainer: David Edmondson <dme@dme.org>
+;; Keywords: convenience, wp
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; This is a simple derivative of some functionality from
+;;; `longlines.el'. The key difference is that this version will
+;;; insert a prefix at the head of each wrapped line. The prefix is
+;;; calculated from the originating long line.
+
+;;; No minor-mode is provided, the caller is expected to call
+;;; `coolj-wrap-region' to wrap the region of interest.
+
+;;; Code:
+
+(defgroup coolj nil
+  "Wrapping of long lines with prefix."
+  :group 'fill)
+
+(defcustom coolj-wrap-follows-window-size t
+  "Non-nil means wrap text to the window size.
+Otherwise respect `fill-column'."
+  :group 'coolj
+  :type 'boolean)
+
+(defcustom coolj-line-prefix-regexp "^\\(>+ \\)*"
+  "Regular expression that matches line prefixes."
+  :group 'coolj
+  :type 'regexp)
+
+(defvar coolj-wrap-point nil)
+
+(make-variable-buffer-local 'coolj-wrap-point)
+
+(defun coolj-determine-prefix ()
+  "Determine the prefix for the current line."
+  (save-excursion
+    (beginning-of-line)
+    (if (re-search-forward coolj-line-prefix-regexp nil t)
+	(buffer-substring (match-beginning 0) (match-end 0))
+      "")))
+
+(defun coolj-wrap-buffer ()
+  "Wrap the current buffer."
+  (coolj-wrap-region (point-min) (point-max)))
+
+(defun coolj-wrap-region (beg end)
+  "Wrap each successive line, starting with the line before BEG.
+Stop when we reach lines after END that don't need wrapping, or the
+end of the buffer."
+  (setq fill-column (if coolj-wrap-follows-window-size
+			(window-width)
+		      fill-column))
+  (let ((mod (buffer-modified-p)))
+    (setq coolj-wrap-point (point))
+    (goto-char beg)
+    (forward-line -1)
+    ;; Two successful coolj-wrap-line's in a row mean successive
+    ;; lines don't need wrapping.
+    (while (null (and (coolj-wrap-line)
+		      (or (eobp)
+			  (and (>= (point) end)
+			       (coolj-wrap-line))))))
+    (goto-char coolj-wrap-point)
+    (set-buffer-modified-p mod)))
+
+(defun coolj-wrap-line ()
+  "If the current line needs to be wrapped, wrap it and return nil.
+If wrapping is performed, point remains on the line.  If the line does
+not need to be wrapped, move point to the next line and return t."
+  (let ((prefix (coolj-determine-prefix)))
+    (if (coolj-set-breakpoint prefix)
+	(progn
+	  (insert-before-markers ?\n)
+	  (backward-char 1)
+	  (delete-char -1)
+	  (forward-char 1)
+	  (insert-before-markers prefix)
+	  nil)
+      (forward-line 1)
+      t)))
+
+(defun coolj-set-breakpoint (prefix)
+  "Place point where we should break the current line, and return t.
+If the line should not be broken, return nil; point remains on the
+line."
+  (move-to-column fill-column)
+  (if (and (re-search-forward "[^ ]" (line-end-position) 1)
+           (> (current-column) fill-column))
+      ;; This line is too long.  Can we break it?
+      (or (coolj-find-break-backward prefix)
+          (progn (move-to-column fill-column)
+                 (coolj-find-break-forward)))))
+
+(defun coolj-find-break-backward (prefix)
+  "Move point backward to the first available breakpoint and return t.
+If no breakpoint is found, return nil."
+  (let ((end-of-prefix (+ (line-beginning-position) (length prefix))))
+    (and (search-backward " " end-of-prefix 1)
+	 (save-excursion
+	   (skip-chars-backward " " end-of-prefix)
+	   (null (bolp)))
+	 (progn (forward-char 1)
+		(if (and fill-nobreak-predicate
+			 (run-hook-with-args-until-success
+			  'fill-nobreak-predicate))
+		    (progn (skip-chars-backward " " end-of-prefix)
+			   (coolj-find-break-backward prefix))
+		  t)))))
+
+(defun coolj-find-break-forward ()
+  "Move point forward to the first available breakpoint and return t.
+If no break point is found, return nil."
+  (and (search-forward " " (line-end-position) 1)
+       (progn (skip-chars-forward " " (line-end-position))
+              (null (eolp)))
+       (if (and fill-nobreak-predicate
+                (run-hook-with-args-until-success
+                 'fill-nobreak-predicate))
+           (coolj-find-break-forward)
+         t)))
+
+(provide 'coolj)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index d01bf36..cd859f0 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -46,17 +46,34 @@ collapsed will change.")
   "A list of functions called to decorate the headers listed in
 `notmuch-show-headers'.")
 
-(defvar notmuch-show-hook '(notmuch-show-pretty-hook)
+(defcustom notmuch-show-hook '(notmuch-show-pretty-hook)
   "A list of functions called after populating a
-`notmuch-show' buffer.")
-
-(defvar notmuch-show-insert-text/plain-hook '(notmuch-wash-text/plain-citations)
-  "A list of functions called to clean up text/plain body parts.")
+`notmuch-show' buffer."
+  :group 'notmuch
+  :type 'hook
+  :options '(notmuch-show-pretty-hook
+	     notmuch-show-turn-off-word-wrap))
+
+(defcustom notmuch-show-insert-text/plain-hook
+  '(notmuch-wash-tidy-citations
+    notmuch-wash-compress-blanks
+    notmuch-wash-markup-citations)
+  "A list of functions called to clean up text/plain body parts."
+  :group 'notmuch
+  :type 'hook
+  :options '(notmuch-wash-wrap-long-lines
+	     notmuch-wash-tidy-citations
+	     notmuch-wash-compress-blanks
+	     notmuch-wash-markup-citations))
 
 (defun notmuch-show-pretty-hook ()
   (goto-address-mode 1)
   (visual-line-mode))
 
+(defun notmuch-show-turn-off-word-wrap ()
+  ;; `toggle-word-wrap' outputs a message, which is distracting.
+  (setq word-wrap nil))
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el
index 54a380a..fe33819 100644
--- a/emacs/notmuch-wash.el
+++ b/emacs/notmuch-wash.el
@@ -1,6 +1,7 @@
 ;; notmuch-wash.el --- cleaning up message bodies
 ;;
 ;; Copyright © Carl Worth
+;; Copyright © David Edmondson
 ;;
 ;; This file is part of Notmuch.
 ;;
@@ -18,6 +19,11 @@
 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 ;; Authors: Carl Worth <cworth@cworth.org>
+;;          David Edmondson <dme@dme.org>
+
+(require 'coolj)
+
+;;
 
 (defvar notmuch-wash-signature-regexp
   "^\\(-- ?\\|_+\\)$"
@@ -104,7 +110,7 @@ is what to put on the button."
 		     'invisibility-spec invis-spec
 		     :type button-type))))
 
-(defun notmuch-wash-text/plain-citations (depth)
+(defun notmuch-wash-markup-citations (depth)
   "Markup citations, and up to one signature in the buffer."
   (goto-char (point-min))
   (beginning-of-line)
@@ -147,4 +153,68 @@ is what to put on the button."
 
 ;;
 
+(defun notmuch-wash-compress-blanks (depth)
+  "Compress successive blank lines into one blank line. Remove
+any leading or trailing blank lines."
+
+  ;; Algorithm derived from `article-strip-multiple-blank-lines' in
+  ;; `gnus-art.el'.
+
+  ;; Make all blank lines empty.
+  (goto-char (point-min))
+  (while (re-search-forward "^[[:space:]\t]+$" nil t)
+    (replace-match "" nil t))
+
+  ;; Replace multiple empty lines with a single empty line.
+  (goto-char (point-min))
+  (while (re-search-forward "^\n\\(\n+\\)" nil t)
+    (delete-region (match-beginning 1) (match-end 1)))
+
+  ;; Remove a leading blank line.
+  (goto-char (point-min))
+  (if (looking-at "\n")
+      (delete-region (match-beginning 0) (match-end 0)))
+
+  ;; Remove a trailing blank line.
+  (goto-char (point-max))
+  (if (looking-at "\n")
+      (delete-region (match-beginning 0) (match-end 0))))
+
+;;
+
+(defun notmuch-wash-tidy-citations (depth)
+  "Clean up citations."
+
+  ;; Remove lines of repeated citation leaders with no other content.
+  (goto-char (point-min))
+  (while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)
+    (replace-match "\\1"))
+
+  ;; Remove citation leaders standing alone before a block of cited
+  ;; text.
+  (goto-char (point-min))
+  (while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)
+    (replace-match "\\1\n"))
+
+  ;; Remove citation trailers standing alone after a block of cited
+  ;; text.
+  (goto-char (point-min))
+  (while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)
+    (replace-match "\\2"))
+
+  ;; Remove blank lines between "Bill wrote:" and the citation.
+  (goto-char (point-min))
+  (while (re-search-forward "^\\([^>].*\\):\n\n>" nil t)
+    (replace-match "\\1:\n>")))
+
+;;
+
+(defun notmuch-wash-wrap-long-lines (depth)
+  "Wrap text in the region whilst maintaining the correct prefix."
+  (let ((coolj-wrap-follows-window-size nil)
+	(fill-column (- (window-width) depth)))
+    (coolj-wrap-region (point-min) (point-max))))
+
+;;
+
 (provide 'notmuch-wash)
-- 
1.7.0

Re: [PATCH] emacs: Add more functions to clean up text/plain parts

[Carl Worth]

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

On Thu, 22 Apr 2010 13:26:06 +0100, David Edmondson <dme@dme.org> wrote:
> This is a small variant on the previous version of the patch. The
> wrapping of long lines is not enabled by default - it's simply an
> option in the customise interface.

This is really close now. I especially like that the various wash
options are as simple as just checkboxes in the customize
interface. (That might not even be new in this case, but I at least
didn't find it before.)

And that again goes to my point. I don't think we should enable this
washing by default since it can appear as silent corruption to the user,
without any indication that it happened nor how to turn it off.

Notmuch has always done some modification of the message with things
like hiding long citations, etc. But those at least provide
self-documenting buttons on how to make them disappear.

Here's what I see in the customize buffer with the latest patch, along
with some review. Some of this review applies to documentation already
in notmuch---I'm just getting pickier as things appear in
customize because I think we need to hold our documentation there to a
higher standard. (Previously, one would practically have to dive into
the source to find the documentation, and that suggests the reader has
more experience and definitely means the user gsts a lot more context).

Here, I'm trying to review these options from the point of view of a new
user who just started using notmuch, wants to tweak a few things, and is
looking at the customize buffer to figure out what tweaks are possible.

	Notmuch Show Hook: 
	[X] notmuch-show-pretty-hook
	[ ] notmuch-show-turn-off-word-wrap
	INS
	   State: STANDARD.
	   A list of functions called after populating a More

What does "pretty hook" mean? What information would a user need to
determine whether to turn this on or off?

With "turn off word wrap", we have on option to disable wrapping here,
and another option later to turn some wrapping on again. How is a user
expected to figure out which combination of options does what they want?

	Notmuch Show Insert Text/Plain Hook: Hide Value
        [ ] notmuch-wash-wrap-long-lines
		Wrap text in the region whilst maintaining the correct prefix.
	[X] notmuch-wash-tidy-citations
		Clean up citations.
	[X] notmuch-wash-compress-blanks
		Compress successive blank lines into one blank line. Remove More
	[X] notmuch-wash-markup-citations
		Markup citations, and up to one signature in the buffer.

"Tidy", "Clean up", and "Markup" citations are all too vague. What do
each of these actually do?

Also, think about line breaks so that something like "Remove more"
doesn't appear there by default.

Thanks,

-Carl

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

[PATCH] emacs: Add more functions to clean up text/plain parts

[David Edmondson]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 11928 bytes --]

Add:
- notmuch-wash-wrap-long-lines: Wrap lines longer than the width of
  the current window whilst maintaining any citation prefix.
- notmuch-wash-tidy-citations: Tidy up citations by:
  - compress repeated otherwise blank citation lines,
  - remove otherwise blank citation lines at the head and tail of a
    citation,
- notmuch-wash-elide-blank-lines: Compress repeated blank lines and
  remove leading and trailing blank lines.

None of these is enabled by default - add them to
`notmuch-show-insert-text/plain-hook' to use.
---

Another attempt :-)

- Functions renamed to be clearer about what they do,
- Function documentation both more concise (for display in customisation
  buffers) and more complete,
- Interaction of long line wrapping and `word-wrap' improved,
- Push `notmuch-show-pretty-hook' functions that everyone will use
  directly into the code, thus avoiding the naming dilemma.

 emacs/Makefile.local  |    3 +-
 emacs/coolj.el        |  145 +++++++++++++++++++++++++++++++++++++++++++++++++
 emacs/notmuch-show.el |   28 +++++++---
 emacs/notmuch-wash.el |   84 ++++++++++++++++++++++++++++-
 4 files changed, 248 insertions(+), 12 deletions(-)
 create mode 100644 emacs/coolj.el

diff --git a/emacs/Makefile.local b/emacs/Makefile.local
index 7537c3d..ce37ca2 100644
--- a/emacs/Makefile.local
+++ b/emacs/Makefile.local
@@ -9,7 +9,8 @@ emacs_sources := \
 	$(dir)/notmuch-wash.el \
 	$(dir)/notmuch-hello.el \
 	$(dir)/notmuch-mua.el \
-	$(dir)/notmuch-address.el
+	$(dir)/notmuch-address.el \
+	$(dir)/coolj.el
 
 emacs_images := \
 	$(dir)/notmuch-logo.png
diff --git a/emacs/coolj.el b/emacs/coolj.el
new file mode 100644
index 0000000..60af60a
--- /dev/null
+++ b/emacs/coolj.el
@@ -0,0 +1,145 @@
+;;; coolj.el --- automatically wrap long lines  -*- coding:utf-8 -*-
+
+;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Authors:    Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+;;             Alex Schroeder <alex@gnu.org>
+;;             Chong Yidong <cyd@stupidchicken.com>
+;; Maintainer: David Edmondson <dme@dme.org>
+;; Keywords: convenience, wp
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; This is a simple derivative of some functionality from
+;;; `longlines.el'. The key difference is that this version will
+;;; insert a prefix at the head of each wrapped line. The prefix is
+;;; calculated from the originating long line.
+
+;;; No minor-mode is provided, the caller is expected to call
+;;; `coolj-wrap-region' to wrap the region of interest.
+
+;;; Code:
+
+(defgroup coolj nil
+  "Wrapping of long lines with prefix."
+  :group 'fill)
+
+(defcustom coolj-wrap-follows-window-size t
+  "Non-nil means wrap text to the window size.
+Otherwise respect `fill-column'."
+  :group 'coolj
+  :type 'boolean)
+
+(defcustom coolj-line-prefix-regexp "^\\(>+ \\)*"
+  "Regular expression that matches line prefixes."
+  :group 'coolj
+  :type 'regexp)
+
+(defvar coolj-wrap-point nil)
+
+(make-variable-buffer-local 'coolj-wrap-point)
+
+(defun coolj-determine-prefix ()
+  "Determine the prefix for the current line."
+  (save-excursion
+    (beginning-of-line)
+    (if (re-search-forward coolj-line-prefix-regexp nil t)
+	(buffer-substring (match-beginning 0) (match-end 0))
+      "")))
+
+(defun coolj-wrap-buffer ()
+  "Wrap the current buffer."
+  (coolj-wrap-region (point-min) (point-max)))
+
+(defun coolj-wrap-region (beg end)
+  "Wrap each successive line, starting with the line before BEG.
+Stop when we reach lines after END that don't need wrapping, or the
+end of the buffer."
+  (setq fill-column (if coolj-wrap-follows-window-size
+			(window-width)
+		      fill-column))
+  (let ((mod (buffer-modified-p)))
+    (setq coolj-wrap-point (point))
+    (goto-char beg)
+    (forward-line -1)
+    ;; Two successful coolj-wrap-line's in a row mean successive
+    ;; lines don't need wrapping.
+    (while (null (and (coolj-wrap-line)
+		      (or (eobp)
+			  (and (>= (point) end)
+			       (coolj-wrap-line))))))
+    (goto-char coolj-wrap-point)
+    (set-buffer-modified-p mod)))
+
+(defun coolj-wrap-line ()
+  "If the current line needs to be wrapped, wrap it and return nil.
+If wrapping is performed, point remains on the line.  If the line does
+not need to be wrapped, move point to the next line and return t."
+  (let ((prefix (coolj-determine-prefix)))
+    (if (coolj-set-breakpoint prefix)
+	(progn
+	  (insert-before-markers ?\n)
+	  (backward-char 1)
+	  (delete-char -1)
+	  (forward-char 1)
+	  (insert-before-markers prefix)
+	  nil)
+      (forward-line 1)
+      t)))
+
+(defun coolj-set-breakpoint (prefix)
+  "Place point where we should break the current line, and return t.
+If the line should not be broken, return nil; point remains on the
+line."
+  (move-to-column fill-column)
+  (if (and (re-search-forward "[^ ]" (line-end-position) 1)
+           (> (current-column) fill-column))
+      ;; This line is too long.  Can we break it?
+      (or (coolj-find-break-backward prefix)
+          (progn (move-to-column fill-column)
+                 (coolj-find-break-forward)))))
+
+(defun coolj-find-break-backward (prefix)
+  "Move point backward to the first available breakpoint and return t.
+If no breakpoint is found, return nil."
+  (let ((end-of-prefix (+ (line-beginning-position) (length prefix))))
+    (and (search-backward " " end-of-prefix 1)
+	 (save-excursion
+	   (skip-chars-backward " " end-of-prefix)
+	   (null (bolp)))
+	 (progn (forward-char 1)
+		(if (and fill-nobreak-predicate
+			 (run-hook-with-args-until-success
+			  'fill-nobreak-predicate))
+		    (progn (skip-chars-backward " " end-of-prefix)
+			   (coolj-find-break-backward prefix))
+		  t)))))
+
+(defun coolj-find-break-forward ()
+  "Move point forward to the first available breakpoint and return t.
+If no break point is found, return nil."
+  (and (search-forward " " (line-end-position) 1)
+       (progn (skip-chars-forward " " (line-end-position))
+              (null (eolp)))
+       (if (and fill-nobreak-predicate
+                (run-hook-with-args-until-success
+                 'fill-nobreak-predicate))
+           (coolj-find-break-forward)
+         t)))
+
+(provide 'coolj)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index f9d6c93..f5de8ae 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -62,16 +62,19 @@ any given message."
   "A list of functions called to decorate the headers listed in
 `notmuch-message-headers'.")
 
-(defvar notmuch-show-hook '(notmuch-show-pretty-hook)
-  "A list of functions called after populating a
-`notmuch-show' buffer.")
-
-(defvar notmuch-show-insert-text/plain-hook '(notmuch-wash-text/plain-citations)
-  "A list of functions called to clean up text/plain body parts.")
+(defcustom notmuch-show-hook nil
+  "Functions called after populating a `notmuch-show' buffer."
+  :group 'notmuch
+  :type 'hook)
 
-(defun notmuch-show-pretty-hook ()
-  (goto-address-mode 1)
-  (visual-line-mode))
+(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations)
+  "Functions used to improve the display of text/plain parts."
+  :group 'notmuch
+  :type 'hook
+  :options '(notmuch-wash-wrap-long-lines
+	     notmuch-wash-tidy-citations
+	     notmuch-wash-elide-blank-lines
+	     notmuch-wash-excerpt-citations))
 
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
@@ -511,6 +514,13 @@ function is used. "
 		   query-context)
 	  (notmuch-show-insert-forest
 	   (notmuch-query-get-threads basic-args))))
+
+      ;; Enable buttonisation of URLs and email addresses in the
+      ;; buffer.
+      (goto-address-mode t)
+      ;; Act on visual lines rather than logical lines.
+      (visual-line-mode t)
+
       (run-hooks 'notmuch-show-hook))
 
     ;; Move straight to the first open message
diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el
index 5ca567f..57f0cc5 100644
--- a/emacs/notmuch-wash.el
+++ b/emacs/notmuch-wash.el
@@ -1,6 +1,7 @@
 ;; notmuch-wash.el --- cleaning up message bodies
 ;;
 ;; Copyright © Carl Worth
+;; Copyright © David Edmondson
 ;;
 ;; This file is part of Notmuch.
 ;;
@@ -18,6 +19,11 @@
 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 ;; Authors: Carl Worth <cworth@cworth.org>
+;;          David Edmondson <dme@dme.org>
+
+(require 'coolj)
+
+;;
 
 (defvar notmuch-wash-signature-regexp
   "^\\(-- ?\\|_+\\)$"
@@ -108,8 +114,8 @@ is what to put on the button."
 		     'invisibility-spec invis-spec
 		     :type button-type))))
 
-(defun notmuch-wash-text/plain-citations (depth)
-  "Markup citations, and up to one signature in the buffer."
+(defun notmuch-wash-excerpt-citations (depth)
+  "Excerpt citations and up to one signature."
   (goto-char (point-min))
   (beginning-of-line)
   (while (and (< (point) (point-max))
@@ -151,4 +157,78 @@ is what to put on the button."
 
 ;;
 
+(defun notmuch-wash-elide-blank-lines (depth)
+  "Elide leading, trailing and successive blank lines."
+
+  ;; Algorithm derived from `article-strip-multiple-blank-lines' in
+  ;; `gnus-art.el'.
+
+  ;; Make all blank lines empty.
+  (goto-char (point-min))
+  (while (re-search-forward "^[[:space:]\t]+$" nil t)
+    (replace-match "" nil t))
+
+  ;; Replace multiple empty lines with a single empty line.
+  (goto-char (point-min))
+  (while (re-search-forward "^\n\\(\n+\\)" nil t)
+    (delete-region (match-beginning 1) (match-end 1)))
+
+  ;; Remove a leading blank line.
+  (goto-char (point-min))
+  (if (looking-at "\n")
+      (delete-region (match-beginning 0) (match-end 0)))
+
+  ;; Remove a trailing blank line.
+  (goto-char (point-max))
+  (if (looking-at "\n")
+      (delete-region (match-beginning 0) (match-end 0))))
+
+;;
+
+(defun notmuch-wash-tidy-citations (depth)
+  "Improve the display of cited regions of a message.
+
+Perform four transformations on the message body:
+
+- Remove lines of repeated citation leaders with no other
+  content,
+- Remove citation leaders standing alone before a block of cited
+  text,
+- Remove citation trailers standing alone after a block of cited
+  text."
+
+  ;; Remove lines of repeated citation leaders with no other content.
+  (goto-char (point-min))
+  (while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)
+    (replace-match "\\1"))
+
+  ;; Remove citation leaders standing alone before a block of cited
+  ;; text.
+  (goto-char (point-min))
+  (while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)
+    (replace-match "\\1\n"))
+
+  ;; Remove citation trailers standing alone after a block of cited
+  ;; text.
+  (goto-char (point-min))
+  (while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)
+    (replace-match "\\2")))
+
+;;
+
+(defun notmuch-wash-wrap-long-lines (depth)
+  "Wrap any long lines in the message to the width of the window.
+
+When doing so, maintaining citation leaders in the wrapped text."
+
+  (let ((coolj-wrap-follows-window-size nil)
+	(fill-column (- (window-width)
+			depth
+			;; 2 to avoid poor interaction with
+			;; `word-wrap'.
+			2)))
+    (coolj-wrap-region (point-min) (point-max))))
+
+;;
+
 (provide 'notmuch-wash)
-- 
1.7.0

Re: [PATCH] emacs: Add more functions to clean up text/plain parts

[Carl Worth]

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

> None of these is enabled by default - add them to
> `notmuch-show-insert-text/plain-hook' to use.
> ---
> 
> Another attempt :-)
> 
> - Functions renamed to be clearer about what they do,
> - Function documentation both more concise (for display in customisation
>   buffers) and more complete,
> - Interaction of long line wrapping and `word-wrap' improved,
> - Push `notmuch-show-pretty-hook' functions that everyone will use
>   directly into the code, thus avoiding the naming dilemma.

All looks perfect. I don't know how I ended up pushing the old version
before I'd seen this. So I just reverted that and pushed this.

Thanks again,

-Carl

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