--- /dev/null
+Return-Path: <dme@dme.org>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id AE7584196F0\r
+ for <notmuch@notmuchmail.org>; Mon, 26 Apr 2010 06:45:34 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -1.9\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5\r
+ tests=[BAYES_00=-1.9, RCVD_IN_DNSWL_NONE=-0.0001] autolearn=ham\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id fGg2jemq1Z+N for <notmuch@notmuchmail.org>;\r
+ Mon, 26 Apr 2010 06:45:32 -0700 (PDT)\r
+Received: from fg-out-1718.google.com (fg-out-1718.google.com [72.14.220.159])\r
+ by olra.theworths.org (Postfix) with ESMTP id 6762E431FC1\r
+ for <notmuch@notmuchmail.org>; Mon, 26 Apr 2010 06:45:32 -0700 (PDT)\r
+Received: by fg-out-1718.google.com with SMTP id e21so1757781fga.2\r
+ for <notmuch@notmuchmail.org>; Mon, 26 Apr 2010 06:45:31 -0700 (PDT)\r
+Received: by 10.86.124.4 with SMTP id w4mr2126243fgc.54.1272289531312;\r
+ Mon, 26 Apr 2010 06:45:31 -0700 (PDT)\r
+Received: from ut.hh.sledj.net (gmp-ea-fw-1b.sun.com [192.18.8.1])\r
+ by mx.google.com with ESMTPS id e17sm2625375fke.57.2010.04.26.06.45.29\r
+ (version=TLSv1/SSLv3 cipher=RC4-MD5);\r
+ Mon, 26 Apr 2010 06:45:29 -0700 (PDT)\r
+Received: by ut.hh.sledj.net (Postfix, from userid 1000)\r
+ id 4207159413B; Mon, 26 Apr 2010 14:45:32 +0100 (BST)\r
+From: David Edmondson <dme@dme.org>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH] emacs: Add more functions to clean up text/plain parts\r
+Date: Mon, 26 Apr 2010 14:45:30 +0100\r
+Message-Id: <1272289530-12593-1-git-send-email-dme@dme.org>\r
+X-Mailer: git-send-email 1.7.0\r
+In-Reply-To: <87tyr0hohn.fsf@yoom.home.cworth.org>\r
+References: <87tyr0hohn.fsf@yoom.home.cworth.org>\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Mon, 26 Apr 2010 13:45:34 -0000\r
+\r
+Add:\r
+- notmuch-wash-wrap-long-lines: Wrap lines longer than the width of\r
+ the current window whilst maintaining any citation prefix.\r
+- notmuch-wash-tidy-citations: Tidy up citations by:\r
+ - compress repeated otherwise blank citation lines,\r
+ - remove otherwise blank citation lines at the head and tail of a\r
+ citation,\r
+- notmuch-wash-elide-blank-lines: Compress repeated blank lines and\r
+ remove leading and trailing blank lines.\r
+\r
+None of these is enabled by default - add them to\r
+`notmuch-show-insert-text/plain-hook' to use.\r
+---\r
+\r
+Another attempt :-)\r
+\r
+- Functions renamed to be clearer about what they do,\r
+- Function documentation both more concise (for display in customisation\r
+ buffers) and more complete,\r
+- Interaction of long line wrapping and `word-wrap' improved,\r
+- Push `notmuch-show-pretty-hook' functions that everyone will use\r
+ directly into the code, thus avoiding the naming dilemma.\r
+\r
+ emacs/Makefile.local | 3 +-\r
+ emacs/coolj.el | 145 +++++++++++++++++++++++++++++++++++++++++++++++++\r
+ emacs/notmuch-show.el | 28 +++++++---\r
+ emacs/notmuch-wash.el | 84 ++++++++++++++++++++++++++++-\r
+ 4 files changed, 248 insertions(+), 12 deletions(-)\r
+ create mode 100644 emacs/coolj.el\r
+\r
+diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
+index 7537c3d..ce37ca2 100644\r
+--- a/emacs/Makefile.local\r
++++ b/emacs/Makefile.local\r
+@@ -9,7 +9,8 @@ emacs_sources := \\r
+ $(dir)/notmuch-wash.el \\r
+ $(dir)/notmuch-hello.el \\r
+ $(dir)/notmuch-mua.el \\r
+- $(dir)/notmuch-address.el\r
++ $(dir)/notmuch-address.el \\r
++ $(dir)/coolj.el\r
+ \r
+ emacs_images := \\r
+ $(dir)/notmuch-logo.png\r
+diff --git a/emacs/coolj.el b/emacs/coolj.el\r
+new file mode 100644\r
+index 0000000..60af60a\r
+--- /dev/null\r
++++ b/emacs/coolj.el\r
+@@ -0,0 +1,145 @@\r
++;;; coolj.el --- automatically wrap long lines -*- coding:utf-8 -*-\r
++\r
++;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.\r
++\r
++;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>\r
++;; Alex Schroeder <alex@gnu.org>\r
++;; Chong Yidong <cyd@stupidchicken.com>\r
++;; Maintainer: David Edmondson <dme@dme.org>\r
++;; Keywords: convenience, wp\r
++\r
++;; This file is not part of GNU Emacs.\r
++\r
++;; GNU Emacs is free software: you can redistribute it and/or modify\r
++;; it under the terms of the GNU General Public License as published by\r
++;; the Free Software Foundation, either version 3 of the License, or\r
++;; (at your option) any later version.\r
++\r
++;; GNU Emacs is distributed in the hope that it will be useful,\r
++;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
++;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
++;; GNU General Public License for more details.\r
++\r
++;; You should have received a copy of the GNU General Public License\r
++;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.\r
++\r
++;;; Commentary:\r
++\r
++;;; This is a simple derivative of some functionality from\r
++;;; `longlines.el'. The key difference is that this version will\r
++;;; insert a prefix at the head of each wrapped line. The prefix is\r
++;;; calculated from the originating long line.\r
++\r
++;;; No minor-mode is provided, the caller is expected to call\r
++;;; `coolj-wrap-region' to wrap the region of interest.\r
++\r
++;;; Code:\r
++\r
++(defgroup coolj nil\r
++ "Wrapping of long lines with prefix."\r
++ :group 'fill)\r
++\r
++(defcustom coolj-wrap-follows-window-size t\r
++ "Non-nil means wrap text to the window size.\r
++Otherwise respect `fill-column'."\r
++ :group 'coolj\r
++ :type 'boolean)\r
++\r
++(defcustom coolj-line-prefix-regexp "^\\(>+ \\)*"\r
++ "Regular expression that matches line prefixes."\r
++ :group 'coolj\r
++ :type 'regexp)\r
++\r
++(defvar coolj-wrap-point nil)\r
++\r
++(make-variable-buffer-local 'coolj-wrap-point)\r
++\r
++(defun coolj-determine-prefix ()\r
++ "Determine the prefix for the current line."\r
++ (save-excursion\r
++ (beginning-of-line)\r
++ (if (re-search-forward coolj-line-prefix-regexp nil t)\r
++ (buffer-substring (match-beginning 0) (match-end 0))\r
++ "")))\r
++\r
++(defun coolj-wrap-buffer ()\r
++ "Wrap the current buffer."\r
++ (coolj-wrap-region (point-min) (point-max)))\r
++\r
++(defun coolj-wrap-region (beg end)\r
++ "Wrap each successive line, starting with the line before BEG.\r
++Stop when we reach lines after END that don't need wrapping, or the\r
++end of the buffer."\r
++ (setq fill-column (if coolj-wrap-follows-window-size\r
++ (window-width)\r
++ fill-column))\r
++ (let ((mod (buffer-modified-p)))\r
++ (setq coolj-wrap-point (point))\r
++ (goto-char beg)\r
++ (forward-line -1)\r
++ ;; Two successful coolj-wrap-line's in a row mean successive\r
++ ;; lines don't need wrapping.\r
++ (while (null (and (coolj-wrap-line)\r
++ (or (eobp)\r
++ (and (>= (point) end)\r
++ (coolj-wrap-line))))))\r
++ (goto-char coolj-wrap-point)\r
++ (set-buffer-modified-p mod)))\r
++\r
++(defun coolj-wrap-line ()\r
++ "If the current line needs to be wrapped, wrap it and return nil.\r
++If wrapping is performed, point remains on the line. If the line does\r
++not need to be wrapped, move point to the next line and return t."\r
++ (let ((prefix (coolj-determine-prefix)))\r
++ (if (coolj-set-breakpoint prefix)\r
++ (progn\r
++ (insert-before-markers ?\n)\r
++ (backward-char 1)\r
++ (delete-char -1)\r
++ (forward-char 1)\r
++ (insert-before-markers prefix)\r
++ nil)\r
++ (forward-line 1)\r
++ t)))\r
++\r
++(defun coolj-set-breakpoint (prefix)\r
++ "Place point where we should break the current line, and return t.\r
++If the line should not be broken, return nil; point remains on the\r
++line."\r
++ (move-to-column fill-column)\r
++ (if (and (re-search-forward "[^ ]" (line-end-position) 1)\r
++ (> (current-column) fill-column))\r
++ ;; This line is too long. Can we break it?\r
++ (or (coolj-find-break-backward prefix)\r
++ (progn (move-to-column fill-column)\r
++ (coolj-find-break-forward)))))\r
++\r
++(defun coolj-find-break-backward (prefix)\r
++ "Move point backward to the first available breakpoint and return t.\r
++If no breakpoint is found, return nil."\r
++ (let ((end-of-prefix (+ (line-beginning-position) (length prefix))))\r
++ (and (search-backward " " end-of-prefix 1)\r
++ (save-excursion\r
++ (skip-chars-backward " " end-of-prefix)\r
++ (null (bolp)))\r
++ (progn (forward-char 1)\r
++ (if (and fill-nobreak-predicate\r
++ (run-hook-with-args-until-success\r
++ 'fill-nobreak-predicate))\r
++ (progn (skip-chars-backward " " end-of-prefix)\r
++ (coolj-find-break-backward prefix))\r
++ t)))))\r
++\r
++(defun coolj-find-break-forward ()\r
++ "Move point forward to the first available breakpoint and return t.\r
++If no break point is found, return nil."\r
++ (and (search-forward " " (line-end-position) 1)\r
++ (progn (skip-chars-forward " " (line-end-position))\r
++ (null (eolp)))\r
++ (if (and fill-nobreak-predicate\r
++ (run-hook-with-args-until-success\r
++ 'fill-nobreak-predicate))\r
++ (coolj-find-break-forward)\r
++ t)))\r
++\r
++(provide 'coolj)\r
+diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+index f9d6c93..f5de8ae 100644\r
+--- a/emacs/notmuch-show.el\r
++++ b/emacs/notmuch-show.el\r
+@@ -62,16 +62,19 @@ any given message."\r
+ "A list of functions called to decorate the headers listed in\r
+ `notmuch-message-headers'.")\r
+ \r
+-(defvar notmuch-show-hook '(notmuch-show-pretty-hook)\r
+- "A list of functions called after populating a\r
+-`notmuch-show' buffer.")\r
+-\r
+-(defvar notmuch-show-insert-text/plain-hook '(notmuch-wash-text/plain-citations)\r
+- "A list of functions called to clean up text/plain body parts.")\r
++(defcustom notmuch-show-hook nil\r
++ "Functions called after populating a `notmuch-show' buffer."\r
++ :group 'notmuch\r
++ :type 'hook)\r
+ \r
+-(defun notmuch-show-pretty-hook ()\r
+- (goto-address-mode 1)\r
+- (visual-line-mode))\r
++(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations)\r
++ "Functions used to improve the display of text/plain parts."\r
++ :group 'notmuch\r
++ :type 'hook\r
++ :options '(notmuch-wash-wrap-long-lines\r
++ notmuch-wash-tidy-citations\r
++ notmuch-wash-elide-blank-lines\r
++ notmuch-wash-excerpt-citations))\r
+ \r
+ (defmacro with-current-notmuch-show-message (&rest body)\r
+ "Evaluate body with current buffer set to the text of current message"\r
+@@ -511,6 +514,13 @@ function is used. "\r
+ query-context)\r
+ (notmuch-show-insert-forest\r
+ (notmuch-query-get-threads basic-args))))\r
++\r
++ ;; Enable buttonisation of URLs and email addresses in the\r
++ ;; buffer.\r
++ (goto-address-mode t)\r
++ ;; Act on visual lines rather than logical lines.\r
++ (visual-line-mode t)\r
++\r
+ (run-hooks 'notmuch-show-hook))\r
+ \r
+ ;; Move straight to the first open message\r
+diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el\r
+index 5ca567f..57f0cc5 100644\r
+--- a/emacs/notmuch-wash.el\r
++++ b/emacs/notmuch-wash.el\r
+@@ -1,6 +1,7 @@\r
+ ;; notmuch-wash.el --- cleaning up message bodies\r
+ ;;\r
+ ;; Copyright © Carl Worth\r
++;; Copyright © David Edmondson\r
+ ;;\r
+ ;; This file is part of Notmuch.\r
+ ;;\r
+@@ -18,6 +19,11 @@\r
+ ;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.\r
+ ;;\r
+ ;; Authors: Carl Worth <cworth@cworth.org>\r
++;; David Edmondson <dme@dme.org>\r
++\r
++(require 'coolj)\r
++\r
++;;\r
+ \r
+ (defvar notmuch-wash-signature-regexp\r
+ "^\\(-- ?\\|_+\\)$"\r
+@@ -108,8 +114,8 @@ is what to put on the button."\r
+ 'invisibility-spec invis-spec\r
+ :type button-type))))\r
+ \r
+-(defun notmuch-wash-text/plain-citations (depth)\r
+- "Markup citations, and up to one signature in the buffer."\r
++(defun notmuch-wash-excerpt-citations (depth)\r
++ "Excerpt citations and up to one signature."\r
+ (goto-char (point-min))\r
+ (beginning-of-line)\r
+ (while (and (< (point) (point-max))\r
+@@ -151,4 +157,78 @@ is what to put on the button."\r
+ \r
+ ;;\r
+ \r
++(defun notmuch-wash-elide-blank-lines (depth)\r
++ "Elide leading, trailing and successive blank lines."\r
++\r
++ ;; Algorithm derived from `article-strip-multiple-blank-lines' in\r
++ ;; `gnus-art.el'.\r
++\r
++ ;; Make all blank lines empty.\r
++ (goto-char (point-min))\r
++ (while (re-search-forward "^[[:space:]\t]+$" nil t)\r
++ (replace-match "" nil t))\r
++\r
++ ;; Replace multiple empty lines with a single empty line.\r
++ (goto-char (point-min))\r
++ (while (re-search-forward "^\n\\(\n+\\)" nil t)\r
++ (delete-region (match-beginning 1) (match-end 1)))\r
++\r
++ ;; Remove a leading blank line.\r
++ (goto-char (point-min))\r
++ (if (looking-at "\n")\r
++ (delete-region (match-beginning 0) (match-end 0)))\r
++\r
++ ;; Remove a trailing blank line.\r
++ (goto-char (point-max))\r
++ (if (looking-at "\n")\r
++ (delete-region (match-beginning 0) (match-end 0))))\r
++\r
++;;\r
++\r
++(defun notmuch-wash-tidy-citations (depth)\r
++ "Improve the display of cited regions of a message.\r
++\r
++Perform four transformations on the message body:\r
++\r
++- Remove lines of repeated citation leaders with no other\r
++ content,\r
++- Remove citation leaders standing alone before a block of cited\r
++ text,\r
++- Remove citation trailers standing alone after a block of cited\r
++ text."\r
++\r
++ ;; Remove lines of repeated citation leaders with no other content.\r
++ (goto-char (point-min))\r
++ (while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)\r
++ (replace-match "\\1"))\r
++\r
++ ;; Remove citation leaders standing alone before a block of cited\r
++ ;; text.\r
++ (goto-char (point-min))\r
++ (while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)\r
++ (replace-match "\\1\n"))\r
++\r
++ ;; Remove citation trailers standing alone after a block of cited\r
++ ;; text.\r
++ (goto-char (point-min))\r
++ (while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)\r
++ (replace-match "\\2")))\r
++\r
++;;\r
++\r
++(defun notmuch-wash-wrap-long-lines (depth)\r
++ "Wrap any long lines in the message to the width of the window.\r
++\r
++When doing so, maintaining citation leaders in the wrapped text."\r
++\r
++ (let ((coolj-wrap-follows-window-size nil)\r
++ (fill-column (- (window-width)\r
++ depth\r
++ ;; 2 to avoid poor interaction with\r
++ ;; `word-wrap'.\r
++ 2)))\r
++ (coolj-wrap-region (point-min) (point-max))))\r
++\r
++;;\r
++\r
+ (provide 'notmuch-wash)\r
+-- \r
+1.7.0\r
+\r
projects / notmuch-archives.git / commitdiff