Allow using `gnus-parameters' while splitting mail

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 4a7c2ab..31af76c 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,6 +1,6 @@
 ;;; message.el --- composing mail and news messages
 
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2014 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
@@ -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
@@ -972,6 +986,8 @@ the signature is inserted."
     (set-keymap-parent map minibuffer-local-map)
     map)
   "Keymap for `message-read-from-minibuffer'."
+  ;; FIXME improve type.
+  :type '(restricted-sexp :match-alternatives (symbolp keymapp))
   :version "22.1"
   :group 'message-various)
 
@@ -2493,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) ":")))
@@ -4141,11 +4158,12 @@ Instead, just auto-save the buffer and then bury it."
 
 (defun message-bury (buffer)
   "Bury this mail BUFFER."
+  ;; Note that this is not quite the same as (bury-buffer buffer),
+  ;; since bury-buffer does extra stuff with a nil argument.
+  ;; Eg http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg00539.html
+  (with-current-buffer buffer (bury-buffer))
   (if message-return-action
-      (progn
-        (bury-buffer buffer)
-        (apply (car message-return-action) (cdr message-return-action)))
-    (with-current-buffer buffer (bury-buffer))))
+      (apply (car message-return-action) (cdr message-return-action))))
 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.
@@ -7256,7 +7274,7 @@ header line with the old Message-ID."
           (let ((buffer-read-only nil))
             (erase-buffer)
             (insert-file-contents file-name nil)))
-         (t (error "message-recover cancelled")))))
+         (t (error "message-recover canceled")))))
 
 ;;; Washing Subject:
 
@@ -7415,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)))
@@ -7473,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)