Fix XEmacs compilation

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 9cd0a4d..828dfde 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-2014 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)
 


@@ -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,8 +1010,8 @@ 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\".
 
   %f   The full From, e.g. \"John Doe <john.doe@example.invalid>\".
   %n   The mail address, e.g. \"john.doe@example.invalid\".


@@ -1005,11 +1019,14 @@ constructs are replaced:
        back to the mail address.
   %F   The first name if present, e.g.: \"John\".
   %L   The last name if present, e.g.: \"Doe\".
        back to the mail address.
   %F   The first name if present, e.g.: \"John\".
   %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'."


@@ -1142,9 +1159,9 @@ 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
   :group 'message-insertion)
 
 (defcustom message-cite-style nil


@@ -1783,13 +1800,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,7 +1967,45 @@ 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
   ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
   ;; http://en.wikipedia.org/wiki/GTLD
   ;; `approved, but not yet in operation': .xxx


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


@@ -2983,7 +3043,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)


@@ -3558,15 +3617,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."


@@ -3858,7 +3918,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)


@@ -3948,9 +4010,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.


@@ -3958,7 +4024,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


@@ -3975,30 +4041,46 @@ 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)
              (push ?F lst) (push fname lst)
              ;; The following letters are not used in `format-time-string':
              (push ?E lst) (push "<E>" lst)
              (push ?F lst) (push fname lst)


@@ -4025,7 +4107,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)))


@@ -4139,11 +4221,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.


@@ -4781,7 +4864,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


@@ -5551,7 +5636,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))))


@@ -6313,6 +6398,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'.


@@ -6339,7 +6427,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."


@@ -7187,7 +7277,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")


@@ -7247,7 +7337,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:
 


@@ -7406,24 +7496,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: "))


@@ -7463,8 +7562,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)


@@ -7959,8 +8057,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)


@@ -7988,37 +8087,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)


@@ -8043,8 +8141,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)


@@ -8454,6 +8551,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))


@@ -8463,7 +8571,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