From: David Edmondson Date: Mon, 26 Apr 2010 13:45:30 +0000 (+0100) Subject: emacs: Add more functions to clean up text/plain parts X-Git-Tag: 0.3~55 X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=commitdiff_plain;h=01ec4d3bcb660e0b26f66db02c25b3dfaec5e1fe emacs: Add more functions to clean up text/plain parts 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, - notmuch-wash-elide-blank-lines: Compress repeated blank lines and remove leading and trailing blank lines. None of these is enabled by default - add them to `notmuch-show-insert-text/plain-hook' to use. Reviewed-by: Carl Worth : I previously committed a stale version of this patch. --- diff --git a/emacs/Makefile.local b/emacs/Makefile.local index 7537c3d5..ce37ca26 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 00000000..60af60af --- /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 +;; Alex Schroeder +;; Chong Yidong +;; Maintainer: David Edmondson +;; 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 . + +;;; 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 f9d6c93e..f5de8ae9 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -62,16 +62,19 @@ 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) - "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.") +(defcustom notmuch-show-hook nil + "Functions called after populating a `notmuch-show' buffer." + :group 'notmuch + :type 'hook) -(defun notmuch-show-pretty-hook () - (goto-address-mode 1) - (visual-line-mode)) +(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations) + "Functions used to improve the display of text/plain parts." + :group 'notmuch + :type 'hook + :options '(notmuch-wash-wrap-long-lines + notmuch-wash-tidy-citations + notmuch-wash-elide-blank-lines + notmuch-wash-excerpt-citations)) (defmacro with-current-notmuch-show-message (&rest body) "Evaluate body with current buffer set to the text of current message" @@ -511,6 +514,13 @@ function is used. " query-context) (notmuch-show-insert-forest (notmuch-query-get-threads basic-args)))) + + ;; Enable buttonisation of URLs and email addresses in the + ;; buffer. + (goto-address-mode t) + ;; Act on visual lines rather than logical lines. + (visual-line-mode t) + (run-hooks 'notmuch-show-hook)) ;; Move straight to the first open message diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el index 5ca567f5..57f0cc5c 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 . ;; ;; Authors: Carl Worth +;; David Edmondson + +(require 'coolj) + +;; (defvar notmuch-wash-signature-regexp "^\\(-- ?\\|_+\\)$" @@ -108,8 +114,8 @@ is what to put on the button." 'invisibility-spec invis-spec :type button-type)))) -(defun notmuch-wash-text/plain-citations (depth) - "Markup citations, and up to one signature in the buffer." +(defun notmuch-wash-excerpt-citations (depth) + "Excerpt citations and up to one signature." (goto-char (point-min)) (beginning-of-line) (while (and (< (point) (point-max)) @@ -151,4 +157,78 @@ is what to put on the button." ;; +(defun notmuch-wash-elide-blank-lines (depth) + "Elide leading, trailing and successive 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) + "Improve the display of cited regions of a message. + +Perform four transformations on the message body: + +- Remove lines of repeated citation leaders with no other + content, +- Remove citation leaders standing alone before a block of cited + text, +- Remove citation trailers standing alone after a block of cited + text." + + ;; 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"))) + +;; + +(defun notmuch-wash-wrap-long-lines (depth) + "Wrap any long lines in the message to the width of the window. + +When doing so, maintaining citation leaders in the wrapped text." + + (let ((coolj-wrap-follows-window-size nil) + (fill-column (- (window-width) + depth + ;; 2 to avoid poor interaction with + ;; `word-wrap'. + 2))) + (coolj-wrap-region (point-min) (point-max)))) + +;; + (provide 'notmuch-wash)