From d21beff04fb6fe6bb1da6c4ada3093a2d204b204 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 31 Jan 2014 16:30:03 -0800 Subject: [PATCH] Allow specifying what headers to include when forwarding messages * lisp/message.el (message-remove-header): Doc fix. (message-forward-included-headers): New variable. (message-remove-ignored-headers): Use it. * texi/message.texi (Forwarding): Mention `message-forward-included-headers'. --- lisp/ChangeLog | 6 ++++++ lisp/message.el | 40 +++++++++++++++++++++++++++++++--------- texi/ChangeLog | 5 +++++ texi/message.texi | 8 +++++++- 4 files changed, 49 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d5532051a..663cb66e3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2014-02-01 Lars Ingebrigtsen + + * message.el (message-remove-header): Doc fix. + (message-forward-included-headers): New variable. + (message-remove-ignored-headers): Use it. + 2014-01-31 Dave Abrahams * gnus-sum.el (gnus-summary-open-group-with-article): New command. diff --git a/lisp/message.el b/lisp/message.el index fe5e2fbea..31af76c90 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -614,7 +614,8 @@ Done before generating the new subject of a forward." regexp)) (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" - "*All headers that match this regexp will be deleted when forwarding a message." + "*All headers that match this regexp will be deleted when forwarding a message. +This may also be a list of regexps." :version "21.1" :group 'message-forwarding :type '(repeat :value-to-internal (lambda (widget value) @@ -624,6 +625,19 @@ Done before generating the new subject of a forward." (widget-editable-list-match widget value))) regexp)) +(defcustom message-forward-included-headers nil + "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." + :version "24.5" + :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 @@ -2495,6 +2509,7 @@ With prefix-argument just set Follow-Up, don't cross-post." "Remove HEADER in the narrowed buffer. If IS-REGEXP, HEADER is a regular expression. If FIRST, only remove the first instance of the header. +If REVERSE, remove headers that doesn't match HEADER. Return the number of headers removed." (goto-char (point-min)) (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":"))) @@ -7418,17 +7433,25 @@ Optional DIGEST will use digest to forward." (message-remove-ignored-headers b e))) (defun message-remove-ignored-headers (b e) - (when message-forward-ignored-headers + (when (or message-forward-ignored-headers + message-forward-included-headers) (save-restriction (narrow-to-region b e) (goto-char b) (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point))) - (let ((ignored (if (stringp message-forward-ignored-headers) - (list message-forward-ignored-headers) - message-forward-ignored-headers))) - (dolist (elem ignored) - (message-remove-header elem t)))))) + (when message-forward-ignored-headers + (let ((ignored (if (stringp message-forward-ignored-headers) + (list message-forward-ignored-headers) + message-forward-ignored-headers))) + (dolist (elem ignored) + (message-remove-header elem t)))) + (when message-forward-included-headers + (message-remove-header + (if (listp message-forward-included-headers) + (regexp-opt message-forward-included-headers) + message-forward-included-headers) + t nil t))))) (defun message-forward-make-body-mime (forward-buffer &optional beg end) (let ((b (point))) @@ -7476,8 +7499,7 @@ Optional DIGEST will use digest to forward." (goto-char (point-max)))) (setq e (point)) (insert "<#/mml>\n") - (when (and (not message-forward-decoded-p) - message-forward-ignored-headers) + (when (not message-forward-decoded-p) (message-remove-ignored-headers b e)))) (defun message-forward-make-body-digest-plain (forward-buffer) diff --git a/texi/ChangeLog b/texi/ChangeLog index 7dcea9983..0f5e01913 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +2014-02-01 Lars Ingebrigtsen + + * message.texi (Forwarding): Mention + `message-forward-included-headers'. + 2014-01-31 Lars Ingebrigtsen * gnus.texi: w3 is no longer supported by Gnus. diff --git a/texi/message.texi b/texi/message.texi index 24cea1deb..0007d14dd 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -310,7 +310,13 @@ news. @table @code @item message-forward-ignored-headers @vindex message-forward-ignored-headers -All headers that match this regexp will be deleted when forwarding a message. +In non-@code{nil}, all headers that match this regexp will be deleted +when forwarding a message. + +@item message-forward-included-headers +@vindex message-forward-included-headers +In non-@code{nil}, only headers that match this regexp will be kept +when forwarding a message. @item message-make-forward-subject-function @vindex message-make-forward-subject-function -- 2.25.1