Silence the byte compiler

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index d7973c5..32cfe3b 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -28,9 +28,6 @@
 
 ;;; Code:
 
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 (eval-when-compile
   (require 'cl))
 
@@ -50,6 +47,7 @@
 (require 'mml)
 (require 'rfc822)
 (require 'format-spec)
+(require 'dired)
 
 (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
 
@@ -614,7 +612,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 +623,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 +2507,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) ":")))
@@ -4143,11 +4156,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.
@@ -7258,7 +7272,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:
 
@@ -7417,17 +7431,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)))
@@ -7475,8 +7497,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)
@@ -7971,8 +7992,9 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed."
 
 (defun message-tab ()
   "Complete names according to `message-completion-alist'.
-Execute function specified by `message-tab-body-function' when not in
-those headers."
+Execute function specified by `message-tab-body-function' when
+not in those headers.  If that variable is nil, indent with the
+regular text mode tabbing command."
   (interactive)
   (cond
    ((if (and (boundp 'completion-fail-discreetly)
@@ -8464,6 +8486,17 @@ Used in `message-simplify-recipients'."
         (message-fetch-field hdr) t))
       ", "))))
 
+;;; multipart/related and HTML support.
+
+(defun message-make-html-message-with-image-files (files)
+  (interactive (list (dired-get-marked-files nil current-prefix-arg)))
+  (message-mail)
+  (message-goto-body)
+  (insert "<#part type=text/html>\n\n")
+  (dolist (file files)
+    (insert (format "<img src=%S>\n\n" file)))
+  (message-goto-to))
+
 (when (featurep 'xemacs)
   (require 'messagexmas)
   (message-xmas-redefine))