git.notmuchmail.org Git - notmuch/blob - emacs/notmuch-wash.el

   1 ;; notmuch-wash.el --- cleaning up message bodies
   2 ;;
   3 ;; Copyright © Carl Worth
   4 ;; Copyright © David Edmondson
   5 ;;
   6 ;; This file is part of Notmuch.
   7 ;;
   8 ;; Notmuch is free software: you can redistribute it and/or modify it
   9 ;; under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12 ;;
  13 ;; Notmuch is distributed in the hope that it will be useful, but
  14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 ;; General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
  20 ;;
  21 ;; Authors: Carl Worth <cworth@cworth.org>
  22 ;;          David Edmondson <dme@dme.org>
  23
  24 (require 'coolj)
  25
  26 ;;
  27
  28 (defvar notmuch-wash-signature-regexp
  29   "^\\(-- ?\\|_+\\)$"
  30   "Pattern to match a line that separates content from signature.")
  31
  32 (defvar notmuch-wash-citation-regexp
  33   "\\(^[[:space:]]*>.*\n\\)+"
  34   "Pattern to match citation lines.")
  35
  36 (defvar notmuch-wash-signature-button-format
  37   "[ %d-line signature. Click/Enter to toggle visibility. ]"
  38   "String used to construct button text for hidden signatures.
  39 Can use up to one integer format parameter, i.e. %d")
  40
  41 (defvar notmuch-wash-citation-button-format
  42   "[ %d more citation lines. Click/Enter to toggle visibility. ]"
  43   "String used to construct button text for hidden citations.
  44 Can use up to one integer format parameter, i.e. %d")
  45
  46 (defvar notmuch-wash-signature-lines-max 12
  47   "Maximum length of signature that will be hidden by default.")
  48
  49 (defvar notmuch-wash-citation-lines-prefix 3
  50   "Always show at least this many lines from the start of a citation.
  51
  52 If there is one more line than the sum of
  53 `notmuch-wash-citation-lines-prefix' and
  54 `notmuch-wash-citation-lines-suffix', show that, otherwise
  55 collapse the remaining lines into a button.")
  56
  57 (defvar notmuch-wash-citation-lines-suffix 3
  58   "Always show at least this many lines from the end of a citation.
  59
  60 If there is one more line than the sum of
  61 `notmuch-wash-citation-lines-prefix' and
  62 `notmuch-wash-citation-lines-suffix', show that, otherwise
  63 collapse the remaining lines into a button.")
  64
  65 (defun notmuch-wash-toggle-invisible-action (cite-button)
  66   (let ((invis-spec (button-get cite-button 'invisibility-spec)))
  67     (if (invisible-p invis-spec)
  68         (remove-from-invisibility-spec invis-spec)
  69       (add-to-invisibility-spec invis-spec)))
  70   (force-window-update)
  71   (redisplay t))
  72
  73 (define-button-type 'notmuch-wash-button-invisibility-toggle-type
  74   'action 'notmuch-wash-toggle-invisible-action
  75   'follow-link t
  76   'face 'font-lock-comment-face)
  77
  78 (define-button-type 'notmuch-wash-button-citation-toggle-type
  79   'help-echo "mouse-1, RET: Show citation"
  80   :supertype 'notmuch-wash-button-invisibility-toggle-type)
  81
  82 (define-button-type 'notmuch-wash-button-signature-toggle-type
  83   'help-echo "mouse-1, RET: Show signature"
  84   :supertype 'notmuch-wash-button-invisibility-toggle-type)
  85
  86 (defun notmuch-wash-region-isearch-show (overlay)
  87   (remove-from-invisibility-spec (overlay-get overlay 'invisible)))
  88
  89 (defun notmuch-wash-region-to-button (beg end type prefix button-text)
  90   "Auxilary function to do the actual making of overlays and buttons
  91
  92 BEG and END are buffer locations. TYPE should a string, either
  93 \"citation\" or \"signature\". PREFIX is some arbitrary text to
  94 insert before the button, probably for indentation.  BUTTON-TEXT
  95 is what to put on the button."
  96
  97   ;; This uses some slightly tricky conversions between strings and
  98   ;; symbols because of the way the button code works. Note that
  99   ;; replacing intern-soft with make-symbol will cause this to fail,
 100   ;; since the newly created symbol has no plist.
 101
 102   (let ((overlay (make-overlay beg end))
 103         (invis-spec (make-symbol (concat "notmuch-" type "-region")))
 104         (button-type (intern-soft (concat "notmuch-wash-button-"
 105                                           type "-toggle-type"))))
 106     (add-to-invisibility-spec invis-spec)
 107     (overlay-put overlay 'invisible invis-spec)
 108     (overlay-put overlay 'isearch-open-invisible #'notmuch-wash-region-isearch-show)
 109     (goto-char (1+ end))
 110     (save-excursion
 111       (goto-char (1- beg))
 112       (insert prefix)
 113       (insert-button button-text
 114                      'invisibility-spec invis-spec
 115                      :type button-type))))
 116
 117 (defun notmuch-wash-excerpt-citations (depth)
 118   "Excerpt citations and up to one signature."
 119   (goto-char (point-min))
 120   (beginning-of-line)
 121   (while (and (< (point) (point-max))
 122               (re-search-forward notmuch-wash-citation-regexp nil t))
 123     (let* ((cite-start (match-beginning 0))
 124            (cite-end (match-end 0))
 125            (cite-lines (count-lines cite-start cite-end)))
 126       (overlay-put (make-overlay cite-start cite-end) 'face 'message-cited-text-face)
 127       (when (> cite-lines (+ notmuch-wash-citation-lines-prefix
 128                              notmuch-wash-citation-lines-suffix
 129                              1))
 130         (goto-char cite-start)
 131         (forward-line notmuch-wash-citation-lines-prefix)
 132         (let ((hidden-start (point-marker)))
 133           (goto-char cite-end)
 134           (forward-line (- notmuch-wash-citation-lines-suffix))
 135           (notmuch-wash-region-to-button
 136            hidden-start (point-marker)
 137            "citation" "\n"
 138            (format notmuch-wash-citation-button-format
 139                    (- cite-lines
 140                       notmuch-wash-citation-lines-prefix
 141                       notmuch-wash-citation-lines-suffix)))))))
 142   (if (and (not (eobp))
 143            (re-search-forward notmuch-wash-signature-regexp nil t))
 144       (let* ((sig-start (match-beginning 0))
 145              (sig-end (match-end 0))
 146              (sig-lines (1- (count-lines sig-start (point-max)))))
 147         (if (<= sig-lines notmuch-wash-signature-lines-max)
 148             (let ((sig-start-marker (make-marker))
 149                   (sig-end-marker (make-marker)))
 150               (set-marker sig-start-marker sig-start)
 151               (set-marker sig-end-marker (point-max))
 152               (overlay-put (make-overlay sig-start-marker sig-end-marker) 'face 'message-cited-text-face)
 153               (notmuch-wash-region-to-button
 154                sig-start-marker sig-end-marker
 155                "signature" "\n"
 156                (format notmuch-wash-signature-button-format sig-lines)))))))
 157
 158 ;;
 159
 160 (defun notmuch-wash-elide-blank-lines (depth)
 161   "Elide leading, trailing and successive blank lines."
 162
 163   ;; Algorithm derived from `article-strip-multiple-blank-lines' in
 164   ;; `gnus-art.el'.
 165
 166   ;; Make all blank lines empty.
 167   (goto-char (point-min))
 168   (while (re-search-forward "^[[:space:]\t]+$" nil t)
 169     (replace-match "" nil t))
 170
 171   ;; Replace multiple empty lines with a single empty line.
 172   (goto-char (point-min))
 173   (while (re-search-forward "^\n\\(\n+\\)" nil t)
 174     (delete-region (match-beginning 1) (match-end 1)))
 175
 176   ;; Remove a leading blank line.
 177   (goto-char (point-min))
 178   (if (looking-at "\n")
 179       (delete-region (match-beginning 0) (match-end 0)))
 180
 181   ;; Remove a trailing blank line.
 182   (goto-char (point-max))
 183   (if (looking-at "\n")
 184       (delete-region (match-beginning 0) (match-end 0))))
 185
 186 ;;
 187
 188 (defun notmuch-wash-tidy-citations (depth)
 189   "Improve the display of cited regions of a message.
 190
 191 Perform four transformations on the message body:
 192
 193 - Remove lines of repeated citation leaders with no other
 194   content,
 195 - Remove citation leaders standing alone before a block of cited
 196   text,
 197 - Remove citation trailers standing alone after a block of cited
 198   text."
 199
 200   ;; Remove lines of repeated citation leaders with no other content.
 201   (goto-char (point-min))
 202   (while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)
 203     (replace-match "\\1"))
 204
 205   ;; Remove citation leaders standing alone before a block of cited
 206   ;; text.
 207   (goto-char (point-min))
 208   (while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)
 209     (replace-match "\\1\n"))
 210
 211   ;; Remove citation trailers standing alone after a block of cited
 212   ;; text.
 213   (goto-char (point-min))
 214   (while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)
 215     (replace-match "\\2")))
 216
 217 ;;
 218
 219 (defun notmuch-wash-wrap-long-lines (depth)
 220   "Wrap any long lines in the message to the width of the window.
 221
 222 When doing so, maintaining citation leaders in the wrapped text."
 223
 224   (let ((coolj-wrap-follows-window-size nil)
 225         (fill-column (- (window-width)
 226                         depth
 227                         ;; 2 to avoid poor interaction with
 228                         ;; `word-wrap'.
 229                         2)))
 230     (coolj-wrap-region (point-min) (point-max))))
 231
 232 ;;
 233
 234 (provide 'notmuch-wash)