emacs: fix MML quoting in replies

[notmuch] / emacs / notmuch-wash.el

diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el
index bf0a3544d0cf82f38d256afac9a852901722ff43..56981d0635aad98913ae90e46f88f3e739fa261d 100644 (file)
--- a/emacs/notmuch-wash.el
+++ b/emacs/notmuch-wash.el
@@ -23,7 +23,7 @@
 
 (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))

 
 ;;
 
 
 ;;
 


@@ -35,16 +35,39 @@
   "\\(^[[:space:]]*>.*\n\\)+"
   "Pattern to match citation lines.")
 
   "\\(^[[:space:]]*>.*\n\\)+"
   "Pattern to match citation lines.")
 

-(defvar notmuch-wash-signature-button-format
-  "[ %d-line signature. Click/Enter to toggle visibility. ]"
+(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.
 Can use up to one integer format parameter, i.e. %d")
 
   "String used to construct button text for hidden signatures.
 Can use up to one integer format parameter, i.e. %d")
 

-(defvar notmuch-wash-citation-button-format
-  "[ %d more citation lines. Click/Enter to toggle visibility. ]"
+(defvar notmuch-wash-button-signature-visible-format
+  "[ %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")
+
+(defvar notmuch-wash-button-citation-hidden-format
+  "[ %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")
 
   "String used to construct button text for hidden citations.
 Can use up to one integer format parameter, i.e. %d")
 

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


@@ -69,6 +92,17 @@ collapse the remaining lines into a button.")
     (if (invisible-p invis-spec)
        (remove-from-invisibility-spec invis-spec)
       (add-to-invisibility-spec invis-spec)))
     (if (invisible-p invis-spec)
        (remove-from-invisibility-spec invis-spec)
       (add-to-invisibility-spec invis-spec)))

+  (let* ((new-start (button-start cite-button))
+        (overlay (button-get cite-button 'overlay))
+        (button-label (notmuch-wash-button-label overlay))
+        (old-point (point))
+        (inhibit-read-only t))
+    (goto-char new-start)
+    (insert button-label)
+    (let ((old-end (button-end cite-button)))
+      (move-overlay cite-button new-start (point))
+      (delete-region (point) old-end))
+    (goto-char (min old-point (1- (button-end cite-button)))))

   (force-window-update)
   (redisplay t))
 
   (force-window-update)
   (redisplay t))
 


@@ -85,16 +119,30 @@ 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-region-to-button (beg end type prefix button-text)
-  "Auxilary function to do the actual making of overlays and buttons
+(defun notmuch-wash-button-label (overlay)
+  (let* ((type (overlay-get overlay 'type))
+        (invis-spec (overlay-get overlay 'invisible))
+        (state (if (invisible-p invis-spec) "hidden" "visible"))
+        (label-format (symbol-value (intern-soft (concat "notmuch-wash-button-"
+                                                         type "-" state "-format"))))
+        (lines-count (count-lines (overlay-start overlay) (overlay-end overlay))))
+    (format label-format lines-count)))
+
+(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.  BUTTON-TEXT
-is what to put on the button."
+\"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


@@ -102,30 +150,44 @@ is what to put on the button."
   ;; 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
     (goto-char (1+ end))
     (save-excursion

-      (goto-char (1- beg))
-      (insert prefix)
-      (insert-button button-text
+      (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
                     'invisibility-spec invis-spec

-                    :type button-type))))
+                    'overlay overlay
+                    :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))
           (cite-end (match-end 0))
           (cite-lines (count-lines cite-start cite-end)))
   (while (and (< (point) (point-max))
              (re-search-forward notmuch-wash-citation-regexp nil t))
     (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-face)
+      (overlay-put (make-overlay cite-start cite-end) 'face 'message-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))


@@ -135,31 +197,26 @@ is what to put on the button."
          (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"
-          (format notmuch-wash-citation-button-format
-                  (- cite-lines
-                     notmuch-wash-citation-lines-prefix
-                     notmuch-wash-citation-lines-suffix)))))))
+          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))
             (sig-end (match-end 0))
   (if (and (not (eobp))
           (re-search-forward notmuch-wash-signature-regexp nil t))
       (let* ((sig-start (match-beginning 0))
             (sig-end (match-end 0))

-            (sig-lines (1- (count-lines sig-start (point-max)))))
+            (sig-lines (count-lines sig-start (point-max))))

        (if (<= sig-lines notmuch-wash-signature-lines-max)
            (let ((sig-start-marker (make-marker))
                  (sig-end-marker (make-marker)))
              (set-marker sig-start-marker sig-start)
              (set-marker sig-end-marker (point-max))
        (if (<= sig-lines notmuch-wash-signature-lines-max)
            (let ((sig-start-marker (make-marker))
                  (sig-end-marker (make-marker)))
              (set-marker sig-start-marker sig-start)
              (set-marker sig-end-marker (point-max))

-             (overlay-put (make-overlay sig-start-marker sig-end-marker) 'face 'message-cited-text-face)
+             (overlay-put (make-overlay sig-start-marker sig-end-marker) 'face 'message-cited-text)

              (notmuch-wash-region-to-button
              (notmuch-wash-region-to-button

-              sig-start-marker sig-end-marker
-              "signature" "\n"
-              (format notmuch-wash-signature-button-format sig-lines)))))))
+              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


@@ -187,10 +244,10 @@ is what to put on the button."
 
 ;;
 
 
 ;;
 

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

   "Improve the display of cited regions of a message.
 
   "Improve the display of cited regions of a message.
 

-Perform four transformations on the message body:
+Perform several transformations on the message body:

 
 - Remove lines of repeated citation leaders with no other
   content,
 
 - Remove lines of repeated citation leaders with no other
   content,


@@ -218,7 +275,7 @@ Perform four 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."


@@ -237,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


@@ -245,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))

 
 ;;
 
 
 ;;