On Wed, 17 Feb 2010 14:04:12 +0000, David Edmondson <d...@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).
>From 545e2a0936a19620bf4f91282ca2aca1da0504b7 Mon Sep 17 00:00:00 2001 From: David Edmondson <d...@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 <d...@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
dme. -- David Edmondson, http://dme.org
_______________________________________________ notmuch mailing list notmuch@notmuchmail.org http://notmuchmail.org/mailman/listinfo/notmuch
