From: Richard Stallman Date: Wed, 12 May 2021 02:38:21 +0000 (-0400) Subject: Little improvements in rmail.el. Recognize encryped override headers. X-Git-Tag: emacs-28.0.90~2511 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=42596bdf4be2702c295afd55ca520dc230950509;p=emacs.git 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. --- diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 455ae7feefc..f60581a11c6 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.