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-markup-citations (depth)
 118   "Markup citations, and up to one signature in the buffer."
 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-compress-blanks (depth)
 161   "Compress successive blank lines into one blank line. Remove
 162 any leading or trailing blank lines."
 163
 164   ;; Algorithm derived from `article-strip-multiple-blank-lines' in
 165   ;; `gnus-art.el'.
 166
 167   ;; Make all blank lines empty.
 168   (goto-char (point-min))
 169   (while (re-search-forward "^[[:space:]\t]+$" nil t)
 170     (replace-match "" nil t))
 171
 172   ;; Replace multiple empty lines with a single empty line.
 173   (goto-char (point-min))
 174   (while (re-search-forward "^\n\\(\n+\\)" nil t)
 175     (delete-region (match-beginning 1) (match-end 1)))
 176
 177   ;; Remove a leading blank line.
 178   (goto-char (point-min))
 179   (if (looking-at "\n")
 180       (delete-region (match-beginning 0) (match-end 0)))
 181
 182   ;; Remove a trailing blank line.
 183   (goto-char (point-max))
 184   (if (looking-at "\n")
 185       (delete-region (match-beginning 0) (match-end 0))))
 186
 187 ;;
 188
 189 (defun notmuch-wash-tidy-citations (depth)
 190   "Clean up citations."
 191
 192   ;; Remove lines of repeated citation leaders with no other content.
 193   (goto-char (point-min))
 194   (while (re-search-forward "\\(^>[> ]*\n\\)\\{2,\\}" nil t)
 195     (replace-match "\\1"))
 196
 197   ;; Remove citation leaders standing alone before a block of cited
 198   ;; text.
 199   (goto-char (point-min))
 200   (while (re-search-forward "\\(\n\\|^[^>].*\\)\n\\(^>[> ]*\n\\)" nil t)
 201     (replace-match "\\1\n"))
 202
 203   ;; Remove citation trailers standing alone after a block of cited
 204   ;; text.
 205   (goto-char (point-min))
 206   (while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)
 207     (replace-match "\\2"))
 208
 209   ;; Remove blank lines between "Bill wrote:" and the citation.
 210   (goto-char (point-min))
 211   (while (re-search-forward "^\\([^>].*\\):\n\n>" nil t)
 212     (replace-match "\\1:\n>")))
 213
 214 ;;
 215
 216 (defun notmuch-wash-wrap-long-lines (depth)
 217   "Wrap text in the region whilst maintaining the correct prefix."
 218   (let ((coolj-wrap-follows-window-size nil)
 219         (fill-column (- (window-width) depth)))
 220     (coolj-wrap-region (point-min) (point-max))))
 221
 222 ;;
 223
 224 (provide 'notmuch-wash)