debian/notmuch
1
0
Fork 0
mirror of https://git.notmuchmail.org/git/notmuch synced 2024-11-22 02:48:08 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

emacs: Add more functions to clean up text/plain parts

Browse source 
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 commit is contained in:
David Edmondson 2010-04-22 13:26:06 +01:00 committed by Carl Worth
parent 7c5f017a30
commit 97570954cb
4 changed files with 239 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
emacs/Makefile.local
View file

@ -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

145
emacs/coolj.el Normal file
View file

@ -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)

25
emacs/notmuch-show.el
View file

@ -62,17 +62,34 @@ any given message."
"A list of functions called to decorate the headers listed in
`notmuch-message-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.")
`notmuch-show' buffer."
:group 'notmuch
:type 'hook
:options '(notmuch-show-pretty-hook
notmuch-show-turn-off-word-wrap))
(defvar notmuch-show-insert-text/plain-hook '(notmuch-wash-text/plain-citations)
"A list of functions called to clean up text/plain body parts.")
(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

72
emacs/notmuch-wash.el
View file

@ -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
"^\\(-- ?\\|_+\\)$"
@ -108,7 +114,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)
@ -151,4 +157,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)