diff options
| -rw-r--r-- | doc/misc/message.texi | 6 | ||||
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 63 |
3 files changed, 63 insertions, 14 deletions
diff --git a/doc/misc/message.texi b/doc/misc/message.texi index f2680b4a797..be6c9a419b2 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -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. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index b22b4543e71..2bcd367638f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -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)) |