emacs: fix MML quoting in replies

[notmuch] / emacs / notmuch-wash.el

diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el
index 115c3bb9cc571908c9fafff569a7111e9ea0e302..56981d0635aad98913ae90e46f88f3e739fa261d 100644 (file)
--- a/emacs/notmuch-wash.el
+++ b/emacs/notmuch-wash.el
@@ -35,6 +35,9 @@
   "\\(^[[:space:]]*>.*\n\\)+"
   "Pattern to match citation lines.")
 
   "\\(^[[:space:]]*>.*\n\\)+"
   "Pattern to match citation lines.")
 

+(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.")
+

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


@@ -55,6 +58,16 @@ Can use up to one integer format parameter, i.e. %d")
   "String used to construct button text for visible citations.
 Can use up to one integer format parameter, i.e. %d")
 
   "String used to construct button text for visible citations.
 Can use up to one integer format parameter, i.e. %d")
 

+(defvar notmuch-wash-button-original-hidden-format
+  "[ %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")
+
+(defvar notmuch-wash-button-original-visible-format
+  "[ %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")
+

 (defvar notmuch-wash-signature-lines-max 12
   "Maximum length of signature that will be hidden by default.")
 
 (defvar notmuch-wash-signature-lines-max 12
   "Maximum length of signature that will be hidden by default.")
 


@@ -106,8 +119,13 @@ collapse the remaining lines into a button.")
   'help-echo "mouse-1, RET: Show signature"
   :supertype 'notmuch-wash-button-invisibility-toggle-type)
 
   'help-echo "mouse-1, RET: Show signature"
   :supertype 'notmuch-wash-button-invisibility-toggle-type)
 

+(define-button-type 'notmuch-wash-button-original-toggle-type
+  'help-echo "mouse-1, RET: Show original message"
+  :supertype 'notmuch-wash-button-invisibility-toggle-type)
+

 (defun notmuch-wash-region-isearch-show (overlay)
 (defun notmuch-wash-region-isearch-show (overlay)

-  (remove-from-invisibility-spec (overlay-get overlay 'invisible)))
+  (dolist (invis-spec (overlay-get overlay 'invisible))
+    (remove-from-invisibility-spec invis-spec)))

 
 (defun notmuch-wash-button-label (overlay)
   (let* ((type (overlay-get overlay 'type))
 
 (defun notmuch-wash-button-label (overlay)
   (let* ((type (overlay-get overlay 'type))


@@ -118,12 +136,13 @@ collapse the remaining lines into a button.")
         (lines-count (count-lines (overlay-start overlay) (overlay-end overlay))))
     (format label-format lines-count)))
 
         (lines-count (count-lines (overlay-start overlay) (overlay-end overlay))))
     (format label-format lines-count)))
 

-(defun notmuch-wash-region-to-button (beg end type prefix)
-  "Auxilary function to do the actual making of overlays and buttons
+(defun notmuch-wash-region-to-button (msg beg end type &optional prefix)
+  "Auxiliary function to do the actual making of overlays and buttons

 
 BEG and END are buffer locations. TYPE should a string, either
 
 BEG and END are buffer locations. TYPE should a string, either

-\"citation\" or \"signature\". PREFIX is some arbitrary text to
-insert before the button, probably for indentation."
+\"citation\" or \"signature\". Optional PREFIX is some arbitrary
+text to insert before the button, probably for indentation.  Note
+that PREFIX should not include a newline."

 
   ;; This uses some slightly tricky conversions between strings and
   ;; symbols because of the way the button code works. Note that
 
   ;; This uses some slightly tricky conversions between strings and
   ;; symbols because of the way the button code works. Note that


@@ -131,26 +150,38 @@ insert before the button, probably for indentation."
   ;; since the newly created symbol has no plist.
 
   (let ((overlay (make-overlay beg end))
   ;; since the newly created symbol has no plist.
 
   (let ((overlay (make-overlay beg end))

+       (message-invis-spec (plist-get msg :message-invis-spec))

        (invis-spec (make-symbol (concat "notmuch-" type "-region")))
        (button-type (intern-soft (concat "notmuch-wash-button-"
                                          type "-toggle-type"))))
     (add-to-invisibility-spec invis-spec)
        (invis-spec (make-symbol (concat "notmuch-" type "-region")))
        (button-type (intern-soft (concat "notmuch-wash-button-"
                                          type "-toggle-type"))))
     (add-to-invisibility-spec invis-spec)

-    (overlay-put overlay 'invisible invis-spec)
+    (overlay-put overlay 'invisible (list invis-spec message-invis-spec))

     (overlay-put overlay 'isearch-open-invisible #'notmuch-wash-region-isearch-show)
     (overlay-put overlay 'isearch-open-invisible #'notmuch-wash-region-isearch-show)

+    (overlay-put overlay 'priority 10)

     (overlay-put overlay 'type type)
     (goto-char (1+ end))
     (save-excursion
     (overlay-put overlay 'type type)
     (goto-char (1+ end))
     (save-excursion

-      (goto-char (1- beg))
-      (insert prefix)
-      (insert-button (notmuch-wash-button-label overlay)
+      (goto-char beg)
+      (if prefix
+         (insert-before-markers prefix))
+      (let ((button-beg (point)))
+       (insert-before-markers (notmuch-wash-button-label overlay) "\n")
+       (make-button button-beg (1- (point))

                     'invisibility-spec invis-spec
                     'overlay overlay
                     'invisibility-spec invis-spec
                     'overlay overlay

-                    :type button-type))))
+                    :type button-type)))))

 
 

-(defun notmuch-wash-excerpt-citations (depth)
+(defun notmuch-wash-excerpt-citations (msg depth)

   "Excerpt citations and up to one signature."
   (goto-char (point-min))
   (beginning-of-line)
   "Excerpt citations and up to one signature."
   (goto-char (point-min))
   (beginning-of-line)

+  (if (and (< (point) (point-max))
+          (re-search-forward notmuch-wash-original-regexp nil t))
+      (let* ((msg-start (match-beginning 0))
+            (msg-end (point-max))
+            (msg-lines (count-lines msg-start msg-end)))
+       (notmuch-wash-region-to-button
+        msg msg-start msg-end "original")))

   (while (and (< (point) (point-max))
              (re-search-forward notmuch-wash-citation-regexp nil t))
     (let* ((cite-start (match-beginning 0))
   (while (and (< (point) (point-max))
              (re-search-forward notmuch-wash-citation-regexp nil t))
     (let* ((cite-start (match-beginning 0))


@@ -166,8 +197,8 @@ insert before the button, probably for indentation."
          (goto-char cite-end)
          (forward-line (- notmuch-wash-citation-lines-suffix))
          (notmuch-wash-region-to-button
          (goto-char cite-end)
          (forward-line (- notmuch-wash-citation-lines-suffix))
          (notmuch-wash-region-to-button

-          hidden-start (point-marker)
-          "citation" "\n")))))
+          msg hidden-start (point-marker)
+          "citation")))))

   (if (and (not (eobp))
           (re-search-forward notmuch-wash-signature-regexp nil t))
       (let* ((sig-start (match-beginning 0))
   (if (and (not (eobp))
           (re-search-forward notmuch-wash-signature-regexp nil t))
       (let* ((sig-start (match-beginning 0))


@@ -180,12 +211,12 @@ insert before the button, probably for indentation."
              (set-marker sig-end-marker (point-max))
              (overlay-put (make-overlay sig-start-marker sig-end-marker) 'face 'message-cited-text)
              (notmuch-wash-region-to-button
              (set-marker sig-end-marker (point-max))
              (overlay-put (make-overlay sig-start-marker sig-end-marker) 'face 'message-cited-text)
              (notmuch-wash-region-to-button

-              sig-start-marker sig-end-marker
-              "signature" "\n"))))))
+              msg sig-start-marker sig-end-marker
+              "signature"))))))

 
 ;;
 
 
 ;;
 

-(defun notmuch-wash-elide-blank-lines (depth)
+(defun notmuch-wash-elide-blank-lines (msg depth)

   "Elide leading, trailing and successive blank lines."
 
   ;; Algorithm derived from `article-strip-multiple-blank-lines' in
   "Elide leading, trailing and successive blank lines."
 
   ;; Algorithm derived from `article-strip-multiple-blank-lines' in


@@ -213,7 +244,7 @@ insert before the button, probably for indentation."
 
 ;;
 
 
 ;;
 

-(defun notmuch-wash-tidy-citations (depth)
+(defun notmuch-wash-tidy-citations (msg depth)

   "Improve the display of cited regions of a message.
 
 Perform several transformations on the message body:
   "Improve the display of cited regions of a message.
 
 Perform several transformations on the message body:


@@ -244,7 +275,7 @@ Perform several transformations on the message body:
 
 ;;
 
 
 ;;
 

-(defun notmuch-wash-wrap-long-lines (depth)
+(defun notmuch-wash-wrap-long-lines (msg depth)

   "Wrap any long lines in the message to the width of the window.
 
 When doing so, maintaining citation leaders in the wrapped text."
   "Wrap any long lines in the message to the width of the window.
 
 When doing so, maintaining citation leaders in the wrapped text."


@@ -263,7 +294,45 @@ When doing so, maintaining citation leaders in the wrapped text."
 
 (defvar diff-file-header-re) ; From `diff-mode.el'.
 
 
 (defvar diff-file-header-re) ; From `diff-mode.el'.
 

-(defun notmuch-wash-convert-inline-patch-to-part (depth)
+(defun notmuch-wash-subject-to-filename (subject &optional maxlen)
+  "Convert a mail SUBJECT into a filename.
+
+The resulting filename is similar to the names generated by \"git
+format-patch\", without the leading patch sequence number
+\"0001-\" and \".patch\" extension. Any leading \"[PREFIX]\"
+style strings are removed prior to conversion.
+
+Optional argument MAXLEN is the maximum length of the resulting
+filename, before trimming any trailing . and - characters."
+  (let* ((s (replace-regexp-in-string "^ *\\(\\[[^]]*\\] *\\)*" "" subject))
+        (s (replace-regexp-in-string "[^A-Za-z0-9._]+" "-" s))
+        (s (replace-regexp-in-string "\\.+" "." s))
+        (s (if maxlen (substring s 0 (min (length s) maxlen)) s))
+        (s (replace-regexp-in-string "[.-]*$" "" s)))
+    s))
+
+(defun notmuch-wash-subject-to-patch-sequence-number (subject)
+  "Convert a patch mail SUBJECT into a patch sequence number.
+
+Return the patch sequence number N from the last \"[PATCH N/M]\"
+style prefix in SUBJECT, or nil if such a prefix can't be found."
+  (when (string-match
+        "^ *\\(\\[[^]]*\\] *\\)*\\[[^]]*?\\([0-9]+\\)/[0-9]+[^]]*\\].*"
+        subject)
+      (string-to-number (substring subject (match-beginning 2) (match-end 2)))))
+
+(defun notmuch-wash-subject-to-patch-filename (subject)
+  "Convert a patch mail SUBJECT into a filename.
+
+The resulting filename is similar to the names generated by \"git
+format-patch\". If the patch mail was generated and sent using
+\"git format-patch/send-email\", this should re-create the
+original filename the sender had."
+  (format "%04d-%s.patch"
+         (or (notmuch-wash-subject-to-patch-sequence-number subject) 1)
+         (notmuch-wash-subject-to-filename subject 52)))
+
+(defun notmuch-wash-convert-inline-patch-to-part (msg depth)

   "Convert an inline patch into a fake 'text/x-diff' attachment.
 
 Given that this function guesses whether a buffer includes a
   "Convert an inline patch into a fake 'text/x-diff' attachment.
 
 Given that this function guesses whether a buffer includes a


@@ -271,27 +340,96 @@ patch and then guesses the extent of the patch, there is scope
 for error."
 
   (goto-char (point-min))
 for error."
 
   (goto-char (point-min))

-  (if (re-search-forward diff-file-header-re nil t)
-      (progn
-       (beginning-of-line -1)
-       (let ((patch-start (point))
-             (patch-end (point-max))
-             part)
-         (goto-char patch-start)
-         (if (or
-              ;; Patch ends with signature.
-              (re-search-forward notmuch-wash-signature-regexp nil t)
-              ;; Patch ends with bugtraq comment.
-              (re-search-forward "^\\*\\*\\* " nil t))
-             (setq patch-end (match-beginning 0)))
-         (save-restriction
-           (narrow-to-region patch-start patch-end)
-           (setq part (plist-put part :content-type "text/x-diff"))
-           (setq part (plist-put part :content (buffer-string)))
-           (setq part (plist-put part :id -1))
-           (setq part (plist-put part :filename "inline patch"))
-           (delete-region (point-min) (point-max))
-           (notmuch-show-insert-bodypart nil part depth))))))
+  (when (re-search-forward diff-file-header-re nil t)
+    (beginning-of-line -1)
+    (let ((patch-start (point))
+         (patch-end (point-max))
+         part)
+      (goto-char patch-start)
+      (if (or
+          ;; Patch ends with signature.
+          (re-search-forward notmuch-wash-signature-regexp nil t)
+          ;; Patch ends with bugtraq comment.
+          (re-search-forward "^\\*\\*\\* " nil t))
+         (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 (buffer-string)))
+       (setq part (plist-put part :id -1))
+       (setq part (plist-put part :filename
+                             (notmuch-wash-subject-to-patch-filename
+                              (plist-get
+                               (plist-get msg :headers) :Subject))))
+       (delete-region (point-min) (point-max))
+       (notmuch-show-insert-bodypart nil part depth)))))
+
+;;
+
+;; Temporary workaround for Emacs bug #8721
+;; http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8721
+
+(defun notmuch-isearch-range-invisible (beg end)
+  "Same as `isearch-range-invisible' but with fixed Emacs bug #8721."
+  (when (/= beg end)
+    ;; Check that invisibility runs up to END.
+    (save-excursion
+      (goto-char beg)
+      (let (;; can-be-opened keeps track if we can open some overlays.
+           (can-be-opened (eq search-invisible 'open))
+           ;; the list of overlays that could be opened
+           (crt-overlays nil))
+       (when (and can-be-opened isearch-hide-immediately)
+         (isearch-close-unnecessary-overlays beg end))
+       ;; If the following character is currently invisible,
+       ;; skip all characters with that same `invisible' property value.
+       ;; Do that over and over.
+       (while (and (< (point) end) (invisible-p (point)))
+         (if (invisible-p (get-text-property (point) 'invisible))
+             (progn
+               (goto-char (next-single-property-change (point) 'invisible
+                                                       nil end))
+               ;; if text is hidden by an `invisible' text property
+               ;; we cannot open it at all.
+               (setq can-be-opened nil))
+           (when can-be-opened
+             (let ((overlays (overlays-at (point)))
+                   ov-list
+                   o
+                   invis-prop)
+               (while overlays
+                 (setq o (car overlays)
+                       invis-prop (overlay-get o 'invisible))
+                 (if (invisible-p invis-prop)
+                     (if (overlay-get o 'isearch-open-invisible)
+                         (setq ov-list (cons o ov-list))
+                       ;; We found one overlay that cannot be
+                       ;; opened, that means the whole chunk
+                       ;; cannot be opened.
+                       (setq can-be-opened nil)))
+                 (setq overlays (cdr overlays)))
+               (if can-be-opened
+                   ;; It makes sense to append to the open
+                   ;; overlays list only if we know that this is
+                   ;; t.
+                   (setq crt-overlays (append ov-list crt-overlays)))))
+           (goto-char (next-overlay-change (point)))))
+       ;; See if invisibility reaches up thru END.
+       (if (>= (point) end)
+           (if (and can-be-opened (consp crt-overlays))
+               (progn
+                 (setq isearch-opened-overlays
+                       (append isearch-opened-overlays crt-overlays))
+                 (mapc 'isearch-open-overlay-temporary crt-overlays)
+                 nil)
+             (setq isearch-hidden t)))))))
+
+(defadvice isearch-range-invisible (around notmuch-isearch-range-invisible-advice activate)
+  "Call `notmuch-isearch-range-invisible' instead of the original
+`isearch-range-invisible' when in `notmuch-show-mode' mode."
+  (if (eq major-mode 'notmuch-show-mode)
+      (setq ad-return-value (notmuch-isearch-range-invisible beg end))
+    ad-do-it))

 
 ;;
 
 
 ;;