* Re: [PATCH 2/2] notmuch.el: Replace inline function calls for body cleaning with a hook mechanism.
2010-02-17 14:04 ` [PATCH 2/2] notmuch.el: Replace inline function calls for body cleaning with a hook mechanism David Edmondson
@ 2010-02-18 9:43 ` David Edmondson
2010-02-18 11:00 ` David Edmondson
0 siblings, 1 reply; 4+ messages in thread
From: David Edmondson @ 2010-02-18 9:43 UTC (permalink / raw)
To: notmuch
[-- Attachment #1: Type: text/plain, Size: 456 bytes --]
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).
[-- Attachment #2: 0001-notmuch.el-Replace-inline-function-calls-for-body-cl.patch --]
[-- Type: text/x-diff, Size: 11591 bytes --]
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 cleaning 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 -*-
-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..fc7b257
--- /dev/null
+++ b/notmuch-washing.el
@@ -0,0 +1,113 @@
+;; 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)
+;; (setq notmuch-show-markup-body-hook nil)
+;; (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-washing-coolj t)
+;; (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-washing-citations t)
+;; (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-washing-compress-blanks t)
+;; (add-hook 'notmuch-show-markup-body-hook 'notmuch-show-markup-citations 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)
(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)
+ "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)
)))
-
-(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-show-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-citation-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 (<= 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-text-face)
+ (when (> cite-lines (1+ (+ notmuch-show-citation-lines-prefix notmuch-show-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-citation-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 (<= 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)
+ )))))))
(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 nil t)
--
1.6.6.1
[-- Attachment #3: Type: text/plain, Size: 42 bytes --]
dme.
--
David Edmondson, http://dme.org
^ permalink raw reply related [flat|nested] 4+ messages in thread