From: David Edmondson <dme@dme.org>
To: notmuch@notmuchmail.org
Subject: [PATCH] emacs: Add more functions to clean up text/plain parts
Date: Thu, 22 Apr 2010 13:26:06 +0100 [thread overview]
Message-ID: <1271939166-24100-1-git-send-email-dme@dme.org> (raw)
[-- 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
next reply other threads:[~2010-04-22 12:26 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-04-22 12:26 David Edmondson [this message]
2010-04-24 15:14 ` [PATCH] emacs: Add more functions to clean up text/plain parts Carl Worth
2010-04-26 13:45 ` David Edmondson
2010-04-26 17:08 ` Carl Worth
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://notmuchmail.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1271939166-24100-1-git-send-email-dme@dme.org \
--to=dme@dme.org \
--cc=notmuch@notmuchmail.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://yhetil.org/notmuch.git/
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).