Commit a7fb4ab8 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

Make Message respect header removal instructions more

* doc/misc/message.texi (Forwarding): Document it.

* lisp/gnus/message.el (message-forward-ignored-headers): Improve
documentation.
(message-forward-included-headers): Ditto.
(message-forward-included-mime-headers): New user option.
(message-remove-ignored-headers): Use it to preserve the necessary
MIME headers.
(message-forward-make-body): Remove headers when forwarding as
MIME, too.
parent b2d30fd6
......@@ -317,6 +317,12 @@ when forwarding a message.
In non-@code{nil}, only headers that match this regexp will be kept
when forwarding a message. This can also be a list of regexps.
@item message-forward-included-mime-headers
@vindex message-forward-included-mime-headers
In non-@code{nil}, headers that match this regexp will be kept when
forwarding a message as @acronym{MIME}, but @acronym{MML} isn't used.
This can also be a list of regexps.
@item message-make-forward-subject-function
@vindex message-make-forward-subject-function
A list of functions that are called to generate a subject header for
......
......@@ -721,9 +721,11 @@ not.
---
*** Respect 'message-forward-ignored-headers' more.
Previously, this variable would not be consulted if
'message-forward-show-mml' was nil. It's now always used, except if
'message-forward-show-mml' is 'best', and we're forwarding an
encrypted/signed message.
'message-forward-show-mml' was nil and forwarding as MIME.
+++
*** New user option 'message-forward-included-mime-headers'.
This is used when forwarding messages as MIME, but not using MML.
+++
*** Message now supports the OpenPGP header.
......
......@@ -620,8 +620,8 @@ Done before generating the new subject of a forward."
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"All headers that match this regexp will be deleted when forwarding a message.
This variable is not consulted when forwarding encrypted messages
and `message-forward-show-mml' is `best'.
Also see `message-forward-included-headers' -- both variables are applied.
In addition, see `message-forward-included-mime-headers'.
This may also be a list of regexps."
:version "21.1"
......@@ -637,7 +637,14 @@ This may also be a list of regexps."
'("^From:" "^Subject:" "^Date:" "^To:" "^Cc:")
"If non-nil, delete non-matching headers when forwarding a message.
Only headers that match this regexp will be included. This
variable should be a regexp or a list of regexps."
variable should be a regexp or a list of regexps.
Also see `message-forward-ignored-headers' -- both variables are applied.
In addition, see `message-forward-included-mime-headers'.
When forwarding messages as MIME, but when
`message-forward-show-mml' results in MML not being used,
`message-forward-included-mime-headers' take precedence."
:version "27.1"
:group 'message-forwarding
:type '(repeat :value-to-internal (lambda (widget value)
......@@ -647,6 +654,24 @@ variable should be a regexp or a list of regexps."
(widget-editable-list-match widget value)))
regexp))
(defcustom message-forward-included-mime-headers
'("^Content-Type:" "^MIME-Version:" "^Content-Transfer-Encoding:")
"When forwarding as MIME, but not using MML, don't delete these headers.
Also see `message-forward-ignored-headers' and
`message-forward-ignored-headers'.
When forwarding messages as MIME, but when
`message-forward-show-mml' results in MML not being used,
`message-forward-included-mime-headers' take precedence."
:version "28.1"
:group 'message-forwarding
:type '(repeat :value-to-internal (lambda (widget value)
(custom-split-regexp-maybe value))
:match (lambda (widget value)
(or (stringp value)
(widget-editable-list-match widget value)))
regexp))
(defcustom message-ignored-cited-headers "."
"Delete these headers from the messages you yank."
:group 'message-insertion
......@@ -7617,14 +7642,28 @@ Optional DIGEST will use digest to forward."
"-------------------- End of forwarded message --------------------\n")
(message-remove-ignored-headers b e)))
(defun message-remove-ignored-headers (b e)
(defun message-remove-ignored-headers (b e &optional preserve-mime)
(when (or message-forward-ignored-headers
message-forward-included-headers)
(let ((saved-headers nil))
(save-restriction
(narrow-to-region b e)
(goto-char b)
(narrow-to-region (point)
(or (search-forward "\n\n" nil t) (point)))
;; When forwarding as MIME, preserve some MIME headers.
(when preserve-mime
(let ((headers (buffer-string)))
(with-temp-buffer
(insert headers)
(message-remove-header
(if (listp message-forward-included-mime-headers)
(mapconcat
#'identity (cons "^$" message-forward-included-mime-headers)
"\\|")
message-forward-included-mime-headers)
t nil t)
(setq saved-headers (string-lines (buffer-string) t)))))
(when message-forward-ignored-headers
(let ((ignored (if (stringp message-forward-ignored-headers)
(list message-forward-ignored-headers)
......@@ -7637,10 +7676,14 @@ Optional DIGEST will use digest to forward."
(mapconcat #'identity (cons "^$" message-forward-included-headers)
"\\|")
message-forward-included-headers)
t nil t)))))
t nil t))
;; Insert the MIME headers, if any.
(goto-char (point-max))
(forward-line -1)
(dolist (header saved-headers)
(insert header "\n"))))))
(defun message-forward-make-body-mime (forward-buffer &optional beg end
remove-headers)
(defun message-forward-make-body-mime (forward-buffer &optional beg end)
(let ((b (point)))
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
(save-restriction
......@@ -7650,8 +7693,7 @@ Optional DIGEST will use digest to forward."
(goto-char (point-min))
(when (looking-at "From ")
(replace-match "X-From-Line: "))
(when remove-headers
(message-remove-ignored-headers (point-min) (point-max)))
(message-remove-ignored-headers (point-min) (point-max) t)
(goto-char (point-max)))
(insert "<#/part>\n")
;; Consider there is no illegible text.
......@@ -7790,8 +7832,7 @@ is for the internal use."
(message-signed-or-encrypted-p)
(error t))))))
(message-forward-make-body-mml forward-buffer)
(message-forward-make-body-mime
forward-buffer nil nil (not (eq message-forward-show-mml 'best))))
(message-forward-make-body-mime forward-buffer))
(message-forward-make-body-plain forward-buffer)))
(message-position-point))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment