procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Little improvements in rmail.el. Recognize encryped override headers.

Browse source 
* 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.
This commit is contained in:
Richard Stallman 2021-05-11 22:38:21 -04:00
parent 19d0cf5484
commit 42596bdf4b
1 changed files with 63 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

91
lisp/mail/rmail.el
View file

@ -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.