summaryrefslogtreecommitdiff
path: root/lisp/mail/rmail.el
diff options
context:
space:
mode:
authorRichard Stallman <rms@gnu.org>2021-05-11 22:38:21 -0400
committerRichard Stallman <rms@gnu.org>2021-05-11 22:38:21 -0400
commit42596bdf4be2702c295afd55ca520dc230950509 (patch)
tree9d3502693f981b2cea2e78362f90e688f2441865 /lisp/mail/rmail.el
parent19d0cf5484ca8e4726b842b11de8cfc7843503e2 (diff)
downloademacs-42596bdf4be2702c295afd55ca520dc230950509.tar.gz
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.
Diffstat (limited to 'lisp/mail/rmail.el')
-rw-r--r--lisp/mail/rmail.el91
1 files changed, 63 insertions, 28 deletions
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.