From: David Edmondson <dme@dme.org>
To: notmuch@notmuchmail.org
Date: Wed, 17 Feb 2010 14:04:12 +0000
Message-Id: <1266415452-25108-2-git-send-email-dme@dme.org>
In-Reply-To: <1266415452-25108-1-git-send-email-dme@dme.org>
References: <1266415452-25108-1-git-send-email-dme@dme.org>
Subject: [notmuch] [PATCH 2/2] notmuch.el: Replace inline function calls for
	body cleaning with a hook mechanism.
Precedence: list

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 |   65 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 notmuch.el         |   12 +++++----
 3 files changed, 76 insertions(+), 7 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 -*-
 
-emacs: notmuch.elc coolj.elc
+emacs: notmuch.elc coolj.elc notmuch-washing.elc
 
 notmuch_client_srcs =		\
 	$(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)
 
 install-desktop:
 	install -d $(DESTDIR)$(desktop_dir)
@@ -62,4 +64,4 @@ install-zsh:
 		$(DESTDIR)$(zsh_completion_dir)/notmuch
 
 SRCS  := $(SRCS) $(notmuch_client_srcs)
-CLEAN := $(CLEAN) notmuch $(notmuch_client_modules) notmuch.elc coolj.elc notmuch.1.gz
+CLEAN := $(CLEAN) notmuch $(notmuch_client_modules) notmuch.elc coolj.elc notmuch-washing.elc notmuch.1.gz
diff --git a/notmuch-washing.el b/notmuch-washing.el
new file mode 100644
index 0000000..831eb00
--- /dev/null
+++ b/notmuch-washing.el
@@ -0,0 +1,65 @@
+; notmuch-washing.el --- functions to clean body parts
+;
+; Copyright © 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)
+;;      (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-washing-coolj)
+;;      (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-washing-compress-blank t)))
+
+;; Note that the ordering of the functions may well be significant.
+
+(defun notmuch-show-washing-coolj (begin end depth)
+  "Wrap text in the region whilst maintaining the correct prefix."
+  (coolj-wrap-region beg end))
+
+(defun notmuch-show-washing-compress-blank (begin end depth)
+  "Compress successive blank lines into one blank line."
+
+  ;; Algorithm derived from `article-strip-multiple-blank-lines' in
+  ;; `gnus-art.el'.
+  
+  (save-excursion
+    ;; Make all blank lines empty. **This also removes the prefix!**
+    (goto-char begin)
+    (while (re-search-forward "^[ \t]+$" end t)
+      (replace-match "" nil t))
+    ;; Replace multiple empty lines with a single empty line.
+    (goto-char begin)
+    (while (re-search-forward "\n\n\\(\n+\\)" end t)
+      (delete-region (match-beginning 1) (match-end 1)))
+    ;; dme - is this really the best way to generate a string of N
+    ;; spaces?
+    (let ((prefix (format (format "%%%ds" depth) "")))
+      (goto-char begin)
+      ;; Insert the relevant prefix.
+      (while (re-search-forward "^$" end t)
+	(insert prefix)
+	(forward-line)))))
+
+;;
+
+(provide 'notmuch-washing)
diff --git a/notmuch.el b/notmuch.el
index 040fb5e..e64ed25 100644
--- a/notmuch.el
+++ b/notmuch.el
@@ -50,7 +50,6 @@
 (require 'cl)
 (require 'mm-view)
 (require 'message)
-(require 'coolj)
 
 (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)
 
+(defun notmuch-show-markup-body-hook '(notmuch-show-markup-citations-region)
+  "List of functions used to clean up body parts.
+
+Each is passed three arguments: the beginning of the region, the
+end of the region and the indetation depth.")
+
 ; 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,7 +708,6 @@ is what to put on the button."
 		     :type button-type)
       )))
 
-
 (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
@@ -791,9 +795,7 @@ 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)))
+		  (run-hook-with-args 'notmuch-show-markup-body-hook beg end 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 nil t)
-- 
1.6.6.1