4a/c9b0929e7d3830a23c95aa30c4163e623bb411

   1 Return-Path: <dme@dme.org>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id AE7584196F0\r
   6         for <notmuch@notmuchmail.org>; Mon, 26 Apr 2010 06:45:34 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -1.9\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5\r
  12         tests=[BAYES_00=-1.9, RCVD_IN_DNSWL_NONE=-0.0001] autolearn=ham\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id fGg2jemq1Z+N for <notmuch@notmuchmail.org>;\r
  16         Mon, 26 Apr 2010 06:45:32 -0700 (PDT)\r
  17 Received: from fg-out-1718.google.com (fg-out-1718.google.com [72.14.220.159])\r
  18         by olra.theworths.org (Postfix) with ESMTP id 6762E431FC1\r
  19         for <notmuch@notmuchmail.org>; Mon, 26 Apr 2010 06:45:32 -0700 (PDT)\r
  20 Received: by fg-out-1718.google.com with SMTP id e21so1757781fga.2\r
  21         for <notmuch@notmuchmail.org>; Mon, 26 Apr 2010 06:45:31 -0700 (PDT)\r
  22 Received: by 10.86.124.4 with SMTP id w4mr2126243fgc.54.1272289531312;\r
  23         Mon, 26 Apr 2010 06:45:31 -0700 (PDT)\r
  24 Received: from ut.hh.sledj.net (gmp-ea-fw-1b.sun.com [192.18.8.1])\r
  25         by mx.google.com with ESMTPS id e17sm2625375fke.57.2010.04.26.06.45.29\r
  26         (version=TLSv1/SSLv3 cipher=RC4-MD5);\r
  27         Mon, 26 Apr 2010 06:45:29 -0700 (PDT)\r
  28 Received: by ut.hh.sledj.net (Postfix, from userid 1000)\r
  29         id 4207159413B; Mon, 26 Apr 2010 14:45:32 +0100 (BST)\r
  30 From: David Edmondson <dme@dme.org>\r
  31 To: notmuch@notmuchmail.org\r
  32 Subject: [PATCH] emacs: Add more functions to clean up text/plain parts\r
  33 Date: Mon, 26 Apr 2010 14:45:30 +0100\r
  34 Message-Id: <1272289530-12593-1-git-send-email-dme@dme.org>\r
  35 X-Mailer: git-send-email 1.7.0\r
  36 In-Reply-To: <87tyr0hohn.fsf@yoom.home.cworth.org>\r
  37 References: <87tyr0hohn.fsf@yoom.home.cworth.org>\r
  38 X-BeenThere: notmuch@notmuchmail.org\r
  39 X-Mailman-Version: 2.1.13\r
  40 Precedence: list\r
  41 List-Id: "Use and development of the notmuch mail system."\r
  42         <notmuch.notmuchmail.org>\r
  43 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  44         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  45 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  46 List-Post: <mailto:notmuch@notmuchmail.org>\r
  47 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  48 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  49         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  50 X-List-Received-Date: Mon, 26 Apr 2010 13:45:34 -0000\r
  51 \r
  52 Add:\r
  53 - notmuch-wash-wrap-long-lines: Wrap lines longer than the width of\r
  54   the current window whilst maintaining any citation prefix.\r
  55 - notmuch-wash-tidy-citations: Tidy up citations by:\r
  56   - compress repeated otherwise blank citation lines,\r
  57   - remove otherwise blank citation lines at the head and tail of a\r
  58     citation,\r
  59 - notmuch-wash-elide-blank-lines: Compress repeated blank lines and\r
  60   remove leading and trailing blank lines.\r
  61 \r
  62 None of these is enabled by default - add them to\r
  63 `notmuch-show-insert-text/plain-hook' to use.\r
  64 ---\r
  65 \r
  66 Another attempt :-)\r
  67 \r
  68 - Functions renamed to be clearer about what they do,\r
  69 - Function documentation both more concise (for display in customisation\r
  70   buffers) and more complete,\r
  71 - Interaction of long line wrapping and `word-wrap' improved,\r
  72 - Push `notmuch-show-pretty-hook' functions that everyone will use\r
  73   directly into the code, thus avoiding the naming dilemma.\r
  74 \r
  75  emacs/Makefile.local  |    3 +-\r
  76  emacs/coolj.el        |  145 +++++++++++++++++++++++++++++++++++++++++++++++++\r
  77  emacs/notmuch-show.el |   28 +++++++---\r
  78  emacs/notmuch-wash.el |   84 ++++++++++++++++++++++++++++-\r
  79  4 files changed, 248 insertions(+), 12 deletions(-)\r
  80  create mode 100644 emacs/coolj.el\r
  81 \r
  82 diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
  83 index 7537c3d..ce37ca2 100644\r
  84 --- a/emacs/Makefile.local\r
  85 +++ b/emacs/Makefile.local\r
  86 @@ -9,7 +9,8 @@ emacs_sources := \\r
  87         $(dir)/notmuch-wash.el \\r
  88         $(dir)/notmuch-hello.el \\r
  89         $(dir)/notmuch-mua.el \\r
  90 -       $(dir)/notmuch-address.el\r
  91 +       $(dir)/notmuch-address.el \\r
  92 +       $(dir)/coolj.el\r
  93  \r
  94  emacs_images := \\r
  95         $(dir)/notmuch-logo.png\r
  96 diff --git a/emacs/coolj.el b/emacs/coolj.el\r
  97 new file mode 100644\r
  98 index 0000000..60af60a\r
  99 --- /dev/null\r
 100 +++ b/emacs/coolj.el\r
 101 @@ -0,0 +1,145 @@\r
 102 +;;; coolj.el --- automatically wrap long lines  -*- coding:utf-8 -*-\r
 103 +\r
 104 +;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.\r
 105 +\r
 106 +;; Authors:    Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>\r
 107 +;;             Alex Schroeder <alex@gnu.org>\r
 108 +;;             Chong Yidong <cyd@stupidchicken.com>\r
 109 +;; Maintainer: David Edmondson <dme@dme.org>\r
 110 +;; Keywords: convenience, wp\r
 111 +\r
 112 +;; This file is not part of GNU Emacs.\r
 113 +\r
 114 +;; GNU Emacs is free software: you can redistribute it and/or modify\r
 115 +;; it under the terms of the GNU General Public License as published by\r
 116 +;; the Free Software Foundation, either version 3 of the License, or\r
 117 +;; (at your option) any later version.\r
 118 +\r
 119 +;; GNU Emacs is distributed in the hope that it will be useful,\r
 120 +;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
 121 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
 122 +;; GNU General Public License for more details.\r
 123 +\r
 124 +;; You should have received a copy of the GNU General Public License\r
 125 +;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.\r
 126 +\r
 127 +;;; Commentary:\r
 128 +\r
 129 +;;; This is a simple derivative of some functionality from\r
 130 +;;; `longlines.el'. The key difference is that this version will\r
 131 +;;; insert a prefix at the head of each wrapped line. The prefix is\r
 132 +;;; calculated from the originating long line.\r
 133 +\r
 134 +;;; No minor-mode is provided, the caller is expected to call\r
 135 +;;; `coolj-wrap-region' to wrap the region of interest.\r
 136 +\r
 137 +;;; Code:\r
 138 +\r
 139 +(defgroup coolj nil\r
 140 +  "Wrapping of long lines with prefix."\r
 141 +  :group 'fill)\r
 142 +\r
 143 +(defcustom coolj-wrap-follows-window-size t\r
 144 +  "Non-nil means wrap text to the window size.\r
 145 +Otherwise respect `fill-column'."\r
 146 +  :group 'coolj\r
 147 +  :type 'boolean)\r
 148 +\r
 149 +(defcustom coolj-line-prefix-regexp "^\\(>+ \\)*"\r
 150 +  "Regular expression that matches line prefixes."\r
 151 +  :group 'coolj\r
 152 +  :type 'regexp)\r
 153 +\r
 154 +(defvar coolj-wrap-point nil)\r
 155 +\r
 156 +(make-variable-buffer-local 'coolj-wrap-point)\r
 157 +\r
 158 +(defun coolj-determine-prefix ()\r
 159 +  "Determine the prefix for the current line."\r
 160 +  (save-excursion\r
 161 +    (beginning-of-line)\r
 162 +    (if (re-search-forward coolj-line-prefix-regexp nil t)\r
 163 +       (buffer-substring (match-beginning 0) (match-end 0))\r
 164 +      "")))\r
 165 +\r
 166 +(defun coolj-wrap-buffer ()\r
 167 +  "Wrap the current buffer."\r
 168 +  (coolj-wrap-region (point-min) (point-max)))\r
 169 +\r
 170 +(defun coolj-wrap-region (beg end)\r
 171 +  "Wrap each successive line, starting with the line before BEG.\r
 172 +Stop when we reach lines after END that don't need wrapping, or the\r
 173 +end of the buffer."\r
 174 +  (setq fill-column (if coolj-wrap-follows-window-size\r
 175 +                       (window-width)\r
 176 +                     fill-column))\r
 177 +  (let ((mod (buffer-modified-p)))\r
 178 +    (setq coolj-wrap-point (point))\r
 179 +    (goto-char beg)\r
 180 +    (forward-line -1)\r
 181 +    ;; Two successful coolj-wrap-line's in a row mean successive\r
 182 +    ;; lines don't need wrapping.\r
 183 +    (while (null (and (coolj-wrap-line)\r
 184 +                     (or (eobp)\r
 185 +                         (and (>= (point) end)\r
 186 +                              (coolj-wrap-line))))))\r
 187 +    (goto-char coolj-wrap-point)\r
 188 +    (set-buffer-modified-p mod)))\r
 189 +\r
 190 +(defun coolj-wrap-line ()\r
 191 +  "If the current line needs to be wrapped, wrap it and return nil.\r
 192 +If wrapping is performed, point remains on the line.  If the line does\r
 193 +not need to be wrapped, move point to the next line and return t."\r
 194 +  (let ((prefix (coolj-determine-prefix)))\r
 195 +    (if (coolj-set-breakpoint prefix)\r
 196 +       (progn\r
 197 +         (insert-before-markers ?\n)\r
 198 +         (backward-char 1)\r
 199 +         (delete-char -1)\r
 200 +         (forward-char 1)\r
 201 +         (insert-before-markers prefix)\r
 202 +         nil)\r
 203 +      (forward-line 1)\r
 204 +      t)))\r
 205 +\r
 206 +(defun coolj-set-breakpoint (prefix)\r
 207 +  "Place point where we should break the current line, and return t.\r
 208 +If the line should not be broken, return nil; point remains on the\r
 209 +line."\r
 210 +  (move-to-column fill-column)\r
 211 +  (if (and (re-search-forward "[^ ]" (line-end-position) 1)\r
 212 +           (> (current-column) fill-column))\r
 213 +      ;; This line is too long.  Can we break it?\r
 214 +      (or (coolj-find-break-backward prefix)\r
 215 +          (progn (move-to-column fill-column)\r
 216 +                 (coolj-find-break-forward)))))\r
 217 +\r
 218 +(defun coolj-find-break-backward (prefix)\r
 219 +  "Move point backward to the first available breakpoint and return t.\r
 220 +If no breakpoint is found, return nil."\r
 221 +  (let ((end-of-prefix (+ (line-beginning-position) (length prefix))))\r
 222 +    (and (search-backward " " end-of-prefix 1)\r
 223 +        (save-excursion\r
 224 +          (skip-chars-backward " " end-of-prefix)\r
 225 +          (null (bolp)))\r
 226 +        (progn (forward-char 1)\r
 227 +               (if (and fill-nobreak-predicate\r
 228 +                        (run-hook-with-args-until-success\r
 229 +                         'fill-nobreak-predicate))\r
 230 +                   (progn (skip-chars-backward " " end-of-prefix)\r
 231 +                          (coolj-find-break-backward prefix))\r
 232 +                 t)))))\r
 233 +\r
 234 +(defun coolj-find-break-forward ()\r
 235 +  "Move point forward to the first available breakpoint and return t.\r
 236 +If no break point is found, return nil."\r
 237 +  (and (search-forward " " (line-end-position) 1)\r
 238 +       (progn (skip-chars-forward " " (line-end-position))\r
 239 +              (null (eolp)))\r
 240 +       (if (and fill-nobreak-predicate\r
 241 +                (run-hook-with-args-until-success\r
 242 +                 'fill-nobreak-predicate))\r
 243 +           (coolj-find-break-forward)\r
 244 +         t)))\r
 245 +\r
 246 +(provide 'coolj)\r
 247 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 248 index f9d6c93..f5de8ae 100644\r
 249 --- a/emacs/notmuch-show.el\r
 250 +++ b/emacs/notmuch-show.el\r
 251 @@ -62,16 +62,19 @@ any given message."\r
 252    "A list of functions called to decorate the headers listed in\r
 253  `notmuch-message-headers'.")\r
 254  \r
 255 -(defvar notmuch-show-hook '(notmuch-show-pretty-hook)\r
 256 -  "A list of functions called after populating a\r
 257 -`notmuch-show' buffer.")\r
 258 -\r
 259 -(defvar notmuch-show-insert-text/plain-hook '(notmuch-wash-text/plain-citations)\r
 260 -  "A list of functions called to clean up text/plain body parts.")\r
 261 +(defcustom notmuch-show-hook nil\r
 262 +  "Functions called after populating a `notmuch-show' buffer."\r
 263 +  :group 'notmuch\r
 264 +  :type 'hook)\r
 265  \r
 266 -(defun notmuch-show-pretty-hook ()\r
 267 -  (goto-address-mode 1)\r
 268 -  (visual-line-mode))\r
 269 +(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations)\r
 270 +  "Functions used to improve the display of text/plain parts."\r
 271 +  :group 'notmuch\r
 272 +  :type 'hook\r
 273 +  :options '(notmuch-wash-wrap-long-lines\r
 274 +            notmuch-wash-tidy-citations\r
 275 +            notmuch-wash-elide-blank-lines\r
 276 +            notmuch-wash-excerpt-citations))\r
 277  \r
 278  (defmacro with-current-notmuch-show-message (&rest body)\r
 279    "Evaluate body with current buffer set to the text of current message"\r
 280 @@ -511,6 +514,13 @@ function is used. "\r
 281                    query-context)\r
 282           (notmuch-show-insert-forest\r
 283            (notmuch-query-get-threads basic-args))))\r
 284 +\r
 285 +      ;; Enable buttonisation of URLs and email addresses in the\r
 286 +      ;; buffer.\r
 287 +      (goto-address-mode t)\r
 288 +      ;; Act on visual lines rather than logical lines.\r
 289 +      (visual-line-mode t)\r
 290 +\r
 291        (run-hooks 'notmuch-show-hook))\r
 292  \r
 293      ;; Move straight to the first open message\r
 294 diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el\r
 295 index 5ca567f..57f0cc5 100644\r
 296 --- a/emacs/notmuch-wash.el\r
 297 +++ b/emacs/notmuch-wash.el\r
 298 @@ -1,6 +1,7 @@\r
 299  ;; notmuch-wash.el --- cleaning up message bodies\r
 300  ;;\r
 301  ;; Copyright © Carl Worth\r
 302 +;; Copyright © David Edmondson\r
 303  ;;\r
 304  ;; This file is part of Notmuch.\r
 305  ;;\r
 306 @@ -18,6 +19,11 @@\r
 307  ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.\r
 308  ;;\r
 309  ;; Authors: Carl Worth <cworth@cworth.org>\r
 310 +;;          David Edmondson <dme@dme.org>\r
 311 +\r
 312 +(require 'coolj)\r
 313 +\r
 314 +;;\r
 315  \r
 316  (defvar notmuch-wash-signature-regexp\r
 317    "^\\(-- ?\\|_+\\)$"\r
 318 @@ -108,8 +114,8 @@ is what to put on the button."\r
 319                      'invisibility-spec invis-spec\r
 320                      :type button-type))))\r
 321  \r
 322 -(defun notmuch-wash-text/plain-citations (depth)\r
 323 -  "Markup citations, and up to one signature in the buffer."\r
 324 +(defun notmuch-wash-excerpt-citations (depth)\r
 325 +  "Excerpt citations and up to one signature."\r
 326    (goto-char (point-min))\r
 327    (beginning-of-line)\r
 328    (while (and (< (point) (point-max))\r
 329 @@ -151,4 +157,78 @@ is what to put on the button."\r
 330  \r
 331  ;;\r
 332  \r
 333 +(defun notmuch-wash-elide-blank-lines (depth)\r
 334 +  "Elide leading, trailing and successive blank lines."\r
 335 +\r
 336 +  ;; Algorithm derived from `article-strip-multiple-blank-lines' in\r
 337 +  ;; `gnus-art.el'.\r
 338 +\r
 339 +  ;; Make all blank lines empty.\r
 340 +  (goto-char (point-min))\r
 341 +  (while (re-search-forward "^[[:space:]\t]+$" nil t)\r
 342 +    (replace-match "" nil t))\r
 343 +\r
 344 +  ;; Replace multiple empty lines with a single empty line.\r
 345 +  (goto-char (point-min))\r
 346 +  (while (re-search-forward "^\n\\(\n+\\)" nil t)\r
 347 +    (delete-region (match-beginning 1) (match-end 1)))\r
 348 +\r
 349 +  ;; Remove a leading blank line.\r
 350 +  (goto-char (point-min))\r
 351 +  (if (looking-at "\n")\r
 352 +      (delete-region (match-beginning 0) (match-end 0)))\r
 353 +\r
 354 +  ;; Remove a trailing blank line.\r
 355 +  (goto-char (point-max))\r
 356 +  (if (looking-at "\n")\r
 357 +      (delete-region (match-beginning 0) (match-end 0))))\r
 358 +\r
 359 +;;\r
 360 +\r
 361 +(defun notmuch-wash-tidy-citations (depth)\r
 362 +  "Improve the display of cited regions of a message.\r
 363 +\r
 364 +Perform four transformations on the message body:\r
 365 +\r
 366 +- Remove lines of repeated citation leaders with no other\r
 367 +  content,\r
 368 +- Remove citation leaders standing alone before a block of cited\r
 369 +  text,\r
 370 +- Remove citation trailers standing alone after a block of cited\r
 371 +  text."\r
 372 +\r
 373 +  ;; Remove lines of repeated citation leaders with no other content.\r
 374 +  (goto-char (point-min))\r
 375 +  (while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)\r
 376 +    (replace-match "\\1"))\r
 377 +\r
 378 +  ;; Remove citation leaders standing alone before a block of cited\r
 379 +  ;; text.\r
 380 +  (goto-char (point-min))\r
 381 +  (while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)\r
 382 +    (replace-match "\\1\n"))\r
 383 +\r
 384 +  ;; Remove citation trailers standing alone after a block of cited\r
 385 +  ;; text.\r
 386 +  (goto-char (point-min))\r
 387 +  (while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)\r
 388 +    (replace-match "\\2")))\r
 389 +\r
 390 +;;\r
 391 +\r
 392 +(defun notmuch-wash-wrap-long-lines (depth)\r
 393 +  "Wrap any long lines in the message to the width of the window.\r
 394 +\r
 395 +When doing so, maintaining citation leaders in the wrapped text."\r
 396 +\r
 397 +  (let ((coolj-wrap-follows-window-size nil)\r
 398 +       (fill-column (- (window-width)\r
 399 +                       depth\r
 400 +                       ;; 2 to avoid poor interaction with\r
 401 +                       ;; `word-wrap'.\r
 402 +                       2)))\r
 403 +    (coolj-wrap-region (point-min) (point-max))))\r
 404 +\r
 405 +;;\r
 406 +\r
 407  (provide 'notmuch-wash)\r
 408 -- \r
 409 1.7.0\r
 410 \r