gnus-registry.el: Correct function argument order.

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index f32981f..2bc8116 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,6 +1,6 @@
 ;;; message.el --- composing mail and news messages
 
 ;;; message.el --- composing mail and news messages
 

-;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news


@@ -28,9 +28,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))

 (eval-when-compile
   (require 'cl))
 
 (eval-when-compile
   (require 'cl))
 


@@ -50,6 +47,7 @@
 (require 'mml)
 (require 'rfc822)
 (require 'format-spec)
 (require 'mml)
 (require 'rfc822)
 (require 'format-spec)

+(require 'dired)

 
 (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
 
 
 (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
 


@@ -268,7 +266,7 @@ This is a list of regexps and regexp matches."
   :type 'sexp)
 
 (defcustom message-ignored-news-headers
   :type 'sexp)
 
 (defcustom message-ignored-news-headers

-  "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
+  "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:\\|^X-Gnus-Delayed:"

   "*Regexp of headers to be removed unconditionally before posting."
   :group 'message-news
   :group 'message-headers
   "*Regexp of headers to be removed unconditionally before posting."
   :group 'message-news
   :group 'message-headers


@@ -535,7 +533,7 @@ If t, use `message-user-organization-file'."
        (setq orgfile f)))
     orgfile)
   "*Local news organization file."
        (setq orgfile f)))
     orgfile)
   "*Local news organization file."

-  :type 'file
+  :type '(choice (const nil) file)

   :link '(custom-manual "(message)News Headers")
   :group 'message-headers)
 
   :link '(custom-manual "(message)News Headers")
   :group 'message-headers)
 


@@ -600,8 +598,10 @@ Done before generating the new subject of a forward."
   ;; comes back to you (e.g. a mailing-list to which you subscribe, in which
   ;; case you may be removed from the list on the grounds that mail to you
   ;; bounced with a "mailing loop" error).
   ;; comes back to you (e.g. a mailing-list to which you subscribe, in which
   ;; case you may be removed from the list on the grounds that mail to you
   ;; bounced with a "mailing loop" error).

-  "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:"
+  "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\
+\\|^X-Content-Length:\\|^X-UIDL:"

   "*All headers that match this regexp will be deleted when resending a message."
   "*All headers that match this regexp will be deleted when resending a message."

+  :version "24.4"

   :group 'message-interface
   :link '(custom-manual "(message)Resending")
   :type '(repeat :value-to-internal (lambda (widget value)
   :group 'message-interface
   :link '(custom-manual "(message)Resending")
   :type '(repeat :value-to-internal (lambda (widget value)


@@ -612,7 +612,8 @@ Done before generating the new subject of a forward."
                 regexp))
 
 (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
                 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)
   :version "21.1"
   :group 'message-forwarding
   :type '(repeat :value-to-internal (lambda (widget value)


@@ -622,6 +623,19 @@ Done before generating the new subject of a forward."
                              (widget-editable-list-match widget value)))
                 regexp))
 
                              (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 "25.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
 (defcustom message-ignored-cited-headers "."
   "*Delete these headers from the messages you yank."
   :group 'message-insertion


@@ -970,6 +984,8 @@ the signature is inserted."
     (set-keymap-parent map minibuffer-local-map)
     map)
   "Keymap for `message-read-from-minibuffer'."
     (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)
 
   :version "22.1"
   :group 'message-various)
 


@@ -994,20 +1010,24 @@ configuration.  See the variable `gnus-cite-attribution-suffix'."
 (defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
   "Format of the \"Whomever writes:\" line.
 
 (defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
   "Format of the \"Whomever writes:\" line.
 

-The string is formatted using `format-spec'.  The following
-constructs are replaced:
+The string is formatted using `format-spec'.  The following constructs
+are replaced:

 
   %f   The full From, e.g. \"John Doe <john.doe@example.invalid>\".
   %n   The mail address, e.g. \"john.doe@example.invalid\".
   %N   The real name if present, e.g.: \"John Doe\", else fall
        back to the mail address.
 
   %f   The full From, e.g. \"John Doe <john.doe@example.invalid>\".
   %n   The mail address, e.g. \"john.doe@example.invalid\".
   %N   The real name if present, e.g.: \"John Doe\", else fall
        back to the mail address.

-  %F   The first name if present, e.g.: \"John\".
+  %F   The first name if present, e.g.: \"John\", else fall
+       back to the mail address.

   %L   The last name if present, e.g.: \"Doe\".
   %L   The last name if present, e.g.: \"Doe\".

+  %Z, %z   The time zone in the numeric form, e.g.:\"+0000\".

 
 All other format specifiers are passed to `format-time-string'
 
 All other format specifiers are passed to `format-time-string'

-which is called using the date from the article your replying to.
-Extracting the first (%F) and last name (%L) is done
-heuristically, so you should always check it yourself.
+which is called using the date from the article your replying to, but
+the date in the formatted string will be expressed in the author's
+time zone as much as possible.
+Extracting the first (%F) and last name (%L) is done heuristically,
+so you should always check it yourself.

 
 Please also read the note in the documentation of
 `message-citation-line-function'."
 
 Please also read the note in the documentation of
 `message-citation-line-function'."


@@ -1140,14 +1160,14 @@ e.g. using `gnus-posting-styles':
 
   (eval (set (make-local-variable 'message-cite-reply-position) 'above))"
   :version "24.1"
 
   (eval (set (make-local-variable 'message-cite-reply-position) 'above))"
   :version "24.1"

-  :type '(choice (const :tag "Reply inline" 'traditional)
-                (const :tag "Reply above" 'above)
-                (const :tag "Reply below" 'below))
+  :type '(choice (const :tag "Reply inline" traditional)
+                (const :tag "Reply above" above)
+                (const :tag "Reply below" below))

   :group 'message-insertion)
 
 (defcustom message-cite-style nil
   "*The overall style to be used when yanking cited text.
   :group 'message-insertion)
 
 (defcustom message-cite-style nil
   "*The overall style to be used when yanking cited text.

-Value is either `nil' (no variable overrides) or a let-style list
+Value is either nil (no variable overrides) or a let-style list

 of pairs (VARIABLE VALUE) that will be bound in
 `message-yank-original' to do the quoting.
 
 of pairs (VARIABLE VALUE) that will be bound in
 `message-yank-original' to do the quoting.
 


@@ -1376,11 +1396,11 @@ If nil, you might be asked to input the charset."
   :type 'symbol)
 
 (defcustom message-dont-reply-to-names
   :type 'symbol)
 
 (defcustom message-dont-reply-to-names

-  (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
+  (and (boundp 'mail-dont-reply-to-names) mail-dont-reply-to-names)

   "*Addresses to prune when doing wide replies.
 This can be a regexp or a list of regexps.  Also, a value of nil means
 exclude your own user name only."
   "*Addresses to prune when doing wide replies.
 This can be a regexp or a list of regexps.  Also, a value of nil means
 exclude your own user name only."

-  :version "21.1"
+  :version "24.3"

   :group 'message
   :link '(custom-manual "(message)Wide Reply")
   :type '(choice (const :tag "Yourself" nil)
   :group 'message
   :link '(custom-manual "(message)Wide Reply")
   :type '(choice (const :tag "Yourself" nil)


@@ -1781,13 +1801,20 @@ no, only reply back to the author."
   :type '(radio (const :format "%v  " nil)
                (string :format "FQDN: %v")))
 
   :type '(radio (const :format "%v  " nil)
                (string :format "FQDN: %v")))
 

-(defcustom message-use-idna (and (condition-case nil (require 'idna)
-                                  (file-error))
-                                (mm-coding-system-p 'utf-8)
-                                (executable-find idna-program)
-                                (string= (idna-to-ascii "räksmörgås")
-                                         "xn--rksmrgs-5wao1o")
-                                t)
+(defcustom message-use-idna
+  (and (or (mm-coding-system-p 'utf-8)
+          (condition-case nil
+              (let (mucs-ignore-version-incompatibilities)
+                (require 'un-define))
+            (error)))
+       (condition-case nil
+          (require 'idna)
+        (file-error)
+        (invalid-operation))
+       idna-program
+       (executable-find idna-program)
+       (string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o")
+       t)

   "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
 GNU Libidn, and in particular the elisp package \"idna.el\" and
 the external program \"idn\", must be installed for this
   "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
 GNU Libidn, and in particular the elisp package \"idna.el\" and
 the external program \"idn\", must be installed for this


@@ -1944,14 +1971,52 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
          "cat\\|com\\|coop\\|edu\\|gov\\|"
          "info\\|int\\|jobs\\|"
          "mil\\|mobi\\|museum\\|name\\|net\\|"
          "cat\\|com\\|coop\\|edu\\|gov\\|"
          "info\\|int\\|jobs\\|"
          "mil\\|mobi\\|museum\\|name\\|net\\|"

-         "org\\|pro\\|tel\\|travel\\|uucp\\)")
+         "org\\|pro\\|tel\\|travel\\|uucp\\|"
+          ;; ICANN-era generic top-level domains
+          "academy\\|actor\\|agency\\|airforce\\|archi\\|associates\\|axa\\|"
+          "bar\\|bargains\\|bayern\\|beer\\|berlin\\|best\\|bid\\|bike\\|"
+          "biz\\|black\\|blackfriday\\|blue\\|boutique\\|build\\|builders\\|"
+          "buzz\\|cab\\|camera\\|camp\\|capital\\|cards\\|care\\|career\\|"
+          "careers\\|cash\\|catering\\|center\\|ceo\\|cheap\\|christmas\\|"
+          "church\\|citic\\|cleaning\\|clinic\\|clothing\\|club\\|codes\\|"
+          "coffee\\|college\\|cologne\\|com\\|community\\|company\\|computer\\|"
+          "construction\\|contractors\\|cooking\\|cool\\|country\\|creditcard\\|"
+          "cruises\\|dance\\|dating\\|democrat\\|dental\\|desi\\|design\\|"
+          "diamonds\\|directory\\|discount\\|domains\\|education\\|email\\|"
+          "engineering\\|enterprises\\|equipment\\|estate\\|eus\\|events\\|"
+          "exchange\\|expert\\|exposed\\|fail\\|farm\\|feedback\\|finance\\|"
+          "financial\\|fish\\|fishing\\|fitness\\|flights\\|florist\\|foo\\|"
+          "foundation\\|frogans\\|fund\\|furniture\\|futbol\\|gal\\|"
+          "gallery\\|gift\\|glass\\|globo\\|gmo\\|gop\\|graphics\\|gratis\\|"
+          "gripe\\|guide\\|guitars\\|guru\\|hamburg\\|haus\\|hiphop\\|"
+          "holdings\\|holiday\\|homes\\|horse\\|house\\|immobilien\\|"
+          "industries\\|info\\|ink\\|institute\\|insure\\|international\\|"
+          "investments\\|jetzt\\|juegos\\|kaufen\\|kim\\|kitchen\\|kiwi\\|"
+          "koeln\\|kred\\|land\\|lat\\|latino\\|lease\\|life\\|lighting\\|"
+          "limited\\|limo\\|link\\|loans\\|london\\|luxe\\|luxury\\|"
+          "management\\|mango\\|marketing\\|media\\|meet\\|menu\\|miami\\|"
+          "moda\\|moe\\|monash\\|moscow\\|motorcycles\\|nagoya\\|name\\|"
+          "net\\|neustar\\|ninja\\|nyc\\|okinawa\\|onl\\|org\\|paris\\|"
+          "partners\\|parts\\|photo\\|photography\\|photos\\|pics\\|"
+          "pictures\\|pink\\|plumbing\\|pro\\|productions\\|properties\\|"
+          "pub\\|qpon\\|quebec\\|recipes\\|red\\|reisen\\|ren\\|rentals\\|"
+          "repair\\|report\\|rest\\|reviews\\|rich\\|rocks\\|rodeo\\|"
+          "ruhr\\|ryukyu\\|saarland\\|schule\\|scot\\|services\\|sexy\\|"
+          "shiksha\\|shoes\\|singles\\|social\\|sohu\\|solar\\|solutions\\|"
+          "soy\\|supplies\\|supply\\|support\\|surgery\\|systems\\|tattoo\\|"
+          "tax\\|technology\\|tienda\\|tips\\|today\\|tokyo\\|tools\\|"
+          "town\\|toys\\|trade\\|training\\|university\\|uno\\|vacations\\|"
+          "vegas\\|ventures\\|viajes\\|villas\\|vision\\|vodka\\|vote\\|"
+          "voting\\|voto\\|voyage\\|wang\\|watch\\|webcam\\|wed\\|wien\\|"
+          "wiki\\|works\\|wtc\\|wtf\\|xyz\\|yachts\\|yokohama\\|you\\|"
+          "zone\\)")

   ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
   ;; http://en.wikipedia.org/wiki/GTLD
   ;; `approved, but not yet in operation': .xxx
   ;; "dead" nato bitnet uucp
   "Regular expression that matches a valid FQDN."
   ;; see also: gnus-button-valid-fqdn-regexp
   ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
   ;; http://en.wikipedia.org/wiki/GTLD
   ;; `approved, but not yet in operation': .xxx
   ;; "dead" nato bitnet uucp
   "Regular expression that matches a valid FQDN."
   ;; see also: gnus-button-valid-fqdn-regexp

-  :version "22.1"
+  :version "25.1"

   :group 'message-headers
   :type 'regexp)
 
   :group 'message-headers
   :type 'regexp)
 


@@ -1977,10 +2042,13 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 (autoload 'nndraft-request-associate-buffer "nndraft")
 (autoload 'nndraft-request-expire-articles "nndraft")
 (autoload 'nnvirtual-find-group-art "nnvirtual")
 (autoload 'nndraft-request-associate-buffer "nndraft")
 (autoload 'nndraft-request-expire-articles "nndraft")
 (autoload 'nnvirtual-find-group-art "nnvirtual")

-(autoload 'rmail-dont-reply-to "mail-utils")

 (autoload 'rmail-msg-is-pruned "rmail")
 (autoload 'rmail-output "rmailout")
 
 (autoload 'rmail-msg-is-pruned "rmail")
 (autoload 'rmail-output "rmailout")
 

+;; Emacs < 24.1 do not have mail-dont-reply-to
+(unless (fboundp 'mail-dont-reply-to)
+  (defalias 'mail-dont-reply-to 'rmail-dont-reply-to))
+

 \f
 
 ;;;
 \f
 
 ;;;


@@ -2286,7 +2354,7 @@ Leading \"Re: \" is not stripped by this function.  Use the function
                   ((not (string-match
                          (concat "^[ \t]*"
                                  (regexp-quote new-subject)
                   ((not (string-match
                          (concat "^[ \t]*"
                                  (regexp-quote new-subject)

-                                 " \t]*$")
+                                 "[ \t]*$")

                          old-subject))  ; yes, it really is a new subject
                    ;; delete eventual Re: prefix
                    (setq old-subject
                          old-subject))  ; yes, it really is a new subject
                    ;; delete eventual Re: prefix
                    (setq old-subject


@@ -2488,6 +2556,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.
   "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) ":")))
 Return the number of headers removed."
   (goto-char (point-min))
   (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":")))


@@ -2647,7 +2716,7 @@ Point is left at the beginning of the narrowed-to region."
   (interactive)
   (let ((start (point)))
     (message-skip-to-next-address)
   (interactive)
   (let ((start (point)))
     (message-skip-to-next-address)

-    (kill-region start (point))))
+    (kill-region start (if (bolp) (1- (point)) (point)))))

 
 
 (autoload 'Info-goto-node "info")
 
 
 (autoload 'Info-goto-node "info")


@@ -2939,6 +3008,30 @@ See also `message-forbidden-properties'."
 
 (autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
 
 
 (autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
 

+(defvar message-smileys '(":-)" ":)"
+                          ":-(" ":("
+                          ";-)" ";)")
+  "A list of recognized smiley faces in `message-mode'.")
+
+(defun message--syntax-propertize (beg end)
+  "Syntax-propertize certain message text specially."
+  (let ((citation-regexp (concat "^" message-cite-prefix-regexp ".*$"))
+        (smiley-regexp (regexp-opt message-smileys)))
+    (goto-char beg)
+    (while (search-forward-regexp citation-regexp
+                                  end 'noerror)
+      (let ((start (match-beginning 0))
+            (end (match-end 0)))
+        (add-text-properties start (1+ start)
+                             `(syntax-table ,(string-to-syntax "<")))
+        (add-text-properties end (min (1+ end) (point-max))
+                             `(syntax-table ,(string-to-syntax ">")))))
+    (goto-char beg)
+    (while (search-forward-regexp smiley-regexp
+            end 'noerror)
+      (add-text-properties (match-beginning 0) (match-end 0)
+                           `(syntax-table ,(string-to-syntax "."))))))
+

 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"
   "Major mode for editing mail and news to be sent.
 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"
   "Major mode for editing mail and news to be sent.


@@ -2978,7 +3071,6 @@ C-c M-n  `message-insert-disposition-notification-to'  (request receipt).
 C-c M-m  `message-mark-inserted-region' (mark region with enclosing tags).
 C-c M-f  `message-mark-insert-file' (insert file marked with enclosing tags).
 M-RET    `message-newline-and-reformat' (break the line and reformat)."
 C-c M-m  `message-mark-inserted-region' (mark region with enclosing tags).
 C-c M-f  `message-mark-insert-file' (insert file marked with enclosing tags).
 M-RET    `message-newline-and-reformat' (break the line and reformat)."

-  (setq local-abbrev-table text-mode-abbrev-table)

   (set (make-local-variable 'message-reply-buffer) nil)
   (set (make-local-variable 'message-inserted-headers) nil)
   (set (make-local-variable 'message-send-actions) nil)
   (set (make-local-variable 'message-reply-buffer) nil)
   (set (make-local-variable 'message-inserted-headers) nil)
   (set (make-local-variable 'message-send-actions) nil)


@@ -3042,7 +3134,13 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
     ;; multibyte is not necessary at all. -- zsh
     (mm-enable-multibyte))
   (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
     ;; multibyte is not necessary at all. -- zsh
     (mm-enable-multibyte))
   (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.

-  (mml-mode))
+  (mml-mode)
+  ;; Syntactic fontification. Helps `show-paren-mode',
+  ;; `electric-pair-mode', and C-M-* navigation by syntactically
+  ;; excluding citations and other artifacts.
+  ;;
+  (set (make-local-variable 'syntax-propertize-function) 'message--syntax-propertize)
+  (set (make-local-variable 'parse-sexp-ignore-comments) t))

 
 (defun message-setup-fill-variables ()
   "Setup message fill variables."
 
 (defun message-setup-fill-variables ()
   "Setup message fill variables."


@@ -3176,22 +3274,10 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (push-mark)
   (message-position-on-field "Summary" "Subject"))
 
   (push-mark)
   (message-position-on-field "Summary" "Subject"))
 

-(eval-when-compile
-  (defmacro message-called-interactively-p (kind)
-    (condition-case nil
-       (progn
-         (eval '(called-interactively-p 'any))
-         ;; Emacs >=23.2
-         `(called-interactively-p ,kind))
-      ;; Emacs <23.2
-      (wrong-number-of-arguments '(called-interactively-p))
-      ;; XEmacs
-      (void-function '(interactive-p)))))
-

 (defun message-goto-body ()
   "Move point to the beginning of the message body."
   (interactive)
 (defun message-goto-body ()
   "Move point to the beginning of the message body."
   (interactive)

-  (when (and (message-called-interactively-p 'any)
+  (when (and (gmm-called-interactively-p 'any)

             (looking-at "[ \t]*\n"))
     (expand-abbrev))
   (push-mark)
             (looking-at "[ \t]*\n"))
     (expand-abbrev))
   (push-mark)


@@ -3201,8 +3287,12 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
 
 (defun message-in-body-p ()
   "Return t if point is in the message body."
 
 (defun message-in-body-p ()
   "Return t if point is in the message body."

-  (let ((body (save-excursion (message-goto-body))))
-    (>= (point) body)))
+  (>= (point)
+      (save-excursion
+       (goto-char (point-min))
+       (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
+           (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))
+       (point))))

 
 (defun message-goto-eoh ()
   "Move point to the end of the headers."
 
 (defun message-goto-eoh ()
   "Move point to the end of the headers."


@@ -3333,11 +3423,33 @@ or in the synonym headers, defined by `message-header-synonyms'."
 (defun message-insert-newsgroups ()
   "Insert the Newsgroups header from the article being replied to."
   (interactive)
 (defun message-insert-newsgroups ()
   "Insert the Newsgroups header from the article being replied to."
   (interactive)

-  (when (and (message-position-on-field "Newsgroups")
-            (mail-fetch-field "newsgroups")
-            (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
-    (insert ","))
-  (insert (or (message-fetch-reply-field "newsgroups") "")))
+  (let ((old-newsgroups (mail-fetch-field "newsgroups"))
+       (new-newsgroups (message-fetch-reply-field "newsgroups"))
+       (first t)
+       insert-newsgroups)
+    (message-position-on-field "Newsgroups")
+    (cond
+     ((not new-newsgroups)
+      (error "No Newsgroups to insert"))
+     ((not old-newsgroups)
+      (insert new-newsgroups))
+     (t
+      (setq new-newsgroups (split-string new-newsgroups "[, ]+")
+           old-newsgroups (split-string old-newsgroups "[, ]+"))
+      (dolist (group new-newsgroups)
+       (unless (member group old-newsgroups)
+         (push group insert-newsgroups)))
+      (if (null insert-newsgroups)
+         (error "Newgroup%s already in the header"
+                (if (> (length new-newsgroups) 1)
+                    "s" ""))
+       (when old-newsgroups
+         (setq first nil))
+       (dolist (group insert-newsgroups)
+         (unless first
+           (insert ","))
+         (setq first nil)
+         (insert group)))))))

 
 \f
 
 
 \f
 


@@ -3539,15 +3651,16 @@ Message buffers and is not meant to be called directly."
       (goto-char (point-max))
       ;; Insert the signature.
       (unless (bolp)
       (goto-char (point-max))
       ;; Insert the signature.
       (unless (bolp)

-       (insert "\n"))
+       (newline))

       (when message-signature-insert-empty-line
       (when message-signature-insert-empty-line

-       (insert "\n"))
-      (insert "-- \n")
+       (newline))
+      (insert "-- ")
+      (newline)

       (if (eq signature t)
          (insert-file-contents signature-file)
        (insert signature))
       (goto-char (point-max))
       (if (eq signature t)
          (insert-file-contents signature-file)
        (insert signature))
       (goto-char (point-max))

-      (or (bolp) (insert "\n")))))
+      (or (bolp) (newline)))))

 
 (defun message-insert-importance-high ()
   "Insert header to mark message as important."
 
 (defun message-insert-importance-high ()
   "Insert header to mark message as important."


@@ -3839,7 +3952,9 @@ prefix, and don't delete any headers."
   (interactive "P")
   ;; eval the let forms contained in message-cite-style
   (eval
   (interactive "P")
   ;; eval the let forms contained in message-cite-style
   (eval

-   `(let ,message-cite-style
+   `(let ,(if (symbolp message-cite-style)
+             (symbol-value message-cite-style)
+           message-cite-style)

       (message--yank-original-internal ',arg))))
 
 (defun message-yank-buffer (buffer)
       (message--yank-original-internal ',arg))))
 
 (defun message-yank-buffer (buffer)


@@ -3855,7 +3970,7 @@ prefix, and don't delete any headers."
     (save-current-buffer
       (dolist (buffer (buffer-list t))
        (set-buffer buffer)
     (save-current-buffer
       (dolist (buffer (buffer-list t))
        (set-buffer buffer)

-       (when (and (eq major-mode 'message-mode)
+       (when (and (derived-mode-p 'message-mode)

                   (null message-sent-message-via))
          (push (buffer-name buffer) buffers))))
     (nreverse buffers)))
                   (null message-sent-message-via))
          (push (buffer-name buffer) buffers))))
     (nreverse buffers)))


@@ -3926,12 +4041,14 @@ This function uses `mail-citation-hook' if that is non-nil."
   "Cite function in the standard Message manner."
   (message-cite-original-1 nil))
 
   "Cite function in the standard Message manner."
   (message-cite-original-1 nil))
 

-(defvar gnus-extract-address-components)
-

 (autoload 'format-spec "format-spec")
 (autoload 'format-spec "format-spec")

+(autoload 'gnus-date-get-time "gnus-util")

 
 

-(defun message-insert-formatted-citation-line (&optional from date)
+(defun message-insert-formatted-citation-line (&optional from date tz)

   "Function that inserts a formatted citation line.
   "Function that inserts a formatted citation line.

+The optional FROM, and DATE are strings containing the contents of
+the From header and the Date header respectively.  The optional TZ
+is a number of seconds, overrides the time zone of DATE.

 
 See `message-citation-line-format'."
   ;; The optional args are for testing/debugging.  They will disappear later.
 
 See `message-citation-line-format'."
   ;; The optional args are for testing/debugging.  They will disappear later.


@@ -3939,13 +4056,13 @@ See `message-citation-line-format'."
   ;; (with-temp-buffer
   ;;   (message-insert-formatted-citation-line
   ;;    "John Doe <john.doe@example.invalid>"
   ;; (with-temp-buffer
   ;;   (message-insert-formatted-citation-line
   ;;    "John Doe <john.doe@example.invalid>"

-  ;;    (current-time))
+  ;;    (message-make-date))

   ;;   (buffer-string))
   (when (or message-reply-headers (and from date))
     (unless from
       (setq from (mail-header-from message-reply-headers)))
     (let* ((data (condition-case ()
   ;;   (buffer-string))
   (when (or message-reply-headers (and from date))
     (unless from
       (setq from (mail-header-from message-reply-headers)))
     (let* ((data (condition-case ()

-                    (funcall (if (boundp gnus-extract-address-components)
+                    (funcall (if (boundp 'gnus-extract-address-components)

                                  gnus-extract-address-components
                                'mail-extract-address-components)
                              from)
                                  gnus-extract-address-components
                                'mail-extract-address-components)
                              from)


@@ -3956,33 +4073,49 @@ See `message-citation-line-format'."
           (net (car (cdr data)))
           (name-or-net (or (car data)
                            (car (cdr data)) from))
           (net (car (cdr data)))
           (name-or-net (or (car data)
                            (car (cdr data)) from))

-          (replydate
-           (or
-            date
-            ;; We need Gnus functionality if the user wants date or time from
-            ;; the original article:
-            (when (string-match "%[^fnNFL]" message-citation-line-format)
-              (autoload 'gnus-date-get-time "gnus-util")
-              (gnus-date-get-time (mail-header-date message-reply-headers)))))
+          (time
+           (when (string-match "%[^fnNFL]" message-citation-line-format)
+             (cond ((numberp (car-safe date)) date) ;; backward compatibility
+                   (date (gnus-date-get-time date))
+                   (t
+                    (gnus-date-get-time
+                     (setq date (mail-header-date message-reply-headers)))))))
+          (tz (or tz
+                  (when (stringp date)
+                    (nth 8 (parse-time-string date)))))

           (flist
            (let ((i ?A) lst)
              (when (stringp name)
                ;; Guess first name and last name:
           (flist
            (let ((i ?A) lst)
              (when (stringp name)
                ;; Guess first name and last name:

-               (cond ((string-match
-                       "\\`\\(\\w\\|[-.]\\)+ \\(\\w\\|[-.]\\)+\\'" name)
-                      (setq fname (nth 0 (split-string name "[ \t]+"))
-                            lname (nth 1 (split-string name "[ \t]+"))))
-                     ((string-match
-                       "\\`\\(\\w\\|[-.]\\)+, \\(\\w\\|[-.]\\)+\\'" name)
-                      (setq fname (nth 1 (split-string name "[ \t,]+"))
-                            lname (nth 0 (split-string name "[ \t,]+"))))
-                     ((string-match
-                       "\\`\\(\\w\\|[-.]\\)+\\'" name)
-                      (setq fname name
-                            lname ""))))
+               (let* ((names (delq
+                              nil
+                              (mapcar
+                               (lambda (x)
+                                 (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'"
+                                                   x)
+                                     x
+                                   nil))
+                               (split-string name "[ \t]+"))))
+                      (count (length names)))
+                 (cond ((= count 1)
+                        (setq fname (car names)
+                              lname ""))
+                       ((or (= count 2) (= count 3))
+                        (setq fname (car names)
+                              lname (mapconcat 'identity (cdr names) " ")))
+                       ((> count 3)
+                        (setq fname (mapconcat 'identity
+                                               (butlast names (- count 2))
+                                               " ")
+                              lname (mapconcat 'identity
+                                               (nthcdr 2 names)
+                                               " "))))
+                  (when (string-match "\\(.*\\),\\'" fname)
+                    (let ((newlname (match-string 1 fname)))
+                      (setq fname lname lname newlname)))))

              ;; The following letters are not used in `format-time-string':
              (push ?E lst) (push "<E>" lst)
              ;; The following letters are not used in `format-time-string':
              (push ?E lst) (push "<E>" lst)

-             (push ?F lst) (push fname lst)
+             (push ?F lst) (push (or fname name-or-net) lst)

              ;; We might want to use "" instead of "<X>" later.
              (push ?J lst) (push "<J>" lst)
              (push ?K lst) (push "<K>" lst)
              ;; We might want to use "" instead of "<X>" later.
              (push ?J lst) (push "<J>" lst)
              (push ?K lst) (push "<K>" lst)


@@ -4006,7 +4139,7 @@ See `message-citation-line-format'."
                               (>= i ?a)))
                  (push i lst)
                  (push (condition-case nil
                               (>= i ?a)))
                  (push i lst)
                  (push (condition-case nil

-                           (format-time-string (format "%%%c" i) replydate)
+                           (gmm-format-time-string (format "%%%c" i) time tz)

                          (error (format ">%c<" i)))
                        lst))
                (setq i (1+ i)))
                          (error (format ">%c<" i)))
                        lst))
                (setq i (1+ i)))


@@ -4055,28 +4188,6 @@ This function strips off the signature from the original message."
        (forward-char -1)
        nil))))
 
        (forward-char -1)
        nil))))
 

-(defun message-remove-signature ()
-  "Remove the signature from the text between point and mark.
-The text will also be indented the normal way."
-  (save-excursion
-    (let ((start (point))
-         mark)
-      (if (not (re-search-forward message-signature-separator (mark t) t))
-         ;; No signature here, so we just indent the cited text.
-         (message-indent-citation)
-       ;; Find the last non-empty line.
-       (forward-line -1)
-       (while (looking-at "[ \t]*$")
-         (forward-line -1))
-       (forward-line 1)
-       (setq mark (set-marker (make-marker) (point)))
-       (goto-char start)
-       (message-indent-citation)
-       ;; Enable undoing the deletion.
-       (undo-boundary)
-       (delete-region mark (mark t))
-       (set-marker mark nil)))))
-

 \f
 
 ;;;
 \f
 
 ;;;


@@ -4142,11 +4253,12 @@ Instead, just auto-save the buffer and then bury it."
 
 (defun message-bury (buffer)
   "Bury this mail BUFFER."
 
 (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
   (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.
 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.


@@ -4784,7 +4896,9 @@ that instead."
                            (list resend-to-addresses)
                          '("-t"))))))
            (unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
                            (list resend-to-addresses)
                          '("-t"))))))
            (unless (or (null cpr) (and (numberp cpr) (zerop cpr)))

-              (if errbuf (pop-to-buffer errbuf))
+             (when errbuf
+               (pop-to-buffer errbuf)
+               (setq errbuf nil))

              (error "Sending...failed with exit value %d" cpr)))
          (when message-interactive
            (with-current-buffer errbuf
              (error "Sending...failed with exit value %d" cpr)))
          (when message-interactive
            (with-current-buffer errbuf


@@ -4868,6 +4982,11 @@ evaluates `message-send-mail-hook' just before sending a message.
 It is useful if your ISP requires the POP-before-SMTP
 authentication.  See the Gnus manual for details."
   (run-hooks 'message-send-mail-hook)
 It is useful if your ISP requires the POP-before-SMTP
 authentication.  See the Gnus manual for details."
   (run-hooks 'message-send-mail-hook)

+  ;; Change header-delimiter to be what smtpmail expects.
+  (goto-char (point-min))
+  (when (re-search-forward
+        (concat "^" (regexp-quote mail-header-separator) "\n"))
+    (replace-match "\n"))

   (smtpmail-send-it))
 
 (defun message-send-mail-with-mailclient ()
   (smtpmail-send-it))
 
 (defun message-send-mail-with-mailclient ()


@@ -4883,9 +5002,7 @@ Do not use this for anything important, it is cryptographically weak."
   (require 'sha1)
   (let (sha1-maximum-internal-length)
     (sha1 (concat (message-unique-id)
   (require 'sha1)
   (let (sha1-maximum-internal-length)
     (sha1 (concat (message-unique-id)

-                 (format "%x%x%x" (random)
-                         (progn (random t) (random))
-                         (random))
+                 (format "%x%x%x" (random) (random) (random))

                  (prin1-to-string (recent-keys))
                  (prin1-to-string (garbage-collect))))))
 
                  (prin1-to-string (recent-keys))
                  (prin1-to-string (garbage-collect))))))
 


@@ -5556,7 +5673,7 @@ If NOW, use that time instead."
   "Make date string for the Expires header.  Expiry in DAYS days.
 
 In posting styles use `(\"Expires\" (make-expires-date 30))'."
   "Make date string for the Expires header.  Expiry in DAYS days.
 
 In posting styles use `(\"Expires\" (make-expires-date 30))'."

-  (let* ((cur (decode-time (current-time)))
+  (let* ((cur (decode-time))

         (nday (+ days (nth 3 cur))))
     (setf (nth 3 cur) nday)
     (message-make-date (apply 'encode-time cur))))
         (nday (+ days (nth 3 cur))))
     (setf (nth 3 cur) nday)
     (message-make-date (apply 'encode-time cur))))


@@ -5588,7 +5705,6 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
 ;; You might for example insert a "." somewhere (not next to another dot
 ;; or string boundary), or modify the "fsf" string.
 (defun message-unique-id ()
 ;; You might for example insert a "." somewhere (not next to another dot
 ;; or string boundary), or modify the "fsf" string.
 (defun message-unique-id ()

-  (random t)

   ;; Don't use microseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq message-unique-id-char
   ;; Don't use microseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq message-unique-id-char


@@ -5814,7 +5930,7 @@ give as trustworthy answer as possible."
 
 (defun message-make-fqdn ()
   "Return user's fully qualified domain name."
 
 (defun message-make-fqdn ()
   "Return user's fully qualified domain name."

-  (let* ((system-name (system-name))
+  (let* ((sysname (system-name))

         (user-mail (message-user-mail-address))
         (user-domain
          (if (and user-mail
         (user-mail (message-user-mail-address))
         (user-domain
          (if (and user-mail


@@ -5828,10 +5944,10 @@ give as trustworthy answer as possible."
           (not (string-match message-bogus-system-names message-user-fqdn)))
       ;; `message-user-fqdn' seems to be valid
       message-user-fqdn)
           (not (string-match message-bogus-system-names message-user-fqdn)))
       ;; `message-user-fqdn' seems to be valid
       message-user-fqdn)

-     ((and (string-match message-valid-fqdn-regexp system-name)
-          (not (string-match message-bogus-system-names system-name)))
+     ((and (string-match message-valid-fqdn-regexp sysname)
+          (not (string-match message-bogus-system-names sysname)))

       ;; `system-name' returned the right result.
       ;; `system-name' returned the right result.

-      system-name)
+      sysname)

      ;; Try `mail-host-address'.
      ((and (boundp 'mail-host-address)
           (stringp mail-host-address)
      ;; Try `mail-host-address'.
      ((and (boundp 'mail-host-address)
           (stringp mail-host-address)


@@ -5846,15 +5962,9 @@ give as trustworthy answer as possible."
       user-domain)
      ;; Default to this bogus thing.
      (t
       user-domain)
      ;; Default to this bogus thing.
      (t

-      (concat system-name
+      (concat sysname

              ".i-did-not-set--mail-host-address--so-tickle-me")))))
 
              ".i-did-not-set--mail-host-address--so-tickle-me")))))
 

-(defun message-make-host-name ()
-  "Return the name of the host."
-  (let ((fqdn (message-make-fqdn)))
-    (string-match "^[^.]+\\." fqdn)
-    (substring fqdn 0 (1- (match-end 0)))))
-

 (defun message-make-domain ()
   "Return the domain name."
   (or mail-host-address
 (defun message-make-domain ()
   "Return the domain name."
   (or mail-host-address


@@ -6171,20 +6281,13 @@ Headers already prepared in the buffer are not modified."
     (while (and (not (= (point) end))
                (or (not (eq char ?,))
                    quoted))
     (while (and (not (= (point) end))
                (or (not (eq char ?,))
                    quoted))

-      (skip-chars-forward "^,\"" (point-max))
+      (skip-chars-forward "^,\"" end)

       (when (eq (setq char (following-char)) ?\")
        (setq quoted (not quoted)))
       (unless (= (point) end)
        (forward-char 1)))
     (skip-chars-forward " \t\n")))
 
       (when (eq (setq char (following-char)) ?\")
        (setq quoted (not quoted)))
       (unless (= (point) end)
        (forward-char 1)))
     (skip-chars-forward " \t\n")))
 

-(defun message-fill-address (header value)
-  (insert (capitalize (symbol-name header))
-         ": "
-         (if (consp value) (car value) value)
-         "\n")
-  (message-fill-field-address))
-

 (defun message-split-line ()
   "Split current line, moving portion beyond point vertically down.
 If the current line has `message-yank-prefix', insert it on the new line."
 (defun message-split-line ()
   "Split current line, moving portion beyond point vertically down.
 If the current line has `message-yank-prefix', insert it on the new line."


@@ -6215,17 +6318,22 @@ If the current line has `message-yank-prefix', insert it on the new line."
       (point-max))))
 
 (defun message-fill-field-address ()
       (point-max))))
 
 (defun message-fill-field-address ()

-  (while (not (eobp))
-    (message-skip-to-next-address)
-    (let (last)
-      (if (and (> (current-column) 78)
-              last)
-         (progn
-           (save-excursion
-             (goto-char last)
-             (insert "\n\t"))
-           (setq last (1+ (point))))
-       (setq last (1+ (point)))))))
+  (let (end last)
+    (while (not end)
+      (message-skip-to-next-address)
+      (cond ((bolp)
+            (end-of-line 0)
+            (setq end 1))
+           ((eobp)
+            (setq end 0)))
+      (when (and (> (current-column) 78)
+                last)
+       (save-excursion
+         (goto-char last)
+         (delete-char (- (skip-chars-backward " \t")))
+         (insert "\n\t")))
+      (setq last (point)))
+    (forward-line end)))

 
 (defun message-fill-field-general ()
   (let ((begin (point))
 
 (defun message-fill-field-general ()
   (let ((begin (point))


@@ -6327,6 +6435,9 @@ they are."
   :link '(custom-manual "(message)Movement")
   :type 'boolean)
 
   :link '(custom-manual "(message)Movement")
   :type 'boolean)
 

+(defvar visual-line-mode)
+(declare-function beginning-of-visual-line "simple" (&optional n))
+

 (defun message-beginning-of-line (&optional n)
   "Move point to beginning of header value or to beginning of line.
 The prefix argument N is passed directly to `beginning-of-line'.
 (defun message-beginning-of-line (&optional n)
   "Move point to beginning of header value or to beginning of line.
 The prefix argument N is passed directly to `beginning-of-line'.


@@ -6353,7 +6464,9 @@ between beginning of field and beginning of line."
        (goto-char
         (if (and eoh (or (< eoh here) (= bol here)))
             eoh bol)))
        (goto-char
         (if (and eoh (or (< eoh here) (= bol here)))
             eoh bol)))

-    (beginning-of-line n)))
+    (if (and (boundp 'visual-line-mode) visual-line-mode)
+       (beginning-of-visual-line n)
+      (beginning-of-line n))))

 
 (defun message-buffer-name (type &optional to group)
   "Return a new (unique) buffer name based on TYPE and TO."
 
 (defun message-buffer-name (type &optional to group)
   "Return a new (unique) buffer name based on TYPE and TO."


@@ -6776,11 +6889,16 @@ The function is called with one parameter, a cons cell ..."
                               ", "))
            mct (message-fetch-field "mail-copies-to")
            author (or (message-fetch-field "mail-reply-to")
                               ", "))
            mct (message-fetch-field "mail-copies-to")
            author (or (message-fetch-field "mail-reply-to")

-                      (message-fetch-field "reply-to")
-                      (message-fetch-field "from")
-                      "")
+                      (message-fetch-field "reply-to"))

            mft (and message-use-mail-followup-to
            mft (and message-use-mail-followup-to

-                    (message-fetch-field "mail-followup-to"))))
+                    (message-fetch-field "mail-followup-to")))
+      ;; Make sure this message goes to the author if this is a wide
+      ;; reply, since Reply-To address may be a list address a mailing
+      ;; list server added.
+      (when (and wide author)
+       (setq cc (concat author ", " cc)))
+      (when (or wide (not author))
+       (setq author (or (message-fetch-field "from") ""))))

 
     ;; Handle special values of Mail-Copies-To.
     (when mct
 
     ;; Handle special values of Mail-Copies-To.
     (when mct


@@ -6846,9 +6964,9 @@ want to get rid of this query permanently.")))
       ;; Squeeze whitespace.
       (while (string-match "[ \t][ \t]+" recipients)
        (setq recipients (replace-match " " t t recipients)))
       ;; Squeeze whitespace.
       (while (string-match "[ \t][ \t]+" recipients)
        (setq recipients (replace-match " " t t recipients)))

-      ;; Remove addresses that match `rmail-dont-reply-to-names'.
-      (let ((rmail-dont-reply-to-names (message-dont-reply-to-names)))
-       (setq recipients (rmail-dont-reply-to recipients)))
+      ;; Remove addresses that match `mail-dont-reply-to-names'.
+      (let ((mail-dont-reply-to-names (message-dont-reply-to-names)))
+       (setq recipients (mail-dont-reply-to recipients)))

       ;; Perhaps "Mail-Copies-To: never" removed the only address?
       (if (string-equal recipients "")
          (setq recipients author))
       ;; Perhaps "Mail-Copies-To: never" removed the only address?
       (if (string-equal recipients "")
          (setq recipients author))


@@ -7196,7 +7314,7 @@ If ARG, allow editing of the cancellation message."
        (erase-buffer)
        (insert "Newsgroups: " newsgroups "\n"
                "From: " from "\n"
        (erase-buffer)
        (insert "Newsgroups: " newsgroups "\n"
                "From: " from "\n"

-               "Subject: cmsg cancel " message-id "\n"
+               "Subject: cancel " message-id "\n"

                "Control: cancel " message-id "\n"
                (if distribution
                    (concat "Distribution: " distribution "\n")
                "Control: cancel " message-id "\n"
                (if distribution
                    (concat "Distribution: " distribution "\n")


@@ -7256,7 +7374,7 @@ header line with the old Message-ID."
           (let ((buffer-read-only nil))
             (erase-buffer)
             (insert-file-contents file-name nil)))
           (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:
 
 
 ;;; Washing Subject:
 


@@ -7415,24 +7533,33 @@ Optional DIGEST will use digest to forward."
     (message-remove-ignored-headers b e)))
 
 (defun message-remove-ignored-headers (b e)
     (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)))
     (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))))))
-
-(defun message-forward-make-body-mime (forward-buffer)
+      (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)))
     (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
     (save-restriction
       (narrow-to-region (point) (point))
   (let ((b (point)))
     (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
     (save-restriction
       (narrow-to-region (point) (point))

-      (mml-insert-buffer forward-buffer)
+      (insert-buffer-substring forward-buffer beg end)
+      (mml-quote-region (point-min) (point-max))

       (goto-char (point-min))
       (when (looking-at "From ")
        (replace-match "X-From-Line: "))
       (goto-char (point-min))
       (when (looking-at "From ")
        (replace-match "X-From-Line: "))


@@ -7472,8 +7599,7 @@ Optional DIGEST will use digest to forward."
        (goto-char (point-max))))
     (setq e (point))
     (insert "<#/mml>\n")
        (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)
       (message-remove-ignored-headers b e))))
 
 (defun message-forward-make-body-digest-plain (forward-buffer)


@@ -7968,8 +8094,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'.
 
 (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)
   (interactive)
   (cond
    ((if (and (boundp 'completion-fail-discreetly)


@@ -7997,37 +8124,36 @@ those headers."
         ;; falling back to message-tab-body-function.
         (lambda () (funcall fun) 'completion-attempted)))))
 
         ;; falling back to message-tab-body-function.
         (lambda () (funcall fun) 'completion-attempted)))))
 

-(eval-and-compile
-  (condition-case nil
-      (with-temp-buffer
-       (let ((standard-output (current-buffer)))
-         (eval '(display-completion-list nil "")))
-       (defalias 'message-display-completion-list 'display-completion-list))
-    (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
-     (defun message-display-completion-list (completions &optional ignore)
-       "Display the list of completions, COMPLETIONS, using `standard-output'."
-       (display-completion-list completions)))))
-

 (defun message-expand-group ()
   "Expand the group name under point."
 (defun message-expand-group ()
   "Expand the group name under point."

-  (let* ((b (save-excursion
-             (save-restriction
-               (narrow-to-region
-                (save-excursion
-                  (beginning-of-line)
-                  (skip-chars-forward "^:")
-                  (1+ (point)))
-                (point))
-               (skip-chars-backward "^, \t\n") (point))))
-        (completion-ignore-case t)
-         (e (progn (skip-chars-forward "^,\t\n ") (point)))
-        (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)))
-    (message-completion-in-region e b hashtb)))
+  (let ((b (save-excursion
+            (save-restriction
+              (narrow-to-region
+               (save-excursion
+                 (beginning-of-line)
+                 (skip-chars-forward "^:")
+                 (1+ (point)))
+               (point))
+              (skip-chars-backward "^, \t\n") (point))))
+       (completion-ignore-case t)
+       (e (progn (skip-chars-forward "^,\t\n ") (point)))
+       group collection)
+    (when (and (boundp 'gnus-active-hashtb)
+              gnus-active-hashtb)
+      (mapatoms
+       (lambda (symbol)
+        (setq group (symbol-name symbol))
+        (push (if (string-match "[^\000-\177]" group)
+                  (gnus-group-decoded-name group)
+                group)
+              collection))
+       gnus-active-hashtb))
+    (message-completion-in-region b e collection)))

 
 (defalias 'message-completion-in-region
   (if (fboundp 'completion-in-region)
       'completion-in-region
 
 (defalias 'message-completion-in-region
   (if (fboundp 'completion-in-region)
       'completion-in-region

-    (lambda (e b hashtb)
+    (lambda (b e hashtb)

       (let* ((string (buffer-substring b e))
              (completions (all-completions string hashtb))
              comp)
       (let* ((string (buffer-substring b e))
              (completions (all-completions string hashtb))
              comp)


@@ -8052,8 +8178,7 @@ those headers."
               (let ((buffer-read-only nil))
                 (erase-buffer)
                 (let ((standard-output (current-buffer)))
               (let ((buffer-read-only nil))
                 (erase-buffer)
                 (let ((standard-output (current-buffer)))

-                  (message-display-completion-list (sort completions 'string<)
-                                                   string))
+                  (display-completion-list (sort completions 'string<)))

                 (setq buffer-read-only nil)
                 (goto-char (point-min))
                 (delete-region (point)
                 (setq buffer-read-only nil)
                 (goto-char (point-min))
                 (delete-region (point)


@@ -8182,7 +8307,7 @@ regexp VARSTR."
   (if (fboundp 'mail-abbrevs-setup)
       (let ((minibuffer-setup-hook 'mail-abbrevs-setup)
            (minibuffer-local-map message-minibuffer-local-map))
   (if (fboundp 'mail-abbrevs-setup)
       (let ((minibuffer-setup-hook 'mail-abbrevs-setup)
            (minibuffer-local-map message-minibuffer-local-map))

-       (flet ((mail-abbrev-in-expansion-header-p nil t))
+       (gmm-flet ((mail-abbrev-in-expansion-header-p nil t))

          (read-from-minibuffer prompt initial-contents)))
     (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
          (minibuffer-local-map message-minibuffer-local-map))
          (read-from-minibuffer prompt initial-contents)))
     (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
          (minibuffer-local-map message-minibuffer-local-map))


@@ -8463,6 +8588,17 @@ Used in `message-simplify-recipients'."
         (message-fetch-field hdr) t))
       ", "))))
 
         (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))
 (when (featurep 'xemacs)
   (require 'messagexmas)
   (message-xmas-redefine))


@@ -8472,7 +8608,7 @@ Used in `message-simplify-recipients'."
 (run-hooks 'message-load-hook)
 
 ;; Local Variables:
 (run-hooks 'message-load-hook)
 
 ;; Local Variables:

-;; coding: iso-8859-1
+;; coding: utf-8

 ;; End:
 
 ;;; message.el ends here
 ;; End:
 
 ;;; message.el ends here