42/f5676405fd876f24757ffa656afbc1134dda40

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