To: notmuch@notmuchmail.org
In-Reply-To: <1266415452-25108-2-git-send-email-dme@dme.org>
References: <1266415452-25108-1-git-send-email-dme@dme.org>
	<1266415452-25108-2-git-send-email-dme@dme.org>
From: David Edmondson <dme@dme.org>
Date: Thu, 18 Feb 2010 09:43:55 +0000
Message-ID: <873a0yho9w.fsf@aw.hh.sledj.net>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Subject: Re: [notmuch] [PATCH 2/2] notmuch.el: Replace inline function calls
 for body cleaning with a hook mechanism.
Precedence: list

--=-=-=

On Wed, 17 Feb 2010 14:04:12 +0000, David Edmondson <dme@dme.org> wrote:
> In-lining every possible body cleaning function is difficult to
> maintain and doesn't allow users any flexibility. Rather, use a hook
> mechanism so that users can choose what cleaning takes place.

Improved version attached, including a new washing function to clean up
citation blocks (suggested by Sebastian in #notmuch, though perhaps I
went a bit further than he intended).


--=-=-=
Content-Type: text/x-diff; charset=utf-8
Content-Disposition: inline;
 filename=0001-notmuch.el-Replace-inline-function-calls-for-body-cl.patch
Content-Transfer-Encoding: quoted-printable

>From 545e2a0936a19620bf4f91282ca2aca1da0504b7 Mon Sep 17 00:00:00 2001
From: David Edmondson <dme@dme.org>
Date: Wed, 17 Feb 2010 14:03:24 +0000
Subject: [PATCH] notmuch.el: Replace inline function calls for body cleanin=
g with a
 hook mechanism.

In-lining every possible body cleaning function is difficult to
maintain and doesn't allow users any flexibility. Rather, use a hook
mechanism so that users can choose what cleaning takes place.

notmuch-washing.el: Sample cleaning functions.
---
 Makefile.local     |    6 ++-
 notmuch-washing.el |  113 ++++++++++++++++++++++++++++++++++++++++++++++++=
++++
 notmuch.el         |  104 +++++++++++++++++++++++++-----------------------
 3 files changed, 171 insertions(+), 52 deletions(-)
 create mode 100644 notmuch-washing.el

diff --git a/Makefile.local b/Makefile.local
index 0a1f203..7124af7 100644
--- a/Makefile.local
+++ b/Makefile.local
@@ -1,6 +1,6 @@
 # -*- mode:makefile -*-
=20
-emacs: notmuch.elc coolj.elc
+emacs: notmuch.elc coolj.elc notmuch-washing.elc
=20
 notmuch_client_srcs =3D		\
 	$(notmuch_compat_srcs)	\
@@ -46,6 +46,8 @@ install-emacs: install emacs
 	install -m0644 notmuch.elc $(DESTDIR)$(emacs_lispdir)
 	install -m0644 coolj.el $(DESTDIR)$(emacs_lispdir)
 	install -m0644 coolj.elc $(DESTDIR)$(emacs_lispdir)
+	install -m0644 notmuch-washing.el $(DESTDIR)$(emacs_lispdir)
+	install -m0644 notmuch-washing.elc $(DESTDIR)$(emacs_lispdir)
=20
 install-desktop:
 	install -d $(DESTDIR)$(desktop_dir)
@@ -62,4 +64,4 @@ install-zsh:
 		$(DESTDIR)$(zsh_completion_dir)/notmuch
=20
 SRCS  :=3D $(SRCS) $(notmuch_client_srcs)
-CLEAN :=3D $(CLEAN) notmuch $(notmuch_client_modules) notmuch.elc coolj.el=
c notmuch.1.gz
+CLEAN :=3D $(CLEAN) notmuch $(notmuch_client_modules) notmuch.elc coolj.el=
c notmuch-washing.elc notmuch.1.gz
diff --git a/notmuch-washing.el b/notmuch-washing.el
new file mode 100644
index 0000000..fc7b257
--- /dev/null
+++ b/notmuch-washing.el
@@ -0,0 +1,113 @@
+;; notmuch-washing.el --- functions to clean body parts
+;;
+;; Copyright =C2=A9 David Edmondson
+;;
+;; This file is not (yet) part of Notmuch.
+;;
+;; Notmuch 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.
+;;
+;; Notmuch 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 Notmuch.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; Authors: David Edmondson <dme@dme.org>
+
+(require 'coolj)
+
+;; Add these functions to `notmuch-show-markup-body-hook' using
+;; `add-hook'. Something like:
+
+;; (eval-after-load "notmuch"
+;;   '(progn
+;;      (require 'notmuch-washing)
+;;      (setq notmuch-show-markup-body-hook nil)
+;;      (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-washing-coo=
lj t)
+;;      (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-washing-cit=
ations t)
+;;      (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-washing-com=
press-blanks t)
+;;      (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-markup-cita=
tions t)
+;;      ))
+
+;; Note that the ordering of the functions is significant, given that
+;; later functions operate on the results of the earlier functions.
+
+(defun notmuch-show-washing-coolj (depth)
+  "Wrap text in the region whilst maintaining the correct prefix."
+  (coolj-wrap-region (point-min) (point-max)))
+
+;; Utility functions.
+(defun remove-prefix (depth)
+  (let ((prefix-regexp (format (format "^%%%ds" depth) "")))
+    (while (and (not (eobp))
+		(re-search-forward prefix-regexp nil t))
+      (replace-match "" nil nil)
+      (forward-line))))
+
+(defun insert-prefix (depth)
+  (let ((prefix (format (format "%%%ds" depth) "")))
+    (while (not (eobp))
+      (insert prefix)
+      (forward-line))))
+
+(defun notmuch-show-washing-compress-blanks (depth)
+  "Compress successive blank lines into one blank line."
+
+  ;; Algorithm derived from `article-strip-multiple-blank-lines' in
+  ;; `gnus-art.el'.
+
+  (goto-char (point-min))
+  (remove-prefix depth)
+
+  ;; Make all blank lines empty.
+  (goto-char (point-min))
+  (while (re-search-forward "^[ \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\\(\n+\\)" nil t)
+    (delete-region (match-beginning 1) (match-end 1)))
+
+  (goto-char (point-min))
+  (insert-prefix depth))
+
+(defun notmuch-show-washing-citations (depth)
+  "Clean up citations."
+
+  (goto-char (point-min))
+  (remove-prefix depth)
+
+  ;; 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>"))
+
+  (goto-char (point-min))
+  (insert-prefix depth))
+
+;;
+
+(provide 'notmuch-washing)
diff --git a/notmuch.el b/notmuch.el
index 040fb5e..9d86a3f 100644
--- a/notmuch.el
+++ b/notmuch.el
@@ -50,7 +50,6 @@
 (require 'cl)
 (require 'mm-view)
 (require 'message)
-(require 'coolj)
=20
 (defvar notmuch-show-mode-map
   (let ((map (make-sparse-keymap)))
@@ -157,6 +156,12 @@ collapse remaining lines into a button.")
 (defvar notmuch-show-signatures-visible nil)
 (defvar notmuch-show-headers-visible nil)
=20
+(defun notmuch-show-markup-body-hook '(notmuch-show-markup-citations)
+  "List of functions used to clean up body parts.
+
+Each is passed one argument: the indentation depth of the region
+to be washed.")
+
 ; XXX: This should be a generic function in emacs somewhere, not here
 (defun point-invisible-p ()
   "Return whether the character at point is invisible.
@@ -703,52 +708,48 @@ is what to put on the button."
 		     :type button-type)
       )))
=20
-
-(defun notmuch-show-markup-citations-region (beg end depth)
-  "Markup citations, and up to one signature in the given region"
-  ;; it would be nice if the untabify was not required, but
-  ;; that would require notmuch to indent with spaces.
-  (untabify beg end)
-  (let ((citation-regexp (notmuch-show-citation-regexp depth))
-	(signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth)
-				  notmuch-show-signature-regexp))
-	(indent (concat "\n" (make-string depth ? ))))
-    (goto-char beg)
-    (beginning-of-line)
-    (while (and (< (point) end)
-		(re-search-forward citation-regexp end t))
-      (let* ((cite-start (match-beginning 0))
-	     (cite-end 	(match-end 0))
-	     (cite-lines (count-lines cite-start cite-end)))
-	(overlay-put (make-overlay cite-start cite-end) 'face 'message-cited-text=
-face)
-	(when (> cite-lines (1+ (+ notmuch-show-citation-lines-prefix notmuch-sho=
w-citation-lines-suffix)))
-	  (goto-char cite-start)
-	  (forward-line notmuch-show-citation-lines-prefix)
-	  (let ((hidden-start (point)))
-	    (goto-char cite-end)
-	    (forward-line (- notmuch-show-citation-lines-suffix))
-	    (notmuch-show-region-to-button
-	     hidden-start (point)
-	     "citation"
-	     indent
-	     (format notmuch-show-citation-button-format
-		     (- cite-lines notmuch-show-citation-lines-prefix notmuch-show-citat=
ion-lines-suffix))
-	     )))))
-    (if (and (< (point) end)
-	     (re-search-forward signature-regexp end t))
-	(let* ((sig-start (match-beginning 0))
-	       (sig-end (match-end 0))
-	       (sig-lines (1- (count-lines sig-start end))))
-	  (if (<=3D sig-lines notmuch-show-signature-lines-max)
-	      (progn
-		(overlay-put (make-overlay sig-start end) 'face 'message-cited-text-face)
-		(notmuch-show-region-to-button
-		 sig-start
-		 end
-		 "signature"
-		 indent
-		 (format notmuch-show-signature-button-format sig-lines)
-		 )))))))
+(defun notmuch-show-markup-citations (depth)
+  "Markup citations, and up to one signature in the buffer."
+    (let ((citation-regexp (notmuch-show-citation-regexp depth))
+	  (signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth)
+				    notmuch-show-signature-regexp))
+	  (indent (concat "\n" (make-string depth ? ))))
+      (goto-char (point-min))
+      (beginning-of-line)
+      (while (and (< (point) (point-max))
+		  (re-search-forward citation-regexp nil t))
+	(let* ((cite-start (match-beginning 0))
+	       (cite-end 	(match-end 0))
+	       (cite-lines (count-lines cite-start cite-end)))
+	  (overlay-put (make-overlay cite-start cite-end) 'face 'message-cited-te=
xt-face)
+	  (when (> cite-lines (1+ (+ notmuch-show-citation-lines-prefix notmuch-s=
how-citation-lines-suffix)))
+	    (goto-char cite-start)
+	    (forward-line notmuch-show-citation-lines-prefix)
+	    (let ((hidden-start (point)))
+	      (goto-char cite-end)
+	      (forward-line (- notmuch-show-citation-lines-suffix))
+	      (notmuch-show-region-to-button
+	       hidden-start (point)
+	       "citation"
+	       indent
+	       (format notmuch-show-citation-button-format
+		       (- cite-lines notmuch-show-citation-lines-prefix notmuch-show-cit=
ation-lines-suffix))
+	       )))))
+      (if (and (not (eobp))
+	       (re-search-forward signature-regexp nil t))
+	  (let* ((sig-start (match-beginning 0))
+		 (sig-end (match-end 0))
+		 (sig-lines (1- (count-lines sig-start (point-max)))))
+	    (if (<=3D sig-lines notmuch-show-signature-lines-max)
+		(progn
+		  (overlay-put (make-overlay sig-start (point-max)) 'face 'message-cited=
-text-face)
+		  (notmuch-show-region-to-button
+		   sig-start
+		   (point-max)
+		   "signature"
+		   indent
+		   (format notmuch-show-signature-button-format sig-lines)
+		   )))))))
=20
 (defun notmuch-show-markup-part (beg end depth)
   (if (re-search-forward notmuch-show-buttonize-begin-regexp nil t)
@@ -791,9 +792,12 @@ is what to put on the button."
                           (mm-display-part mime-message))))
                 )
 	      (if (equal mime-type "text/plain")
-		  (progn
-		    (coolj-wrap-region beg end)
-		    (notmuch-show-markup-citations-region beg end depth)))
+		  (save-restriction
+		    (narrow-to-region beg end)
+		    ;; it would be nice if the untabify was not required, but
+		    ;; that would require notmuch to indent with spaces.
+		    (untabify (point-min) (point-max))
+		    (run-hook-with-args 'notmuch-show-markup-body-hook depth)))
               ; Advance to the next part (if any) (so the outer loop can
               ; determine whether we've left the current message.
               (if (re-search-forward notmuch-show-buttonize-begin-regexp n=
il t)
--=20
1.6.6.1


--=-=-=


dme.
-- 
David Edmondson, http://dme.org

--=-=-=--