message.el: Improve sexp-based movement in message-mode

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 4eb2a57..5b44866 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-2013 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/
 


@@ -614,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)


@@ -624,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


@@ -972,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)
 


@@ -996,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'."


@@ -1783,13 +1801,17 @@ 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))
+       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


@@ -1946,14 +1968,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)
 


@@ -2291,7 +2351,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


@@ -2493,6 +2553,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) ":")))


@@ -2944,6 +3005,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.


@@ -3046,7 +3131,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.
+  ;;
+  (setq-local syntax-propertize-function 'message--syntax-propertize)
+  (setq-local parse-sexp-ignore-comments t))

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


@@ -3557,15 +3648,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."


@@ -3949,9 +4041,13 @@ This function uses `mail-citation-hook' if that is non-nil."
 (defvar gnus-extract-address-components)
 
 (autoload 'format-spec "format-spec")
 (defvar gnus-extract-address-components)
 
 (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.


@@ -3959,7 +4055,7 @@ 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
   ;;   (buffer-string))
   (when (or message-reply-headers (and from date))
     (unless from


@@ -3976,34 +4072,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:

-                (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) " "))) )
+               (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)
                   (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)

-             (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)


@@ -4027,7 +4138,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)))


@@ -4141,11 +4252,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.


@@ -4783,7 +4895,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


@@ -4867,6 +4981,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 ()


@@ -5553,7 +5672,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))))


@@ -5810,7 +5929,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


@@ -5824,10 +5943,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)


@@ -5842,7 +5961,7 @@ 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")))))
 
 (defun message-make-domain ()
              ".i-did-not-set--mail-host-address--so-tickle-me")))))
 
 (defun message-make-domain ()


@@ -6315,6 +6434,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'.


@@ -6341,7 +6463,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."


@@ -7249,7 +7373,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:
 


@@ -7408,17 +7532,25 @@ 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))))))
+      (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)))
 
 (defun message-forward-make-body-mime (forward-buffer &optional beg end)
   (let ((b (point)))


@@ -7466,8 +7598,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)


@@ -7962,8 +8093,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)


@@ -7991,17 +8123,6 @@ 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."
   (let ((b (save-excursion
 (defun message-expand-group ()
   "Expand the group name under point."
   (let ((b (save-excursion


@@ -8026,12 +8147,12 @@ those headers."
                 group)
               collection))
        gnus-active-hashtb))
                 group)
               collection))
        gnus-active-hashtb))

-    (message-completion-in-region e b collection)))
+    (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)


@@ -8056,8 +8177,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)


@@ -8467,6 +8587,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))