emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 42596bd 2/6: Little improvements in rmail.el. Recognize encryped


From: Richard M. Stallman
Subject: master 42596bd 2/6: Little improvements in rmail.el. Recognize encryped override headers.
Date: Tue, 11 May 2021 23:09:48 -0400 (EDT)

branch: master
commit 42596bdf4be2702c295afd55ca520dc230950509
Author: Richard Stallman <rms@gnu.org>
Commit: Richard Stallman <rms@gnu.org>

    Little improvements in rmail.el.  Recognize encryped override headers.
    
    * lisp/mail/rmail.el (rmail-simplified-subject): Delete `[External] :'.
    (rmail-reply): In encrypted message, search for other header fields
            inside the encrypted part, and use them instead of the real header.
    (rmail-epa-decrypt): Don't set MIME unless it's Rmail mode.
---
 lisp/mail/rmail.el | 91 +++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 63 insertions(+), 28 deletions(-)

diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 455ae7f..f60581a 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -3357,6 +3357,11 @@ removing prefixes such as Re:, Fwd: and so on and 
mailing list
 tags such as [tag]."
   (let ((subject (or (rmail-get-header "Subject" msgnum) ""))
        (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}\u00a0*[::]\\|\\[[^]]+]\\)[ 
\t\n]+\\)*"))
+    ;; Debbugs sometimes adds `[External] :'; if that happened,
+    ;; delete everything up thru there.  Empirically, that deletion makes
+    ;; the Subject match the other messages in the thread.
+    (if (string-match "[[]external][ \t\n]*:" subject)
+        (setq subject (substring subject (match-end 0))))
     (setq subject (rfc2047-decode-string subject))
     (setq subject (replace-regexp-in-string regexp "" subject))
     (replace-regexp-in-string "[ \t\n]+" " " subject)))
@@ -3762,32 +3767,61 @@ use \\[mail-yank-original] to yank the original message 
into it."
     (rmail-apply-in-message
      rmail-current-message
      (lambda ()
-       (search-forward "\n\n" nil 'move)
-       (narrow-to-region (point-min) (point))
-       (setq from (mail-fetch-field "from")
-            reply-to (or (mail-fetch-field "mail-reply-to" nil t)
-                         (mail-fetch-field "reply-to" nil t)
-                         from)
-            subject (mail-fetch-field "subject")
-            date (mail-fetch-field "date")
-            message-id (mail-fetch-field "message-id")
-            references (mail-fetch-field "references" nil nil t)
-            ;; Bug#512.  It's inappropriate to reply to these addresses.
-            ;;resent-reply-to (mail-fetch-field "resent-reply-to" nil t)
-            ;;resent-cc (and (not just-sender)
-            ;;             (mail-fetch-field "resent-cc" nil t))
-            ;;resent-to (or (mail-fetch-field "resent-to" nil t) "")
-            ;;resent-subject (mail-fetch-field "resent-subject")
-            ;;resent-date (mail-fetch-field "resent-date")
-            ;;resent-message-id (mail-fetch-field "resent-message-id")
-            )
-       (unless just-sender
-        (if (mail-fetch-field "mail-followup-to" nil t)
-            ;; If this header field is present, use it instead of the
-            ;; To and Cc fields.
-            (setq to (mail-fetch-field "mail-followup-to" nil t))
-          (setq cc (or (mail-fetch-field "cc" nil t) "")
-                to (or (mail-fetch-field "to" nil t) ""))))))
+       (let ((beg (point-min)) (end (point-max))
+             subheader)
+         ;; Find the message's real header.
+         (search-forward "\n\n" nil 'move)
+         (narrow-to-region (point-min) (point))
+
+         (goto-char (point-min))
+
+         ;; If this is an encrypted message, search for other header fields
+         ;; inside the encrypted part, and use them instead of the real header.
+
+         ;; First, find a From: field after a plausible section start.
+         (when (and (search-forward "\nContent-Type: multipart/encrypted;\n" 
nil t)
+                    (save-restriction
+                      (narrow-to-region (point-min) end)
+                      (and (search-forward "\nFrom: " nil t)
+                           (setq subheader (point)))))
+           ;; We found one, so widen up to end of message and go there.
+           (narrow-to-region (point-min) end)
+           (goto-char subheader)
+
+           ;; Find the start of the inner header.
+           (search-backward "\n--")
+           (forward-line 2)
+
+           ;; Find the end of it.
+           (let ((subheader-start (point)))
+             (goto-char subheader)
+             (search-forward "\n\n" nil 'move)
+             (narrow-to-region subheader-start (point))))
+
+         (setq from (mail-fetch-field "from")
+               reply-to (or (mail-fetch-field "mail-reply-to" nil t)
+                            (mail-fetch-field "reply-to" nil t)
+                            from)
+               subject (mail-fetch-field "subject")
+               date (mail-fetch-field "date")
+               message-id (mail-fetch-field "message-id")
+               references (mail-fetch-field "references" nil nil t)
+               ;; Bug#512.  It's inappropriate to reply to these addresses.
+               ;;resent-reply-to (mail-fetch-field "resent-reply-to" nil t)
+               ;;resent-cc (and (not just-sender)
+               ;;          (mail-fetch-field "resent-cc" nil t))
+               ;;resent-to (or (mail-fetch-field "resent-to" nil t) "")
+               ;;resent-subject (mail-fetch-field "resent-subject")
+               ;;resent-date (mail-fetch-field "resent-date")
+               ;;resent-message-id (mail-fetch-field "resent-message-id")
+               )
+         (unless just-sender
+           (if (mail-fetch-field "mail-followup-to" nil t)
+               ;; If this header field is present, use it instead of the
+               ;; To and Cc fields.
+               (setq to (mail-fetch-field "mail-followup-to" nil t))
+             (setq cc (or (mail-fetch-field "cc" nil t) "")
+                   to (or (mail-fetch-field "to" nil t) "")))))))
     ;; Merge the resent-to and resent-cc into the to and cc.
     ;; Bug#512.  It's inappropriate to reply to these addresses.
     ;;(if (and resent-to (not (equal resent-to "")))
@@ -4585,8 +4619,9 @@ Argument MIME is non-nil if this is a mime message."
   ;; change it in one of the calls to `epa-decrypt-region'.
 
   (save-excursion
-    (let (decrypts (mime (rmail-mime-message-p))
-                   mime-disabled)
+    (let (decrypts
+          (mime (and (eq major-mode 'rmail-mode) (rmail-mime-message-p)))
+          mime-disabled)
       (goto-char (point-min))
 
       ;; Turn off mime processing.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]