Merge branch 'release'

[notmuch] / emacs / notmuch-wash.el

diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el
index 826b6f43c77ba6853a32f65ad82b67af0a52271c..07fc1a1f6325363df0e0a55268899851dd3cc109 100644 (file)
--- a/emacs/notmuch-wash.el
+++ b/emacs/notmuch-wash.el
@@ -1,4 +1,4 @@
-;; notmuch-wash.el --- cleaning up message bodies
+;;; notmuch-wash.el --- cleaning up message bodies

 ;;
 ;; Copyright © Carl Worth
 ;; Copyright © David Edmondson
 ;;
 ;; Copyright © Carl Worth
 ;; Copyright © David Edmondson


@@ -16,84 +16,130 @@
 ;; General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License

-;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
+;; along with Notmuch.  If not, see <https://www.gnu.org/licenses/>.

 ;;
 ;; Authors: Carl Worth <cworth@cworth.org>
 ;;          David Edmondson <dme@dme.org>
 
 ;;
 ;; Authors: Carl Worth <cworth@cworth.org>
 ;;          David Edmondson <dme@dme.org>
 

+;;; Code:
+

 (require 'coolj)
 
 (require 'coolj)
 

-(declare-function notmuch-show-insert-bodypart "notmuch-show" (msg part depth))
+(declare-function notmuch-show-insert-bodypart "notmuch-show" (msg part depth &optional hide))
+(defvar notmuch-show-indent-messages-width)

 
 ;;
 
 
 ;;
 

-(defvar notmuch-wash-signature-regexp
-  "^\\(-- ?\\|_+\\)$"
-  "Pattern to match a line that separates content from signature.")
+(defgroup notmuch-wash nil
+  "Cleaning up messages for display."
+  :group 'notmuch)
+
+(defcustom notmuch-wash-signature-regexp "^\\(-- ?\\|_+\\)$"
+  "Pattern to match a line that separates content from signature."
+  :type 'regexp
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-citation-regexp
-  "\\(^[[:space:]]*>.*\n\\)+"
-  "Pattern to match citation lines.")
+(defcustom notmuch-wash-citation-regexp "\\(^[[:space:]]*>.*\n\\)+"
+  "Pattern to match citation lines."
+  :type 'regexp
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-original-regexp "^\\(--+\s?[oO]riginal [mM]essage\s?--+\\)$"
-  "Pattern to match a line that separates original message from reply in top-posted message.")
+(defcustom notmuch-wash-original-regexp "^\\(--+\s?[oO]riginal [mM]essage\s?--+\\)$"
+  "Pattern to match a line that separates original message from
+reply in top-posted message."
+  :type 'regexp
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-signature-hidden-format
+(defcustom notmuch-wash-button-signature-hidden-format

   "[ %d-line signature. Click/Enter to show. ]"
   "String used to construct button text for hidden signatures.
   "[ %d-line signature. Click/Enter to show. ]"
   "String used to construct button text for hidden signatures.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-signature-visible-format
+(defcustom notmuch-wash-button-signature-visible-format

   "[ %d-line signature. Click/Enter to hide. ]"
   "String used to construct button text for visible signatures.
   "[ %d-line signature. Click/Enter to hide. ]"
   "String used to construct button text for visible signatures.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-citation-hidden-format
+(defcustom notmuch-wash-button-citation-hidden-format

   "[ %d more citation lines. Click/Enter to show. ]"
   "String used to construct button text for hidden citations.
   "[ %d more citation lines. Click/Enter to show. ]"
   "String used to construct button text for hidden citations.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-citation-visible-format
+(defcustom notmuch-wash-button-citation-visible-format

   "[ %d more citation lines. Click/Enter to hide. ]"
   "String used to construct button text for visible citations.
   "[ %d more citation lines. Click/Enter to hide. ]"
   "String used to construct button text for visible citations.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-original-hidden-format
+(defcustom notmuch-wash-button-original-hidden-format

   "[ %d-line hidden original message. Click/Enter to show. ]"
   "String used to construct button text for hidden citations.
   "[ %d-line hidden original message. Click/Enter to show. ]"
   "String used to construct button text for hidden citations.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-original-visible-format
+(defcustom notmuch-wash-button-original-visible-format

   "[ %d-line original message. Click/Enter to hide. ]"
   "String used to construct button text for visible citations.
   "[ %d-line original message. Click/Enter to hide. ]"
   "String used to construct button text for visible citations.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-signature-lines-max 12
-  "Maximum length of signature that will be hidden by default.")
+(defcustom notmuch-wash-signature-lines-max 12
+  "Maximum length of signature that will be hidden by default."
+  :type 'integer
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-citation-lines-prefix 3
+(defcustom notmuch-wash-citation-lines-prefix 3

   "Always show at least this many lines from the start of a citation.
 
 If there is one more line than the sum of
 `notmuch-wash-citation-lines-prefix' and
 `notmuch-wash-citation-lines-suffix', show that, otherwise
   "Always show at least this many lines from the start of a citation.
 
 If there is one more line than the sum of
 `notmuch-wash-citation-lines-prefix' and
 `notmuch-wash-citation-lines-suffix', show that, otherwise

-collapse the remaining lines into a button.")
+collapse the remaining lines into a button."
+  :type 'integer
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-citation-lines-suffix 3
+(defcustom notmuch-wash-citation-lines-suffix 3

   "Always show at least this many lines from the end of a citation.
 
 If there is one more line than the sum of
 `notmuch-wash-citation-lines-prefix' and
 `notmuch-wash-citation-lines-suffix', show that, otherwise
   "Always show at least this many lines from the end of a citation.
 
 If there is one more line than the sum of
 `notmuch-wash-citation-lines-prefix' and
 `notmuch-wash-citation-lines-suffix', show that, otherwise

-collapse the remaining lines into a button.")
+collapse the remaining lines into a button."
+  :type 'integer
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-wrap-lines-length nil
+(defcustom notmuch-wash-wrap-lines-length nil

   "Wrap line after at most this many characters.
 
 If this is nil, lines in messages will be wrapped to fit in the
 current window. If this is a number, lines will be wrapped after
 this many characters or at the window width (whichever one is
   "Wrap line after at most this many characters.
 
 If this is nil, lines in messages will be wrapped to fit in the
 current window. If this is a number, lines will be wrapped after
 this many characters or at the window width (whichever one is

-lower).")
+lower)."
+  :type '(choice (const :tag "window width" nil)
+                (integer :tag "number of characters"))
+  :group 'notmuch-wash)
+
+(defface notmuch-wash-toggle-button
+  '((t (:inherit font-lock-comment-face)))
+  "Face used for buttons toggling the visibility of washed away
+message parts."
+  :group 'notmuch-wash
+  :group 'notmuch-faces)
+
+(defface notmuch-wash-cited-text
+  '((t (:inherit message-cited-text)))
+  "Face used for cited text."
+  :group 'notmuch-wash
+  :group 'notmuch-faces)

 
 (defun notmuch-wash-toggle-invisible-action (cite-button)
   ;; Toggle overlay visibility
 
 (defun notmuch-wash-toggle-invisible-action (cite-button)
   ;; Toggle overlay visibility


@@ -104,9 +150,11 @@ lower).")
         (overlay (button-get cite-button 'overlay))
         (button-label (notmuch-wash-button-label overlay))
         (old-point (point))
         (overlay (button-get cite-button 'overlay))
         (button-label (notmuch-wash-button-label overlay))
         (old-point (point))

+        (properties (text-properties-at (point)))

         (inhibit-read-only t))
     (goto-char new-start)
     (insert button-label)
         (inhibit-read-only t))
     (goto-char new-start)
     (insert button-label)

+    (set-text-properties new-start (point) properties)

     (let ((old-end (button-end cite-button)))
       (move-overlay cite-button new-start (point))
       (delete-region (point) old-end))
     (let ((old-end (button-end cite-button)))
       (move-overlay cite-button new-start (point))
       (delete-region (point) old-end))


@@ -115,7 +163,7 @@ lower).")
 (define-button-type 'notmuch-wash-button-invisibility-toggle-type
   'action 'notmuch-wash-toggle-invisible-action
   'follow-link t
 (define-button-type 'notmuch-wash-button-invisibility-toggle-type
   'action 'notmuch-wash-toggle-invisible-action
   'follow-link t

-  'face 'font-lock-comment-face
+  'face 'notmuch-wash-toggle-button

   :supertype 'notmuch-button-type)
 
 (define-button-type 'notmuch-wash-button-citation-toggle-type
   :supertype 'notmuch-button-type)
 
 (define-button-type 'notmuch-wash-button-citation-toggle-type


@@ -190,7 +238,7 @@ that PREFIX should not include a newline."
     (let* ((cite-start (match-beginning 0))
           (cite-end (match-end 0))
           (cite-lines (count-lines cite-start cite-end)))
     (let* ((cite-start (match-beginning 0))
           (cite-end (match-end 0))
           (cite-lines (count-lines cite-start cite-end)))

-      (overlay-put (make-overlay cite-start cite-end) 'face 'message-cited-text)
+      (overlay-put (make-overlay cite-start cite-end) 'face 'notmuch-wash-cited-text)

       (when (> cite-lines (+ notmuch-wash-citation-lines-prefix
                             notmuch-wash-citation-lines-suffix
                             1))
       (when (> cite-lines (+ notmuch-wash-citation-lines-prefix
                             notmuch-wash-citation-lines-suffix
                             1))


@@ -288,12 +336,13 @@ message at the window width. When doing so, citation leaders in
 the wrapped text are maintained."
 
   (let* ((coolj-wrap-follows-window-size nil)
 the wrapped text are maintained."
 
   (let* ((coolj-wrap-follows-window-size nil)

+        (indent (* depth notmuch-show-indent-messages-width))

         (limit (if (numberp notmuch-wash-wrap-lines-length)
                    (min notmuch-wash-wrap-lines-length
                         (window-width))
                  (window-width)))
         (fill-column (- limit
         (limit (if (numberp notmuch-wash-wrap-lines-length)
                    (min notmuch-wash-wrap-lines-length
                         (window-width))
                  (window-width)))
         (fill-column (- limit

-                        depth
+                        indent

                         ;; 2 to avoid poor interaction with
                         ;; `word-wrap'.
                         2)))
                         ;; 2 to avoid poor interaction with
                         ;; `word-wrap'.
                         2)))


@@ -365,7 +414,7 @@ for error."
          (setq patch-end (match-beginning 0)))
       (save-restriction
        (narrow-to-region patch-start patch-end)
          (setq patch-end (match-beginning 0)))
       (save-restriction
        (narrow-to-region patch-start patch-end)

-       (setq part (plist-put part :content-type "inline-patch-fake-part"))
+       (setq part (plist-put part :content-type "inline patch"))

        (setq part (plist-put part :content (buffer-string)))
        (setq part (plist-put part :id -1))
        (setq part (plist-put part :filename
        (setq part (plist-put part :content (buffer-string)))
        (setq part (plist-put part :id -1))
        (setq part (plist-put part :filename


@@ -378,3 +427,5 @@ for error."
 ;;
 
 (provide 'notmuch-wash)
 ;;
 
 (provide 'notmuch-wash)

+
+;;; notmuch-wash.el ends here