*** empty log message ***

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index de5481f..5c1b7ab 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,7 +1,7 @@
 ;;; message.el --- composing mail and news messages
 ;;; message.el --- composing mail and news messages

-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.

 
 

-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>

 ;; Keywords: mail, news
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: mail, news
 
 ;; This file is part of GNU Emacs.


@@ -29,10 +29,9 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

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

 (require 'mailheader)
 (require 'mailheader)

-(require 'rmail)

 (require 'nnheader)
 (require 'timezone)
 (require 'easymenu)
 (require 'nnheader)
 (require 'timezone)
 (require 'easymenu)


@@ -45,7 +44,8 @@
                    (user-full-name custom-variable))
   "Mail and news message composing."
   :link '(custom-manual "(message)Top")
                    (user-full-name custom-variable))
   "Mail and news message composing."
   :link '(custom-manual "(message)Top")

-  :group 'emacs)
+  :group 'mail
+  :group 'news)

 
 (put 'user-mail-address 'custom-type 'string)
 (put 'user-full-name 'custom-type 'string)
 
 (put 'user-mail-address 'custom-type 'string)
 (put 'user-full-name 'custom-type 'string)


@@ -93,6 +93,11 @@
   "Composing Mail Messages"
   :group 'message)
 
   "Composing Mail Messages"
   :group 'message)
 

+(defgroup message-faces nil
+  "Faces used for message composing."
+  :group 'message
+  :group 'faces)
+

 (defcustom message-directory "~/Mail/"
   "*Directory from which all other mail file variables are derived."
   :group 'message-various
 (defcustom message-directory "~/Mail/"
   "*Directory from which all other mail file variables are derived."
   :group 'message-various


@@ -108,13 +113,12 @@
   :group 'message-buffers
   :type 'function)
 
   :group 'message-buffers
   :type 'function)
 

-;;;###autoload
-(defcustom message-fcc-handler-function 'rmail-output
+(defcustom message-fcc-handler-function 'message-output

   "*A function called to save outgoing articles.
 This function will be called with the name of the file to store the
   "*A function called to save outgoing articles.
 This function will be called with the name of the file to store the

-article in.  The default function is `rmail-output' which saves in Unix
+article in.  The default function is `message-output' which saves in Unix

 mailbox format."
 mailbox format."

-  :type '(radio (function-item rmail-output)
+  :type '(radio (function-item message-output)

                (function :tag "Other"))
   :group 'message-sending)
 
                (function :tag "Other"))
   :group 'message-sending)
 


@@ -152,8 +156,8 @@ Otherwise, most addresses look like `angles', but they look like
   :group 'message-headers)
 
 (defcustom message-syntax-checks nil
   :group 'message-headers)
 
 (defcustom message-syntax-checks nil

-  ;; Guess this one shouldn't be easy to customize...
-  "Controls what syntax checks should not be performed on outgoing posts.
+  ; Guess this one shouldn't be easy to customize...
+  "*Controls what syntax checks should not be performed on outgoing posts.

 To disable checking of long signatures, for instance, add
  `(signature . disabled)' to this list.
 
 To disable checking of long signatures, for instance, add
  `(signature . disabled)' to this list.
 


@@ -162,14 +166,14 @@ Don't touch this variable unless you really know what you're doing.
 Checks include subject-cmsg multiple-headers sendsys message-id from
 long-lines control-chars size new-text redirected-followup signature
 approved sender empty empty-headers message-id from subject
 Checks include subject-cmsg multiple-headers sendsys message-id from
 long-lines control-chars size new-text redirected-followup signature
 approved sender empty empty-headers message-id from subject

-shorten-followup-to existing-newsgroups."
+shorten-followup-to existing-newsgroups buffer-file-name unchanged."

   :group 'message-news)
 
 (defcustom message-required-news-headers
   :group 'message-news)
 
 (defcustom message-required-news-headers

-  '(From Newsgroups Subject Date Message-ID 
-        (optional . Organization) Lines 
+  '(From Newsgroups Subject Date Message-ID
+        (optional . Organization) Lines

         (optional . X-Newsreader))
         (optional . X-Newsreader))

-  "Headers to be generated or prompted for when posting an article.
+  "*Headers to be generated or prompted for when posting an article.

 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
 X-Newsreader are optional.  If don't you want message to insert some
 RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
 Message-ID.  Organization, Lines, In-Reply-To, Expires, and
 X-Newsreader are optional.  If don't you want message to insert some


@@ -178,10 +182,10 @@ header, remove it from this list."
   :group 'message-headers
   :type '(repeat sexp))
 
   :group 'message-headers
   :type '(repeat sexp))
 

-(defcustom message-required-mail-headers 
+(defcustom message-required-mail-headers

   '(From Subject Date (optional . In-Reply-To) Message-ID Lines
         (optional . X-Mailer))
   '(From Subject Date (optional . In-Reply-To) Message-ID Lines
         (optional . X-Mailer))

-  "Headers to be generated or prompted for when mailing a message.
+  "*Headers to be generated or prompted for when mailing a message.

 RFC822 required that From, Date, To, Subject and Message-ID be
 included.  Organization, Lines and X-Mailer are optional."
   :group 'message-mail
 RFC822 required that From, Date, To, Subject and Message-ID be
 included.  Organization, Lines and X-Mailer are optional."
   :group 'message-mail


@@ -193,26 +197,31 @@ included.  Organization, Lines and X-Mailer are optional."
   :group 'message-headers
   :type 'sexp)
 
   :group 'message-headers
   :type 'sexp)
 

-(defcustom message-ignored-news-headers 
-  "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
+(defcustom message-ignored-news-headers
+  "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:"

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

-(defcustom message-ignored-mail-headers "^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
+(defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:"

   "*Regexp of headers to be removed unconditionally before mailing."
   :group 'message-mail
   :group 'message-headers
   :type 'regexp)
 
   "*Regexp of headers to be removed unconditionally before mailing."
   :group 'message-mail
   :group 'message-headers
   :type 'regexp)
 

-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^X-Trace:\\|^X-Complaints-To:"

   "*Header lines matching this regexp will be deleted before posting.
 It's best to delete old Path and Date headers before posting to avoid
 any confusion."
   :group 'message-interface
   :type 'regexp)
 
   "*Header lines matching this regexp will be deleted before posting.
 It's best to delete old Path and Date headers before posting to avoid
 any confusion."
   :group 'message-interface
   :type 'regexp)
 

+(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*"
+  "*Regexp matching \"Re: \" in the subject line."
+  :group 'message-various
+  :type 'regexp)
+

 ;;;###autoload
 (defcustom message-signature-separator "^-- *$"
   "Regexp matching the signature separator."
 ;;;###autoload
 (defcustom message-signature-separator "^-- *$"
   "Regexp matching the signature separator."


@@ -220,9 +229,11 @@ any confusion."
   :group 'message-various)
 
 (defcustom message-elide-elipsis "\n[...]\n\n"
   :group 'message-various)
 
 (defcustom message-elide-elipsis "\n[...]\n\n"

-  "*The string which is inserted for elided text.")
+  "*The string which is inserted for elided text."
+  :type 'string
+  :group 'message-various)

 
 

-(defcustom message-interactive nil 
+(defcustom message-interactive nil

   "Non-nil means when sending a message wait for and display errors.
 nil means let mailer mail back a message to report errors."
   :group 'message-sending
   "Non-nil means when sending a message wait for and display errors.
 nil means let mailer mail back a message to report errors."
   :group 'message-sending


@@ -230,7 +241,7 @@ nil means let mailer mail back a message to report errors."
   :type 'boolean)
 
 (defcustom message-generate-new-buffers t
   :type 'boolean)
 
 (defcustom message-generate-new-buffers t

-  "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.
+  "*Non-nil means that a new message buffer will be created whenever `message-setup' is called.

 If this is a function, call that function with three parameters:  The type,
 the to address and the group name.  (Any of these may be nil.)  The function
 should return the new buffer name."
 If this is a function, call that function with three parameters:  The type,
 the to address and the group name.  (Any of these may be nil.)  The function
 should return the new buffer name."


@@ -245,8 +256,9 @@ should return the new buffer name."
   :type 'boolean)
 
 (defvar gnus-local-organization)
   :type 'boolean)
 
 (defvar gnus-local-organization)

-(defcustom message-user-organization 
+(defcustom message-user-organization

   (or (and (boundp 'gnus-local-organization)
   (or (and (boundp 'gnus-local-organization)

+          (stringp gnus-local-organization)

           gnus-local-organization)
       (getenv "ORGANIZATION")
       t)
           gnus-local-organization)
       (getenv "ORGANIZATION")
       t)


@@ -262,14 +274,7 @@ If t, use `message-user-organization-file'."
   :type 'file
   :group 'message-headers)
 
   :type 'file
   :group 'message-headers)
 

-(defcustom message-autosave-directory "~/"
-  ; (concat (file-name-as-directory message-directory) "drafts/")
-  "*Directory where message autosaves buffers.
-If nil, message won't autosave."
-  :group 'message-buffers
-  :type 'directory)
-
-(defcustom message-forward-start-separator 
+(defcustom message-forward-start-separator

   "------- Start of forwarded message -------\n"
   "*Delimiter inserted before forwarded messages."
   :group 'message-forwarding
   "------- Start of forwarded message -------\n"
   "*Delimiter inserted before forwarded messages."
   :group 'message-forwarding


@@ -286,8 +291,8 @@ If nil, message won't autosave."
   :group 'message-forwarding
   :type 'boolean)
 
   :group 'message-forwarding
   :type 'boolean)
 

-(defcustom message-included-forward-headers 
-  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:"
+(defcustom message-included-forward-headers
+  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:"

   "*Regexp matching headers to be included in forwarded messages."
   :group 'message-forwarding
   :type 'regexp)
   "*Regexp matching headers to be included in forwarded messages."
   :group 'message-forwarding
   :type 'regexp)


@@ -315,10 +320,12 @@ The headers should be delimited by a line whose contents match the
 variable `mail-header-separator'.
 
 Legal values include `message-send-mail-with-sendmail' (the default),
 variable `mail-header-separator'.
 
 Legal values include `message-send-mail-with-sendmail' (the default),

-`message-send-mail-with-mh' and `message-send-mail-with-qmail'."
+`message-send-mail-with-mh', `message-send-mail-with-qmail' and
+`smtpmail-send-it'."

   :type '(radio (function-item message-send-mail-with-sendmail)
                (function-item message-send-mail-with-mh)
                (function-item message-send-mail-with-qmail)
   :type '(radio (function-item message-send-mail-with-sendmail)
                (function-item message-send-mail-with-mh)
                (function-item message-send-mail-with-qmail)

+               (function-item smtpmail-send-it)

                (function :tag "Other"))
   :group 'message-sending
   :group 'message-mail)
                (function :tag "Other"))
   :group 'message-sending
   :group 'message-mail)


@@ -388,16 +395,18 @@ might set this variable to '(\"-f\" \"you@some.where\")."
 
 (defvar gnus-post-method)
 (defvar gnus-select-method)
 
 (defvar gnus-post-method)
 (defvar gnus-select-method)

-(defcustom message-post-method 
+(defcustom message-post-method

   (cond ((and (boundp 'gnus-post-method)
              gnus-post-method)
         gnus-post-method)
        ((boundp 'gnus-select-method)
         gnus-select-method)
        (t '(nnspool "")))
   (cond ((and (boundp 'gnus-post-method)
              gnus-post-method)
         gnus-post-method)
        ((boundp 'gnus-select-method)
         gnus-select-method)
        (t '(nnspool "")))

-  "Method used to post news."
+  "*Method used to post news.
+Note that when posting from inside Gnus, for instance, this
+variable isn't used."

   :group 'message-news
   :group 'message-news

-  :group 'mesage-sending
+  :group 'message-sending

   ;; This should be the `gnus-select-method' widget, but that might
   ;; create a dependence to `gnus.el'.
   :type 'sexp)
   ;; This should be the `gnus-select-method' widget, but that might
   ;; create a dependence to `gnus.el'.
   :type 'sexp)


@@ -415,7 +424,7 @@ The function `message-setup' runs this hook."
 
 (defcustom message-signature-setup-hook nil
   "Normal hook, run each time a new outgoing message is initialized.
 
 (defcustom message-signature-setup-hook nil
   "Normal hook, run each time a new outgoing message is initialized.

-It is run after the headers have been inserted and before 
+It is run after the headers have been inserted and before

 the signature is inserted."
   :group 'message-various
   :type 'hook)
 the signature is inserted."
   :group 'message-various
   :type 'hook)


@@ -431,8 +440,7 @@ the signature is inserted."
   :type 'hook)
 
 (defcustom message-header-setup-hook nil
   :type 'hook)
 
 (defcustom message-header-setup-hook nil

-  "Hook called narrowed to the headers when setting up a message
-buffer."
+  "Hook called narrowed to the headers when setting up a message buffer."

   :group 'message-various
   :type 'hook)
 
   :group 'message-various
   :type 'hook)
 


@@ -456,12 +464,11 @@ Used by `message-yank-original' via `message-yank-cite'."
   :type 'integer)
 
 ;;;###autoload
   :type 'integer)
 
 ;;;###autoload

-(defcustom message-cite-function
-  (if (and (boundp 'mail-citation-hook)
-          mail-citation-hook)
-      mail-citation-hook
-    'message-cite-original)
-  "*Function for citing an original message."
+(defcustom message-cite-function 'message-cite-original
+  "*Function for citing an original message.
+Predefined functions include `message-cite-original' and
+`message-cite-original-without-signature'.
+Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."

   :type '(radio (function-item message-cite-original)
                (function-item sc-cite-original)
                (function :tag "Other"))
   :type '(radio (function-item message-cite-original)
                (function-item sc-cite-original)
                (function :tag "Other"))


@@ -531,30 +538,36 @@ If stringp, use this; if non-nil, use no host name (user name only)."
 (defvar message-postpone-actions nil
   "A list of actions to be performed after postponing a message.")
 
 (defvar message-postpone-actions nil
   "A list of actions to be performed after postponing a message.")
 

+(define-widget 'message-header-lines 'text
+  "All header lines must be LFD terminated."
+  :format "%t:%n%v"
+  :valid-regexp "^\\'"
+  :error "All header lines must be newline terminated")
+

 (defcustom message-default-headers ""
   "*A string containing header lines to be inserted in outgoing messages.
 It is inserted before you edit the message, so you can edit or delete
 these lines."
   :group 'message-headers
 (defcustom message-default-headers ""
   "*A string containing header lines to be inserted in outgoing messages.
 It is inserted before you edit the message, so you can edit or delete
 these lines."
   :group 'message-headers

-  :type 'string)
+  :type 'message-header-lines)

 
 (defcustom message-default-mail-headers ""
   "*A string of header lines to be inserted in outgoing mails."
   :group 'message-headers
   :group 'message-mail
 
 (defcustom message-default-mail-headers ""
   "*A string of header lines to be inserted in outgoing mails."
   :group 'message-headers
   :group 'message-mail

-  :type 'string)
+  :type 'message-header-lines)

 
 (defcustom message-default-news-headers ""
   "*A string of header lines to be inserted in outgoing news
 articles."
   :group 'message-headers
   :group 'message-news
 
 (defcustom message-default-news-headers ""
   "*A string of header lines to be inserted in outgoing news
 articles."
   :group 'message-headers
   :group 'message-news

-  :type 'string)
+  :type 'message-header-lines)

 
 ;; Note: could use /usr/ucb/mail instead of sendmail;
 ;; options -t, and -v if not interactive.
 (defcustom message-mailer-swallows-blank-line
 
 ;; Note: could use /usr/ucb/mail instead of sendmail;
 ;; options -t, and -v if not interactive.
 (defcustom message-mailer-swallows-blank-line

-  (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" 
+  (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"

                         system-configuration)
           (file-readable-p "/etc/sendmail.cf")
           (let ((buffer (get-buffer-create " *temp*")))
                         system-configuration)
           (file-readable-p "/etc/sendmail.cf")
           (let ((buffer (get-buffer-create " *temp*")))


@@ -571,25 +584,55 @@ articles."
       ;; 33 and 126, except colon)", i. e., any chars except ctl chars,
       ;; space, or colon.
       '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
       ;; 33 and 126, except colon)", i. e., any chars except ctl chars,
       ;; space, or colon.
       '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))

-  "Set this non-nil if the system's mailer runs the header and body together.
+  "*Set this non-nil if the system's mailer runs the header and body together.

 \(This problem exists on Sunos 4 when sendmail is run in remote mode.)
 The value should be an expression to test whether the problem will
 actually occur."
   :group 'message-sending
   :type 'sexp)
 
 \(This problem exists on Sunos 4 when sendmail is run in remote mode.)
 The value should be an expression to test whether the problem will
 actually occur."
   :group 'message-sending
   :type 'sexp)
 

-(ignore-errors
-  (define-mail-user-agent 'message-user-agent
-    'message-mail 'message-send-and-exit 
-    'message-kill-buffer 'message-send-hook))
+;; Ignore errors in case this is used in Emacs 19.
+;; Don't use ignore-errors because this is copied into loaddefs.el.
+;;;###autoload
+(condition-case nil
+    (define-mail-user-agent 'message-user-agent
+      'message-mail 'message-send-and-exit
+      'message-kill-buffer 'message-send-hook)
+  (error nil))

 
 

-(defvar message-delete-mh-headers t
+(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)

   "If non-nil, delete the deletable headers before feeding to mh.")
 
   "If non-nil, delete the deletable headers before feeding to mh.")
 

+(defvar message-send-method-alist
+  '((news message-news-p message-send-via-news)
+    (mail message-mail-p message-send-via-mail))
+  "Alist of ways to send outgoing messages.
+Each element has the form
+
+  \(TYPE PREDICATE FUNCTION)
+
+where TYPE is a symbol that names the method; PREDICATE is a function
+called without any parameters to determine whether the message is
+a message of type TYPE; and FUNCTION is a function to be called if
+PREDICATE returns non-nil.  FUNCTION is called with one parameter --
+the prefix.")
+
+(defvar message-mail-alias-type 'abbrev
+  "*What alias expansion type to use in Message buffers.
+The default is `abbrev', which uses mailabbrev.  nil switches
+mail aliases off.")
+
+(defcustom message-autosave-directory
+  (nnheader-concat message-directory "drafts/")
+  "*Directory where Message autosaves buffers if Gnus isn't running.
+If nil, Message won't autosave."
+  :group 'message-buffers
+  :type 'directory)
+

 ;;; Internal variables.
 ;;; Well, not really internal.
 
 ;;; Internal variables.
 ;;; Well, not really internal.
 

-(defvar message-mode-syntax-table 
+(defvar message-mode-syntax-table

   (let ((table (copy-syntax-table text-mode-syntax-table)))
     (modify-syntax-entry ?% ". " table)
     table)
   (let ((table (copy-syntax-table text-mode-syntax-table)))
     (modify-syntax-entry ?% ". " table)
     table)


@@ -598,27 +641,160 @@ actually occur."
 (defvar message-mode-abbrev-table text-mode-abbrev-table
   "Abbrev table used in Message mode buffers.
 Defaults to `text-mode-abbrev-table'.")
 (defvar message-mode-abbrev-table text-mode-abbrev-table
   "Abbrev table used in Message mode buffers.
 Defaults to `text-mode-abbrev-table'.")

+(defgroup message-headers nil
+  "Message headers."
+  :link '(custom-manual "(message)Variables")
+  :group 'message)
+
+(defface message-header-to-face
+  '((((class color)
+      (background dark))
+     (:foreground "green2" :bold t))
+    (((class color)
+      (background light))
+     (:foreground "MidnightBlue" :bold t))
+    (t
+     (:bold t :italic t)))
+  "Face used for displaying From headers."
+  :group 'message-faces)
+
+(defface message-header-cc-face
+  '((((class color)
+      (background dark))
+     (:foreground "green4" :bold t))
+    (((class color)
+      (background light))
+     (:foreground "MidnightBlue"))
+    (t
+     (:bold t)))
+  "Face used for displaying Cc headers."
+  :group 'message-faces)
+
+(defface message-header-subject-face
+  '((((class color)
+      (background dark))
+     (:foreground "green3"))
+    (((class color)
+      (background light))
+     (:foreground "navy blue" :bold t))
+    (t
+     (:bold t)))
+  "Face used for displaying subject headers."
+  :group 'message-faces)
+
+(defface message-header-newsgroups-face
+  '((((class color)
+      (background dark))
+     (:foreground "yellow" :bold t :italic t))
+    (((class color)
+      (background light))
+     (:foreground "blue4" :bold t :italic t))
+    (t
+     (:bold t :italic t)))
+  "Face used for displaying newsgroups headers."
+  :group 'message-faces)
+
+(defface message-header-other-face
+  '((((class color)
+      (background dark))
+     (:foreground "#b00000"))
+    (((class color)
+      (background light))
+     (:foreground "steel blue"))
+    (t
+     (:bold t :italic t)))
+  "Face used for displaying newsgroups headers."
+  :group 'message-faces)
+
+(defface message-header-name-face
+  '((((class color)
+      (background dark))
+     (:foreground "DarkGreen"))
+    (((class color)
+      (background light))
+     (:foreground "cornflower blue"))
+    (t
+     (:bold t)))
+  "Face used for displaying header names."
+  :group 'message-faces)
+
+(defface message-header-xheader-face
+  '((((class color)
+      (background dark))
+     (:foreground "blue"))
+    (((class color)
+      (background light))
+     (:foreground "blue"))
+    (t
+     (:bold t)))
+  "Face used for displaying X-Header headers."
+  :group 'message-faces)
+
+(defface message-separator-face
+  '((((class color)
+      (background dark))
+     (:foreground "blue3"))
+    (((class color)
+      (background light))
+     (:foreground "brown"))
+    (t
+     (:bold t)))
+  "Face used for displaying the separator."
+  :group 'message-faces)
+
+(defface message-cited-text-face
+  '((((class color)
+      (background dark))
+     (:foreground "red"))
+    (((class color)
+      (background light))
+     (:foreground "red"))
+    (t
+     (:bold t)))
+  "Face used for displaying cited text names."
+  :group 'message-faces)

 
 (defvar message-font-lock-keywords
 
 (defvar message-font-lock-keywords

-  (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")))
-    (list '("^To:" . font-lock-function-name-face)
-          '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face)
-         '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
-           (1 font-lock-comment-face) (2 font-lock-type-face nil t))
-         (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
-               1 'font-lock-comment-face)
-         (cons (concat "^[ \t]*"
-                       "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
-                       "[>|}].*")
-               'font-lock-reference-face)
-         '("^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):.*"
-           . font-lock-string-face)))
+  (let* ((cite-prefix "A-Za-z")
+        (cite-suffix (concat cite-prefix "0-9_.@-"))
+        (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
+    `((,(concat "^\\([Tt]o:\\)" content)
+       (1 'message-header-name-face)
+       (2 'message-header-to-face nil t))
+      (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
+       (1 'message-header-name-face)
+       (2 'message-header-cc-face nil t))
+      (,(concat "^\\([Ss]ubject:\\)" content)
+       (1 'message-header-name-face)
+       (2 'message-header-subject-face nil t))
+      (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
+       (1 'message-header-name-face)
+       (2 'message-header-newsgroups-face nil t))
+      (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
+       (1 'message-header-name-face)
+       (2 'message-header-other-face nil t))
+      (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
+       (1 'message-header-name-face)
+       (2 'message-header-name-face))
+      ,@(if (and mail-header-separator
+                (not (equal mail-header-separator "")))
+           `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
+              1 'message-separator-face))
+         nil)
+      (,(concat "^[ \t]*"
+               "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
+               "[:>|}].*")
+       (0 'message-cited-text-face))))

   "Additional expressions to highlight in Message mode.")
 
   "Additional expressions to highlight in Message mode.")
 

+;; XEmacs does it like this.  For Emacs, we have to set the
+;; `font-lock-defaults' buffer-local variable.
+(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
+

 (defvar message-face-alist
   '((bold . bold-region)
     (underline . underline-region)
 (defvar message-face-alist
   '((bold . bold-region)
     (underline . underline-region)

-    (default . (lambda (b e) 
+    (default . (lambda (b e)

                 (unbold-region b e)
                 (ununderline-region b e))))
   "Alist of mail and news faces for facemenu.
                 (unbold-region b e)
                 (ununderline-region b e))))
   "Alist of mail and news faces for facemenu.


@@ -650,13 +826,15 @@ The cdr of ech entry is a function for applying the face to a region.")
 (defvar message-buffer-list nil)
 (defvar message-this-is-news nil)
 (defvar message-this-is-mail nil)
 (defvar message-buffer-list nil)
 (defvar message-this-is-news nil)
 (defvar message-this-is-mail nil)

+(defvar message-draft-article nil)

 
 ;; Byte-compiler warning
 (defvar gnus-active-hashtb)
 (defvar gnus-read-active-file)
 
 ;;; Regexp matching the delimiter of messages in UNIX mail format
 
 ;; Byte-compiler warning
 (defvar gnus-active-hashtb)
 (defvar gnus-read-active-file)
 
 ;;; Regexp matching the delimiter of messages in UNIX mail format

-;;; (UNIX From lines), minus the initial ^.  
+;;; (UNIX From lines), minus the initial ^.  It should be a copy
+;;; of rmail.el's rmail-unix-mail-delimiter.

 (defvar message-unix-mail-delimiter
   (let ((time-zone-regexp
         (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
 (defvar message-unix-mail-delimiter
   (let ((time-zone-regexp
         (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"


@@ -666,25 +844,39 @@ The cdr of ech entry is a function for applying the face to a region.")
     (concat
      "From "
 
     (concat
      "From "
 

-     ;; Username, perhaps with a quoted section that can contain spaces.
-     "\\("
-     "[^ \n]*"
-     "\\(\\|\".*\"[^ \n]*\\)"
-     "\\|<[^<>\n]+>"
-     "\\)  ?"
+     ;; Many things can happen to an RFC 822 mailbox before it is put into
+     ;; a `From' line.  The leading phrase can be stripped, e.g.
+     ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'.  The <> can be stripped, e.g.
+     ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'.  Everything starting with a CRLF
+     ;; can be removed, e.g.
+     ;;                From: joe@y.z (Joe      K
+     ;;                        User)
+     ;; can yield `From joe@y.z (Joe   K Fri Mar 22 08:11:15 1996', and
+     ;;                From: Joe User
+     ;;                        <joe@y.z>
+     ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
+     ;; The mailbox can be removed or be replaced by white space, e.g.
+     ;;                From: "Joe User"{space}{tab}
+     ;;                        <joe@y.z>
+     ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
+     ;; where {space} and {tab} represent the Ascii space and tab characters.
+     ;; We want to match the results of any of these manglings.
+     ;; The following regexp rejects names whose first characters are
+     ;; obviously bogus, but after that anything goes.
+     "\\([^\0-\b\n-\r\^?].*\\)? "

 
      ;; The time the message was sent.
 
      ;; The time the message was sent.

-     "\\([^ \n]*\\) *"                 ; day of the week
-     "\\([^ ]*\\) *"                   ; month
-     "\\([0-9]*\\) *"                  ; day of month
-     "\\([0-9:]*\\) *"                 ; time of day
+     "\\([^\0-\r \^?]+\\) +"                           ; day of the week
+     "\\([^\0-\r \^?]+\\) +"                           ; month
+     "\\([0-3]?[0-9]\\) +"                             ; day of month
+     "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day

 
      ;; Perhaps a time zone, specified by an abbreviation, or by a
      ;; numeric offset.
      time-zone-regexp
 
      ;; The year.
 
      ;; Perhaps a time zone, specified by an abbreviation, or by a
      ;; numeric offset.
      time-zone-regexp
 
      ;; The year.

-     " [0-9][0-9]\\([0-9]*\\) *"
+     " \\([0-9][0-9]+\\) *"

 
      ;; On some systems the time zone can appear after the year, too.
      time-zone-regexp
 
      ;; On some systems the time zone can appear after the year, too.
      time-zone-regexp


@@ -692,7 +884,8 @@ The cdr of ech entry is a function for applying the face to a region.")
      ;; Old uucp cruft.
      "\\(remote from .*\\)?"
 
      ;; Old uucp cruft.
      "\\(remote from .*\\)?"
 

-     "\n")))
+     "\n"))
+  "Regexp matching the delimiter of messages in UNIX mail format.")

 
 (defvar message-unsent-separator
   (concat "^ *---+ +Unsent message follows +---+ *$\\|"
 
 (defvar message-unsent-separator
   (concat "^ *---+ +Unsent message follows +---+ *$\\|"


@@ -704,9 +897,9 @@ The cdr of ech entry is a function for applying the face to a region.")
          "^|? *---+ +Message text follows: +---+ *|?$")
   "A regexp that matches the separator before the text of a failed message.")
 
          "^|? *---+ +Message text follows: +---+ *|?$")
   "A regexp that matches the separator before the text of a failed message.")
 

-(defvar message-header-format-alist 
+(defvar message-header-format-alist

   `((Newsgroups)
   `((Newsgroups)

-    (To . message-fill-address) 
+    (To . message-fill-address)

     (Cc . message-fill-address)
     (Subject)
     (In-Reply-To)
     (Cc . message-fill-address)
     (Subject)
     (In-Reply-To)


@@ -718,37 +911,33 @@ The cdr of ech entry is a function for applying the face to a region.")
     (Lines)
     (Expires)
     (Message-ID)
     (Lines)
     (Expires)
     (Message-ID)

-    (References)
+    (References . message-shorten-references)

     (X-Mailer)
     (X-Newsreader))
   "Alist used for formatting headers.")
 
 (eval-and-compile
   (autoload 'message-setup-toolbar "messagexmas")
     (X-Mailer)
     (X-Newsreader))
   "Alist used for formatting headers.")
 
 (eval-and-compile
   (autoload 'message-setup-toolbar "messagexmas")

-  (autoload 'mh-send-letter "mh-comp"))
+  (autoload 'mh-new-draft-name "mh-comp")
+  (autoload 'mh-send-letter "mh-comp")
+  (autoload 'gnus-point-at-eol "gnus-util")
+  (autoload 'gnus-point-at-bol "gnus-util")
+  (autoload 'gnus-output-to-mail "gnus-util")
+  (autoload 'gnus-output-to-rmail "gnus-util")
+  (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
+  (autoload 'nndraft-request-associate-buffer "nndraft")
+  (autoload 'nndraft-request-expire-articles "nndraft")
+  (autoload 'gnus-open-server "gnus-int")
+  (autoload 'gnus-request-post "gnus-int")
+  (autoload 'gnus-alive-p "gnus-util")
+  (autoload 'rmail-output "rmail"))

 
 \f
 
 
 \f
 

-;;; 
+;;;

 ;;; Utility functions.
 ;;;
 
 ;;; Utility functions.
 ;;;
 

-(defun message-point-at-bol ()
-  "Return point at the beginning of the line."
-  (let ((p (point)))
-    (beginning-of-line)
-    (prog1
-       (point)
-      (goto-char p))))
-
-(defun message-point-at-eol ()
-  "Return point at the end of the line."
-  (let ((p (point)))
-    (end-of-line)
-    (prog1
-       (point)
-      (goto-char p))))
-

 (defmacro message-y-or-n-p (question show &rest text)
   "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
   `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
 (defmacro message-y-or-n-p (question show &rest text)
   "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
   `(message-talkative-question 'y-or-n-p ,question ,show ,@text))


@@ -792,12 +981,36 @@ The cdr of ech entry is a function for applying the face to a region.")
                 (setq paren nil))))
        (nreverse elems)))))
 
                 (setq paren nil))))
        (nreverse elems)))))
 

-(defun message-fetch-field (header)
+(defun message-mail-file-mbox-p (file)
+  "Say whether FILE looks like a Unix mbox file."
+  (when (and (file-exists-p file)
+            (file-readable-p file)
+            (file-regular-p file))
+    (nnheader-temp-write nil
+      (nnheader-insert-file-contents file)
+      (goto-char (point-min))
+      (looking-at message-unix-mail-delimiter))))
+
+(defun message-fetch-field (header &optional not-all)

   "The same as `mail-fetch-field', only remove all newlines."
   "The same as `mail-fetch-field', only remove all newlines."

-  (let ((value (mail-fetch-field header nil t)))
+  (let* ((inhibit-point-motion-hooks t)
+        (value (mail-fetch-field header nil (not not-all))))

     (when value
       (nnheader-replace-chars-in-string value ?\n ? ))))
 
     (when value
       (nnheader-replace-chars-in-string value ?\n ? ))))
 

+(defun message-add-header (&rest headers)
+  "Add the HEADERS to the message header, skipping those already present."
+  (while headers
+    (let (hclean)
+      (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
+       (error "Invalid header `%s'" (car headers)))
+      (setq hclean (match-string 1 (car headers)))
+    (save-restriction
+      (message-narrow-to-headers)
+      (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
+       (insert (car headers) ?\n))))
+    (setq headers (cdr headers))))
+

 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (when (and message-reply-buffer
 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (when (and message-reply-buffer


@@ -818,11 +1031,12 @@ The cdr of ech entry is a function for applying the face to a region.")
 (defun message-functionp (form)
   "Return non-nil if FORM is funcallable."
   (or (and (symbolp form) (fboundp form))
 (defun message-functionp (form)
   "Return non-nil if FORM is funcallable."
   (or (and (symbolp form) (fboundp form))

-      (and (listp form) (eq (car form) 'lambda))))
+      (and (listp form) (eq (car form) 'lambda))
+      (byte-code-function-p form)))

 
 (defun message-strip-subject-re (subject)
   "Remove \"Re:\" from subject lines."
 
 (defun message-strip-subject-re (subject)
   "Remove \"Re:\" from subject lines."

-  (if (string-match "^[Rr][Ee]: *" subject)
+  (if (string-match message-subject-re-regexp subject)

       (substring subject (match-end 0))
     subject))
 
       (substring subject (match-end 0))
     subject))
 


@@ -832,7 +1046,7 @@ If REGEXP, HEADER is a regular expression.
 If FIRST, only remove the first instance of the header.
 Return the number of headers removed."
   (goto-char (point-min))
 If FIRST, only remove the first instance of the header.
 Return the number of headers removed."
   (goto-char (point-min))

-  (let ((regexp (if is-regexp header (concat "^" header ":")))
+  (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":")))

        (number 0)
        (case-fold-search t)
        last)
        (number 0)
        (case-fold-search t)
        last)


@@ -883,21 +1097,24 @@ Return the number of headers removed."
 
 (defun message-news-p ()
   "Say whether the current buffer contains a news message."
 
 (defun message-news-p ()
   "Say whether the current buffer contains a news message."

-  (or message-this-is-news
-      (save-excursion
-       (save-restriction
-         (message-narrow-to-headers)
-         (message-fetch-field "newsgroups")))))
+  (and (not message-this-is-mail)
+       (or message-this-is-news
+          (save-excursion
+            (save-restriction
+              (message-narrow-to-headers)
+              (and (message-fetch-field "newsgroups")
+                   (not (message-fetch-field "posted-to"))))))))

 
 (defun message-mail-p ()
   "Say whether the current buffer contains a mail message."
 
 (defun message-mail-p ()
   "Say whether the current buffer contains a mail message."

-  (or message-this-is-mail
-      (save-excursion
-       (save-restriction
-         (message-narrow-to-headers)
-         (or (message-fetch-field "to")
-             (message-fetch-field "cc")
-             (message-fetch-field "bcc"))))))
+  (and (not message-this-is-news)
+       (or message-this-is-mail
+          (save-excursion
+            (save-restriction
+              (message-narrow-to-headers)
+              (or (message-fetch-field "to")
+                  (message-fetch-field "cc")
+                  (message-fetch-field "bcc")))))))

 
 (defun message-next-header ()
   "Go to the beginning of the next header."
 
 (defun message-next-header ()
   "Go to the beginning of the next header."


@@ -906,12 +1123,12 @@ Return the number of headers removed."
   (not (if (re-search-forward "^[^ \t]" nil t)
           (beginning-of-line)
         (goto-char (point-max)))))
   (not (if (re-search-forward "^[^ \t]" nil t)
           (beginning-of-line)
         (goto-char (point-max)))))

-    
+

 (defun message-sort-headers-1 ()
   "Sort the buffer as headers using `message-rank' text props."
   (goto-char (point-min))
 (defun message-sort-headers-1 ()
   "Sort the buffer as headers using `message-rank' text props."
   (goto-char (point-min))

-  (sort-subr 
-   nil 'message-next-header 
+  (sort-subr
+   nil 'message-next-header

    (lambda ()
      (message-next-header)
      (unless (bobp)
    (lambda ()
      (message-next-header)
      (unless (bobp)


@@ -971,7 +1188,7 @@ Return the number of headers removed."
 
   (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
 
   (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)

-  
+

   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)


@@ -985,10 +1202,13 @@ Return the number of headers removed."
   (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
 
   (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
   (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
 
   (define-key message-mode-map "\C-c\C-e" 'message-elide-region)

+  (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
+  (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
+  (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)

 
   (define-key message-mode-map "\t" 'message-tab))
 
 
   (define-key message-mode-map "\t" 'message-tab))
 

-(easy-menu-define 
+(easy-menu-define

  message-mode-menu message-mode-map "Message Menu."
  '("Message"
    ["Sort Headers" message-sort-headers t]
  message-mode-menu message-mode-map "Message Menu."
  '("Message"
    ["Sort Headers" message-sort-headers t]


@@ -998,13 +1218,17 @@ Return the number of headers removed."
    ["Caesar (rot13) Message" message-caesar-buffer-body t]
    ["Caesar (rot13) Region" message-caesar-region (mark t)]
    ["Elide Region" message-elide-region (mark t)]
    ["Caesar (rot13) Message" message-caesar-buffer-body t]
    ["Caesar (rot13) Region" message-caesar-region (mark t)]
    ["Elide Region" message-elide-region (mark t)]

+   ["Delete Outside Region" message-delete-not-region (mark t)]
+   ["Kill To Signature" message-kill-to-signature t]
+   ["Newline and Reformat" message-newline-and-reformat t]

    ["Rename buffer" message-rename-buffer t]
    ["Spellcheck" ispell-message t]
    "----"
    ["Send Message" message-send-and-exit t]
    ["Rename buffer" message-rename-buffer t]
    ["Spellcheck" ispell-message t]
    "----"
    ["Send Message" message-send-and-exit t]

-   ["Abort Message" message-dont-send t]))
+   ["Abort Message" message-dont-send t]
+   ["Kill Message" message-kill-buffer t]))

 
 

-(easy-menu-define 
+(easy-menu-define

  message-mode-field-menu message-mode-map ""
  '("Field"
    ["Fetch To" message-insert-to t]
  message-mode-field-menu message-mode-map ""
  '("Field"
    ["Fetch To" message-insert-to t]


@@ -1045,23 +1269,24 @@ C-c C-w  message-insert-signature (insert `message-signature-file' file).
 C-c C-y  message-yank-original (insert current message, if any).
 C-c C-q  message-fill-yanked-message (fill what was yanked).
 C-c C-e  message-elide-region (elide the text between point and mark).
 C-c C-y  message-yank-original (insert current message, if any).
 C-c C-q  message-fill-yanked-message (fill what was yanked).
 C-c C-e  message-elide-region (elide the text between point and mark).

+C-c C-z  message-kill-to-signature (kill the text up to the signature).

 C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (interactive)
   (kill-all-local-variables)
   (make-local-variable 'message-reply-buffer)
   (setq message-reply-buffer nil)
 C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (interactive)
   (kill-all-local-variables)
   (make-local-variable 'message-reply-buffer)
   (setq message-reply-buffer nil)

-  (make-local-variable 'message-send-actions)
-  (make-local-variable 'message-exit-actions)
+  (make-local-variable 'message-send-actions) 
+  (make-local-variable 'message-exit-actions) 

   (make-local-variable 'message-kill-actions)
   (make-local-variable 'message-postpone-actions)
   (make-local-variable 'message-kill-actions)
   (make-local-variable 'message-postpone-actions)

+  (make-local-variable 'message-draft-article)
+  (make-local-hook 'kill-buffer-hook)

   (set-syntax-table message-mode-syntax-table)
   (use-local-map message-mode-map)
   (setq local-abbrev-table message-mode-abbrev-table)
   (setq major-mode 'message-mode)
   (setq mode-name "Message")
   (setq buffer-offer-save t)
   (set-syntax-table message-mode-syntax-table)
   (use-local-map message-mode-map)
   (setq local-abbrev-table message-mode-abbrev-table)
   (setq major-mode 'message-mode)
   (setq mode-name "Message")
   (setq buffer-offer-save t)

-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(message-font-lock-keywords t))

   (make-local-variable 'facemenu-add-face-function)
   (make-local-variable 'facemenu-remove-face-function)
   (setq facemenu-add-face-function
   (make-local-variable 'facemenu-add-face-function)
   (make-local-variable 'facemenu-remove-face-function)
   (setq facemenu-add-face-function


@@ -1074,14 +1299,18 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
        facemenu-remove-face-function t)
   (make-local-variable 'paragraph-separate)
   (make-local-variable 'paragraph-start)
        facemenu-remove-face-function t)
   (make-local-variable 'paragraph-separate)
   (make-local-variable 'paragraph-start)

-  (setq paragraph-start (concat (regexp-quote mail-header-separator)
-                               "$\\|[ \t]*[-_][-_][-_]+$\\|"
-                               "-- $\\|"
-                               paragraph-start))
-  (setq paragraph-separate (concat (regexp-quote mail-header-separator)
-                                  "$\\|[ \t]*[-_][-_][-_]+$\\|"
-                                  "-- $\\|"
-                                  paragraph-separate))
+  ;; `-- ' precedes the signature.  `-----' appears at the start of the
+  ;; lines that delimit forwarded messages.
+  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
+  ;; are also sometimes used and should be separators.
+  (setq paragraph-start
+       (concat (regexp-quote mail-header-separator)
+               "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
+               "-- $\\|---+$\\|"
+               page-delimiter
+               ;;!!! Uhm... shurely this can't be right?
+               "[> " (regexp-quote message-yank-prefix) "]+$"))
+  (setq paragraph-separate paragraph-start)

   (make-local-variable 'message-reply-headers)
   (setq message-reply-headers nil)
   (make-local-variable 'message-newsreader)
   (make-local-variable 'message-reply-headers)
   (setq message-reply-headers nil)
   (make-local-variable 'message-newsreader)


@@ -1096,10 +1325,25 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (when (string-match "XEmacs\\|Lucid" emacs-version)
     (message-setup-toolbar))
   (easy-menu-add message-mode-menu message-mode-map)
   (when (string-match "XEmacs\\|Lucid" emacs-version)
     (message-setup-toolbar))
   (easy-menu-add message-mode-menu message-mode-map)

+  (easy-menu-add message-mode-field-menu message-mode-map)

   ;; Allow mail alias things.
   ;; Allow mail alias things.

-  (if (fboundp 'mail-abbrevs-setup)
-      (mail-abbrevs-setup)
-    (funcall (intern "mail-aliases-setup")))
+  (when (eq message-mail-alias-type 'abbrev)
+    (if (fboundp 'mail-abbrevs-setup)
+       (mail-abbrevs-setup)
+      (mail-aliases-setup)))
+  (message-set-auto-save-file-name)
+  (unless (string-match "XEmacs" emacs-version)
+    (set (make-local-variable 'font-lock-defaults)
+        '(message-font-lock-keywords t)))
+  (make-local-variable 'adaptive-fill-regexp)
+  (setq adaptive-fill-regexp
+       (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp))
+  (unless (boundp 'adaptive-fill-first-line-regexp)
+    (setq adaptive-fill-first-line-regexp nil))
+  (make-local-variable 'adaptive-fill-first-line-regexp)
+  (setq adaptive-fill-first-line-regexp
+       (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|"
+               adaptive-fill-first-line-regexp))

   (run-hooks 'text-mode-hook 'message-mode-hook))
 
 \f
   (run-hooks 'text-mode-hook 'message-mode-hook))
 
 \f


@@ -1182,11 +1426,15 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
 
 \f
 
 
 \f
 

-(defun message-insert-to ()
-  "Insert a To header that points to the author of the article being replied to."
-  (interactive)
-  (let ((co (message-fetch-field "courtesy-copies-to")))
-    (when (and co 
+(defun message-insert-to (&optional force)
+  "Insert a To header that points to the author of the article being replied to.
+If the original author requested not to be sent mail, the function signals
+an error.
+With the prefix argument FORCE, insert the header anyway."
+  (interactive "P")
+  (let ((co (message-fetch-reply-field "mail-copies-to")))
+    (when (and (null force)
+              co

               (equal (downcase co) "never"))
       (error "The user has requested not to have copies sent via mail")))
   (when (and (message-position-on-field "To")
               (equal (downcase co) "never"))
       (error "The user has requested not to have copies sent via mail")))
   (when (and (message-position-on-field "To")


@@ -1209,10 +1457,52 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
 
 ;;; Various commands
 
 
 ;;; Various commands
 

+(defun message-delete-not-region (beg end)
+  "Delete everything in the body of the current message that is outside of the region."
+  (interactive "r")
+  (save-excursion
+    (goto-char end)
+    (delete-region (point) (progn (message-goto-signature)
+                                 (forward-line -2)
+                                 (point)))
+    (insert "\n")
+    (goto-char beg)
+    (delete-region beg (progn (message-goto-body)
+                             (forward-line 2)
+                             (point))))
+  (message-goto-signature)
+  (forward-line -2))
+
+(defun message-kill-to-signature ()
+  "Deletes all text up to the signature."
+  (interactive)
+  (let ((point (point)))
+    (message-goto-signature)
+    (unless (eobp)
+      (forward-line -2))
+    (kill-region point (point))
+    (unless (bolp)
+      (insert "\n"))))
+
+(defun message-newline-and-reformat ()
+  "Insert four newlines, and then reformat if inside quoted text."
+  (interactive)
+  (let ((point (point))
+       quoted)
+    (save-excursion
+      (beginning-of-line)
+      (setq quoted (looking-at (regexp-quote message-yank-prefix))))
+    (insert "\n\n\n\n")
+    (when quoted
+      (insert message-yank-prefix))
+    (fill-paragraph nil)
+    (goto-char point)
+    (forward-line 2)))
+

 (defun message-insert-signature (&optional force)
   "Insert a signature.  See documentation for the `message-signature' variable."
   (interactive (list 0))
 (defun message-insert-signature (&optional force)
   "Insert a signature.  See documentation for the `message-signature' variable."
   (interactive (list 0))

-  (let* ((signature 
+  (let* ((signature

          (cond
           ((and (null message-signature)
                 (eq force 0))
          (cond
           ((and (null message-signature)
                 (eq force 0))


@@ -1248,8 +1538,9 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
       (or (bolp) (insert "\n")))))
 
 (defun message-elide-region (b e)
       (or (bolp) (insert "\n")))))
 
 (defun message-elide-region (b e)

-  "Elide the text between point and mark.  An ellipsis (from
-message-elide-elipsis) will be inserted where the text was killed."
+  "Elide the text between point and mark.
+An ellipsis (from `message-elide-elipsis') will be inserted where the
+text was killed."

   (interactive "r")
   (kill-region b e)
   (unless (bolp)
   (interactive "r")
   (kill-region b e)
   (unless (bolp)


@@ -1273,31 +1564,34 @@ message-elide-elipsis) will be inserted where the text was killed."
     ;; We build the table, if necessary.
     (when (or (not message-caesar-translation-table)
              (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
     ;; We build the table, if necessary.
     (when (or (not message-caesar-translation-table)
              (/= (aref message-caesar-translation-table ?a) (+ ?a n)))

-      (let ((i -1) 
-           (table (make-string 256 0)))
-       (while (< (incf i) 256)
-         (aset table i i))
-       (setq table
-             (concat
-              (substring table 0 ?A)
-              (substring table (+ ?A n) (+ ?A n (- 26 n)))
-              (substring table ?A (+ ?A n))
-              (substring table (+ ?A 26) ?a)
-              (substring table (+ ?a n) (+ ?a n (- 26 n)))
-              (substring table ?a (+ ?a n))
-              (substring table (+ ?a 26) 255)))
-       (setq message-caesar-translation-table table)))
-    ;; Then we translate the region.  Do it this way to retain 
+       (setq message-caesar-translation-table
+             (message-make-caesar-translation-table n)))
+    ;; Then we translate the region.  Do it this way to retain

     ;; text properties.
     (while (< b e)
     ;; text properties.
     (while (< b e)

-      (subst-char-in-region 
+      (subst-char-in-region

        b (1+ b) (char-after b)
        (aref message-caesar-translation-table (char-after b)))
       (incf b))))
 
        b (1+ b) (char-after b)
        (aref message-caesar-translation-table (char-after b)))
       (incf b))))
 

+(defun message-make-caesar-translation-table (n)
+  "Create a rot table with offset N."
+  (let ((i -1)
+       (table (make-string 256 0)))
+    (while (< (incf i) 256)
+      (aset table i i))
+    (concat
+     (substring table 0 ?A)
+     (substring table (+ ?A n) (+ ?A n (- 26 n)))
+     (substring table ?A (+ ?A n))
+     (substring table (+ ?A 26) ?a)
+     (substring table (+ ?a n) (+ ?a n (- 26 n)))
+     (substring table ?a (+ ?a n))
+     (substring table (+ ?a 26) 255))))
+

 (defun message-caesar-buffer-body (&optional rotnum)
   "Caesar rotates all letters in the current buffer by 13 places.
 (defun message-caesar-buffer-body (&optional rotnum)
   "Caesar rotates all letters in the current buffer by 13 places.

-Used to encode/decode possibly offensive messages (commonly in net.jokes).
+Used to encode/decode possiblyun offensive messages (commonly in net.jokes).

 With prefix arg, specifies the number of places to rotate each letter forward.
 Mail and USENET news headers are not rotated."
   (interactive (if current-prefix-arg
 With prefix arg, specifies the number of places to rotate each letter forward.
 Mail and USENET news headers are not rotated."
   (interactive (if current-prefix-arg


@@ -1319,17 +1613,17 @@ Mail and USENET news headers are not rotated."
         (unless (equal 0 (call-process-region
                            (point-min) (point-max) program t t))
             (insert body)
         (unless (equal 0 (call-process-region
                            (point-min) (point-max) program t t))
             (insert body)

-            (gnus-message 1 "%s failed." program))))))
+            (message "%s failed." program))))))

 
 (defun message-rename-buffer (&optional enter-string)
 
 (defun message-rename-buffer (&optional enter-string)

-  "Rename the *message* buffer to \"*message* RECIPIENT\".  
+  "Rename the *message* buffer to \"*message* RECIPIENT\".

 If the function is run with a prefix, it will ask for a new buffer
 name, rather than giving an automatic name."
   (interactive "Pbuffer name: ")
   (save-excursion
     (save-restriction
       (goto-char (point-min))
 If the function is run with a prefix, it will ask for a new buffer
 name, rather than giving an automatic name."
   (interactive "Pbuffer name: ")
   (save-excursion
     (save-restriction
       (goto-char (point-min))

-      (narrow-to-region (point) 
+      (narrow-to-region (point)

                        (search-forward mail-header-separator nil 'end))
       (let* ((mail-to (or
                       (if (message-news-p) (message-fetch-field "Newsgroups")
                        (search-forward mail-header-separator nil 'end))
       (let* ((mail-to (or
                       (if (message-news-p) (message-fetch-field "Newsgroups")


@@ -1342,9 +1636,7 @@ name, rather than giving an automatic name."
             (name-default (concat "*message* " mail-trimmed-to))
             (name (if enter-string
                       (read-string "New buffer name: " name-default)
             (name-default (concat "*message* " mail-trimmed-to))
             (name (if enter-string
                       (read-string "New buffer name: " name-default)

-                    name-default))
-            (default-directory
-              (file-name-as-directory message-autosave-directory)))
+                    name-default)))

        (rename-buffer name t)))))
 
 (defun message-fill-yanked-message (&optional justifyp)
        (rename-buffer name t)))))
 
 (defun message-fill-yanked-message (&optional justifyp)


@@ -1367,14 +1659,20 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
   (let ((start (point)))
     ;; Remove unwanted headers.
     (when message-ignored-cited-headers
   (let ((start (point)))
     ;; Remove unwanted headers.
     (when message-ignored-cited-headers

-      (save-restriction
-       (narrow-to-region 
-        (goto-char start)
-        (if (search-forward "\n\n" nil t)
-            (1- (point))
-          (point)))
-       (message-remove-header message-ignored-cited-headers t)
-       (goto-char (point-max))))
+      (let (all-removed)
+       (save-restriction
+         (narrow-to-region
+          (goto-char start)
+          (if (search-forward "\n\n" nil t)
+              (1- (point))
+            (point)))
+         (message-remove-header message-ignored-cited-headers t)
+         (when (= (point-min) (point-max))
+           (setq all-removed t))
+         (goto-char (point-max)))
+       (if all-removed
+           (goto-char start)
+         (forward-line 1))))

     ;; Delete blank lines at the start of the buffer.
     (while (and (point-min)
                (eolp)
     ;; Delete blank lines at the start of the buffer.
     (while (and (point-min)
                (eolp)


@@ -1418,16 +1716,20 @@ prefix, and don't delete any headers."
       (unless (bolp)
        (insert ?\n))
       (unless modified
       (unless (bolp)
        (insert ?\n))
       (unless modified

-       (setq message-checksum (cons (message-checksum) (buffer-size)))))))
+       (setq message-checksum (message-checksum))))))

 
 

-(defun message-cite-original ()
+(defun message-cite-original-without-signature ()

   "Cite function in the standard Message manner."
   (let ((start (point))
   "Cite function in the standard Message manner."
   (let ((start (point))

-       (functions 
+       (end (mark t))
+       (functions

         (when message-indent-citation-function
           (if (listp message-indent-citation-function)
               message-indent-citation-function
             (list message-indent-citation-function)))))
         (when message-indent-citation-function
           (if (listp message-indent-citation-function)
               message-indent-citation-function
             (list message-indent-citation-function)))))

+    (goto-char end)
+    (when (re-search-backward "^-- $" start t)
+      (delete-region (point) end))

     (goto-char start)
     (while functions
       (funcall (pop functions)))
     (goto-char start)
     (while functions
       (funcall (pop functions)))


@@ -1436,6 +1738,25 @@ prefix, and don't delete any headers."
        (insert "\n"))
       (funcall message-citation-line-function))))
 
        (insert "\n"))
       (funcall message-citation-line-function))))
 

+(defun message-cite-original ()
+  "Cite function in the standard Message manner."
+  (if (and (boundp 'mail-citation-hook)
+          mail-citation-hook)
+      (run-hooks 'mail-citation-hook)
+    (let ((start (point))
+         (functions
+          (when message-indent-citation-function
+            (if (listp message-indent-citation-function)
+                message-indent-citation-function
+              (list message-indent-citation-function)))))
+      (goto-char start)
+      (while functions
+       (funcall (pop functions)))
+      (when message-citation-line-function
+       (unless (bolp)
+         (insert "\n"))
+       (funcall message-citation-line-function)))))
+

 (defun message-insert-citation-line ()
   "Function that inserts a simple citation line."
   (when message-reply-headers
 (defun message-insert-citation-line ()
   "Function that inserts a simple citation line."
   (when message-reply-headers


@@ -1447,7 +1768,7 @@ prefix, and don't delete any headers."
       (narrow-to-region
        (goto-char (point-min))
        (progn
       (narrow-to-region
        (goto-char (point-min))
        (progn

-        (re-search-forward 
+        (re-search-forward

          (concat "^" (regexp-quote mail-header-separator) "$"))
         (match-beginning 0)))
       (goto-char (point-min))
          (concat "^" (regexp-quote mail-header-separator) "$"))
         (match-beginning 0)))
       (goto-char (point-min))


@@ -1458,7 +1779,7 @@ prefix, and don't delete any headers."
            (skip-chars-backward "\n")
            t)
        (while (and afters
            (skip-chars-backward "\n")
            t)
        (while (and afters

-                   (not (re-search-forward 
+                   (not (re-search-forward

                          (concat "^" (regexp-quote (car afters)) ":")
                          nil t)))
          (pop afters))
                          (concat "^" (regexp-quote (car afters)) ":")
                          nil t)))
          (pop afters))


@@ -1514,6 +1835,8 @@ The text will also be indented the normal way."
 (defun message-dont-send ()
   "Don't send the message you have been editing."
   (interactive)
 (defun message-dont-send ()
   "Don't send the message you have been editing."
   (interactive)

+  (set-buffer-modified-p t)
+  (save-buffer)

   (let ((actions message-postpone-actions))
     (message-bury (current-buffer))
     (message-do-actions actions)))
   (let ((actions message-postpone-actions))
     (message-bury (current-buffer))
     (message-do-actions actions)))


@@ -1521,9 +1844,12 @@ The text will also be indented the normal way."
 (defun message-kill-buffer ()
   "Kill the current buffer."
   (interactive)
 (defun message-kill-buffer ()
   "Kill the current buffer."
   (interactive)

-  (let ((actions message-kill-actions))
-    (kill-buffer (current-buffer))
-    (message-do-actions actions)))
+  (when (or (not (buffer-modified-p))
+           (yes-or-no-p "Message modified; kill anyway? "))
+    (let ((actions message-kill-actions))
+      (setq buffer-file-name nil)
+      (kill-buffer (current-buffer))
+      (message-do-actions actions))))

 
 (defun message-bury (buffer)
   "Bury this mail buffer."
 
 (defun message-bury (buffer)
   "Bury this mail buffer."


@@ -1542,13 +1868,10 @@ or error messages, and inform user.
 Otherwise any failure is reported in a message back to
 the user from the mailer."
   (interactive "P")
 Otherwise any failure is reported in a message back to
 the user from the mailer."
   (interactive "P")

-  (when (if buffer-file-name
-           (y-or-n-p (format "Send buffer contents as %s message? "
-                             (if (message-mail-p)
-                                 (if (message-news-p) "mail and news" "mail")
-                               "news")))
-         (or (buffer-modified-p)
-             (y-or-n-p "No changes in the buffer; really send? ")))
+  ;; Disabled test.
+  (when (or (buffer-modified-p)
+           (message-check-element 'unchanged)
+           (y-or-n-p "No changes in the buffer; really send? "))

     ;; Make it possible to undo the coming changes.
     (undo-boundary)
     (let ((inhibit-read-only t))
     ;; Make it possible to undo the coming changes.
     (undo-boundary)
     (let ((inhibit-read-only t))


@@ -1556,30 +1879,43 @@ the user from the mailer."
     (message-fix-before-sending)
     (run-hooks 'message-send-hook)
     (message "Sending...")
     (message-fix-before-sending)
     (run-hooks 'message-send-hook)
     (message "Sending...")

-    (when (and (or (not (message-news-p))
-                  (and (or (not (memq 'news message-sent-message-via))
-                           (y-or-n-p
-                            "Already sent message via news; resend? "))
-                       (funcall message-send-news-function arg)))
-              (or (not (message-mail-p))
-                  (and (or (not (memq 'mail message-sent-message-via))
-                           (y-or-n-p
-                            "Already sent message via mail; resend? "))
-                       (message-send-mail arg))))
-      (message-do-fcc)
-      ;;(when (fboundp 'mail-hist-put-headers-into-history)
-      ;; (mail-hist-put-headers-into-history))
-      (run-hooks 'message-sent-hook)
-      (message "Sending...done")
-      ;; If buffer has no file, mark it as unmodified and delete autosave.
-      (unless buffer-file-name
+    (let ((alist message-send-method-alist)
+         (success t)
+         elem sent)
+      (while (and success
+                 (setq elem (pop alist)))
+       (when (and (or (not (funcall (cadr elem)))
+                      (and (or (not (memq (car elem)
+                                          message-sent-message-via))
+                               (y-or-n-p
+                                (format
+                                 "Already sent message via %s; resend? "
+                                 (car elem))))
+                           (setq success (funcall (caddr elem) arg)))))
+         (setq sent t)))
+      (when (and success sent)
+       (message-do-fcc)
+       ;;(when (fboundp 'mail-hist-put-headers-into-history)
+       ;; (mail-hist-put-headers-into-history))
+       (run-hooks 'message-sent-hook)
+       (message "Sending...done")
+       ;; Mark the buffer as unmodified and delete autosave.

        (set-buffer-modified-p nil)
        (set-buffer-modified-p nil)

-       (delete-auto-save-file-if-necessary t))
-      ;; Delete other mail buffers and stuff.
-      (message-do-send-housekeeping)
-      (message-do-actions message-send-actions)
-      ;; Return success.
-      t)))
+       (delete-auto-save-file-if-necessary t)
+       (message-disassociate-draft)
+       ;; Delete other mail buffers and stuff.
+       (message-do-send-housekeeping)
+       (message-do-actions message-send-actions)
+       ;; Return success.
+       t))))
+
+(defun message-send-via-mail (arg)
+  "Send the current message via mail."
+  (message-send-mail arg))
+
+(defun message-send-via-news (arg)
+  "Send the current message via news."
+  (funcall message-send-news-function arg))

 
 (defun message-fix-before-sending ()
   "Do various things to make the message nice before sending it."
 
 (defun message-fix-before-sending ()
   "Do various things to make the message nice before sending it."


@@ -1600,7 +1936,7 @@ the user from the mailer."
   ;; Now perform actions on successful sending.
   (while actions
     (ignore-errors
   ;; Now perform actions on successful sending.
   (while actions
     (ignore-errors

-      (cond 
+      (cond

        ;; A simple function.
        ((message-functionp (car actions))
        (funcall (car actions)))
        ;; A simple function.
        ((message-functionp (car actions))
        (funcall (car actions)))


@@ -1628,7 +1964,7 @@ the user from the mailer."
          (set-buffer tembuf)
          (erase-buffer)
          ;; Avoid copying text props.
          (set-buffer tembuf)
          (erase-buffer)
          ;; Avoid copying text props.

-         (insert (format 
+         (insert (format

                   "%s" (save-excursion
                          (set-buffer mailbuf)
                          (buffer-string))))
                   "%s" (save-excursion
                          (set-buffer mailbuf)
                          (buffer-string))))


@@ -1677,7 +2013,8 @@ the user from the mailer."
        (save-excursion
          (set-buffer errbuf)
          (erase-buffer))))
        (save-excursion
          (set-buffer errbuf)
          (erase-buffer))))

-    (let ((default-directory "/"))
+    (let ((default-directory "/")
+         (coding-system-for-write 'binary))

       (apply 'call-process-region
             (append (list (point-min) (point-max)
                           (if (boundp 'sendmail-program)
       (apply 'call-process-region
             (append (list (point-min) (point-max)
                           (if (boundp 'sendmail-program)


@@ -1725,49 +2062,47 @@ to find out how to use this."
   (run-hooks 'message-send-mail-hook)
   ;; send the message
   (case
   (run-hooks 'message-send-mail-hook)
   ;; send the message
   (case

-      (apply
-       'call-process-region 1 (point-max) message-qmail-inject-program
-       nil nil nil
-       ;; qmail-inject's default behaviour is to look for addresses on the
-       ;; command line; if there're none, it scans the headers.
-       ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
-       ;;
-       ;; in general, ALL of qmail-inject's defaults are perfect for simply
-       ;; reading a formatted (i. e., at least a To: or Resent-To header)
-       ;; message from stdin.
-       ;;
-       ;; qmail also has the advantage of not having been raped by
-       ;; various vendors, so we don't have to allow for that, either --
-       ;; compare this with message-send-mail-with-sendmail and weep 
-       ;; for sendmail's lost innocence.
-       ;;
-       ;; all this is way cool coz it lets us keep the arguments entirely
-       ;; free for -inject-arguments -- a big win for the user and for us
-       ;; since we don't have to play that double-guessing game and the user
-       ;; gets full control (no gestapo'ish -f's, for instance).  --sj
-       message-qmail-inject-args)
+      (let ((coding-system-for-write 'binary))
+       (apply
+        'call-process-region 1 (point-max) message-qmail-inject-program
+        nil nil nil
+        ;; qmail-inject's default behaviour is to look for addresses on the
+        ;; command line; if there're none, it scans the headers.
+        ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
+        ;;
+        ;; in general, ALL of qmail-inject's defaults are perfect for simply
+        ;; reading a formatted (i. e., at least a To: or Resent-To header)
+        ;; message from stdin.
+        ;;
+        ;; qmail also has the advantage of not having been raped by
+        ;; various vendors, so we don't have to allow for that, either --
+        ;; compare this with message-send-mail-with-sendmail and weep
+        ;; for sendmail's lost innocence.
+        ;;
+        ;; all this is way cool coz it lets us keep the arguments entirely
+        ;; free for -inject-arguments -- a big win for the user and for us
+        ;; since we don't have to play that double-guessing game and the user
+        ;; gets full control (no gestapo'ish -f's, for instance).  --sj
+        message-qmail-inject-args))

     ;; qmail-inject doesn't say anything on it's stdout/stderr,
     ;; we have to look at the retval instead
     (0 nil)
     ;; qmail-inject doesn't say anything on it's stdout/stderr,
     ;; we have to look at the retval instead
     (0 nil)

-    (1   (error "qmail-inject reported permanent failure."))
-    (111 (error "qmail-inject reported transient failure."))
+    (1   (error "qmail-inject reported permanent failure"))
+    (111 (error "qmail-inject reported transient failure"))

     ;; should never happen
     ;; should never happen

-    (t   (error "qmail-inject reported unknown failure."))))
+    (t   (error "qmail-inject reported unknown failure"))))

 
 (defun message-send-mail-with-mh ()
   "Send the prepared message buffer with mh."
   (let ((mh-previous-window-config nil)
 
 (defun message-send-mail-with-mh ()
   "Send the prepared message buffer with mh."
   (let ((mh-previous-window-config nil)

-       (name (make-temp-name
-              (concat (file-name-as-directory 
-                       (expand-file-name message-autosave-directory))
-                      "msg."))))
+       (name (mh-new-draft-name)))

     (setq buffer-file-name name)
     ;; MH wants to generate these headers itself.
     (setq buffer-file-name name)
     ;; MH wants to generate these headers itself.

-    (when message-delete-mh-headers
-      (let ((headers message-deletable-headers))
+    (when message-mh-deletable-headers
+      (let ((headers message-mh-deletable-headers))

        (while headers
        (while headers

-         (goto-char (point-min)) 
-         (and (re-search-forward 
+         (goto-char (point-min))
+         (and (re-search-forward

                (concat "^" (symbol-name (car headers)) ": *") nil t)
               (message-delete-line))
          (pop headers))))
                (concat "^" (symbol-name (car headers)) ": *") nil t)
               (message-delete-line))
          (pop headers))))


@@ -1803,9 +2138,9 @@ to find out how to use this."
          (save-excursion
            (set-buffer tembuf)
            (buffer-disable-undo (current-buffer))
          (save-excursion
            (set-buffer tembuf)
            (buffer-disable-undo (current-buffer))

-           (erase-buffer) 
+           (erase-buffer)

            ;; Avoid copying text props.
            ;; Avoid copying text props.

-           (insert (format 
+           (insert (format

                     "%s" (save-excursion
                            (set-buffer messbuf)
                            (buffer-string))))
                     "%s" (save-excursion
                            (set-buffer messbuf)
                            (buffer-string))))


@@ -1826,11 +2161,14 @@ to find out how to use this."
              (replace-match "\n")
              (backward-char 1))
            (run-hooks 'message-send-news-hook)
              (replace-match "\n")
              (backward-char 1))
            (run-hooks 'message-send-news-hook)

-           (require (car method))
-           (funcall (intern (format "%s-open-server" (car method)))
-                    (cadr method) (cddr method))
-           (setq result
-                 (funcall (intern (format "%s-request-post" (car method))))))
+           ;;(require (car method))
+           ;;(funcall (intern (format "%s-open-server" (car method)))
+           ;;(cadr method) (cddr method))
+           ;;(setq result
+           ;;    (funcall (intern (format "%s-request-post" (car method)))
+           ;;             (cadr method)))
+           (gnus-open-server method)
+           (setq result (gnus-request-post method)))

        (kill-buffer tembuf))
       (set-buffer messbuf)
       (if result
        (kill-buffer tembuf))
       (set-buffer messbuf)
       (if result


@@ -1865,7 +2203,7 @@ to find out how to use this."
   (save-excursion
     (save-restriction
       (widen)
   (save-excursion
     (save-restriction
       (widen)

-      (and 
+      (and

        ;; We narrow to the headers and check them first.
        (save-excursion
         (save-restriction
        ;; We narrow to the headers and check them first.
        (save-excursion
         (save-restriction


@@ -1875,7 +2213,17 @@ to find out how to use this."
        (message-check-news-body-syntax)))))
 
 (defun message-check-news-header-syntax ()
        (message-check-news-body-syntax)))))
 
 (defun message-check-news-header-syntax ()

-  (and 
+  (and
+   ;; Check the Subject header.
+   (message-check 'subject
+     (let* ((case-fold-search t)
+           (subject (message-fetch-field "subject")))
+       (or
+       (and subject
+            (not (string-match "\\`[ \t]*\\'" subject)))
+       (ignore
+        (message
+         "The subject field is empty or missing.  Posting is denied.")))))

    ;; Check for commands in Subject.
    (message-check 'subject-cmsg
      (if (string-match "^cmsg " (message-fetch-field "subject"))
    ;; Check for commands in Subject.
    (message-check 'subject-cmsg
      (if (string-match "^cmsg " (message-fetch-field "subject"))


@@ -1885,11 +2233,11 @@ to find out how to use this."
    ;; Check for multiple identical headers.
    (message-check 'multiple-headers
      (let (found)
    ;; Check for multiple identical headers.
    (message-check 'multiple-headers
      (let (found)

-       (while (and (not found) 
+       (while (and (not found)

                   (re-search-forward "^[^ \t:]+: " nil t))
         (save-excursion
                   (re-search-forward "^[^ \t:]+: " nil t))
         (save-excursion

-          (or (re-search-forward 
-               (concat "^" 
+          (or (re-search-forward
+               (concat "^"

                        (regexp-quote
                         (setq found
                               (buffer-substring
                        (regexp-quote
                         (setq found
                               (buffer-substring


@@ -1905,7 +2253,7 @@ to find out how to use this."
      (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
         (y-or-n-p
          (format "The article contains a %s command.  Really post? "
      (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
         (y-or-n-p
          (format "The article contains a %s command.  Really post? "

-                 (buffer-substring (match-beginning 0) 
+                 (buffer-substring (match-beginning 0)

                                    (1- (match-end 0)))))
        t))
    ;; See whether we can shorten Followup-To.
                                    (1- (match-end 0)))))
        t))
    ;; See whether we can shorten Followup-To.


@@ -1919,11 +2267,11 @@ to find out how to use this."
                  (not
                   (zerop
                    (length
                  (not
                   (zerop
                    (length

-                    (setq to (completing-read 
-                              "Followups to: (default all groups) " 
+                    (setq to (completing-read
+                              "Followups to: (default all groups) "

                               (mapcar (lambda (g) (list g))
                               (mapcar (lambda (g) (list g))

-                                      (cons "poster" 
-                                            (message-tokenize-header 
+                                      (cons "poster"
+                                            (message-tokenize-header

                                              newsgroups)))))))))
         (goto-char (point-min))
         (insert "Followup-To: " to "\n"))
                                              newsgroups)))))))))
         (goto-char (point-min))
         (insert "Followup-To: " to "\n"))


@@ -1942,23 +2290,17 @@ to find out how to use this."
    ;; Check the Message-ID header.
    (message-check 'message-id
      (let* ((case-fold-search t)
    ;; Check the Message-ID header.
    (message-check 'message-id
      (let* ((case-fold-search t)

-           (message-id (message-fetch-field "message-id")))
+           (message-id (message-fetch-field "message-id" t)))

        (or (not message-id)
        (or (not message-id)

+          ;; Is there an @ in the ID?

           (and (string-match "@" message-id)
           (and (string-match "@" message-id)

-               (string-match "@[^\\.]*\\." message-id))
+               ;; Is there a dot in the ID?
+               (string-match "@[^.]*\\." message-id)
+               ;; Does the ID end with a dot?
+               (not (string-match "\\.>" message-id)))

           (y-or-n-p
            (format "The Message-ID looks strange: \"%s\".  Really post? "
                    message-id)))))
           (y-or-n-p
            (format "The Message-ID looks strange: \"%s\".  Really post? "
                    message-id)))))

-   ;; Check the Subject header.
-   (message-check 'subject
-     (let* ((case-fold-search t)
-           (subject (message-fetch-field "subject")))
-       (or
-       (and subject
-            (not (string-match "\\`[ \t]*\\'" subject)))
-       (ignore
-        (message 
-         "The subject field is empty or missing.  Posting is denied.")))))

    ;; Check the Newsgroups & Followup-To headers.
    (message-check 'existing-newsgroups
      (let* ((case-fold-search t)
    ;; Check the Newsgroups & Followup-To headers.
    (message-check 'existing-newsgroups
      (let* ((case-fold-search t)


@@ -1997,12 +2339,12 @@ to find out how to use this."
        (while (and headers (not error))
         (when (setq header (mail-fetch-field (car headers)))
           (if (or
        (while (and headers (not error))
         (when (setq header (mail-fetch-field (car headers)))
           (if (or

-               (not 
+               (not

                 (string-match
                  "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
                  header))
                 (string-match
                  "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
                  header))

-               (memq 
-                nil (mapcar 
+               (memq
+                nil (mapcar

                      (lambda (g)
                        (not (string-match "\\.\\'\\|\\.\\." g)))
                      (message-tokenize-header header ","))))
                      (lambda (g)
                        (not (string-match "\\.\\'\\|\\.\\." g)))
                      (message-tokenize-header header ","))))


@@ -2014,6 +2356,22 @@ to find out how to use this."
         (y-or-n-p
          (format "The %s header looks odd: \"%s\".  Really post? "
                  (car headers) header)))))
         (y-or-n-p
          (format "The %s header looks odd: \"%s\".  Really post? "
                  (car headers) header)))))

+   (message-check 'repeated-newsgroups
+     (let ((case-fold-search t)
+          (headers '("Newsgroups" "Followup-To"))
+          header error groups group)
+       (while (and headers
+                  (not error))
+        (when (setq header (mail-fetch-field (pop headers)))
+          (setq groups (message-tokenize-header header ","))
+          (while (setq group (pop groups))
+            (when (member group groups)
+              (setq error group
+                    groups nil)))))
+       (if (not error)
+          t
+        (y-or-n-p
+         (format "Group %s is repeated in headers.  Really post? " error)))))

    ;; Check the From header.
    (message-check 'from
      (let* ((case-fold-search t)
    ;; Check the From header.
    (message-check 'from
      (let* ((case-fold-search t)


@@ -2065,7 +2423,7 @@ to find out how to use this."
    ;; Check for control characters.
    (message-check 'control-chars
      (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
    ;; Check for control characters.
    (message-check 'control-chars
      (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)

-        (y-or-n-p 
+        (y-or-n-p

          "The article contains control characters.  Really post? ")
        t))
    ;; Check excessive size.
          "The article contains control characters.  Really post? ")
        t))
    ;; Check excessive size.


@@ -2079,8 +2437,7 @@ to find out how to use this."
    (message-check 'new-text
      (or
       (not message-checksum)
    (message-check 'new-text
      (or
       (not message-checksum)

-      (not (and (eq (message-checksum) (car message-checksum))
-               (eq (buffer-size) (cdr message-checksum))))
+      (not (eq (message-checksum) message-checksum))

       (y-or-n-p
        "It looks like no new text has been added.  Really post? ")))
    ;; Check the length of the signature.
       (y-or-n-p
        "It looks like no new text has been added.  Really post? ")))
    ;; Check the length of the signature.


@@ -2105,7 +2462,8 @@ to find out how to use this."
        (concat "^" (regexp-quote mail-header-separator) "$"))
       (while (not (eobp))
        (when (not (looking-at "[ \t\n]"))
        (concat "^" (regexp-quote mail-header-separator) "$"))
       (while (not (eobp))
        (when (not (looking-at "[ \t\n]"))

-         (setq sum (logxor (ash sum 1) (following-char))))
+         (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
+                           (following-char))))

        (forward-char 1)))
     sum))
 
        (forward-char 1)))
     sum))
 


@@ -2146,58 +2504,72 @@ to find out how to use this."
                (rmail-output file 1 nil t)
              (let ((mail-use-rfc822 t))
                (rmail-output file 1 t t))))))
                (rmail-output file 1 nil t)
              (let ((mail-use-rfc822 t))
                (rmail-output file 1 t t))))))

+

       (kill-buffer (current-buffer)))))
 
       (kill-buffer (current-buffer)))))
 

+(defun message-output (filename)
+  "Append this article to Unix/babyl mail file.."
+  (if (and (file-readable-p filename)
+          (mail-file-babyl-p filename))
+      (gnus-output-to-rmail filename t)
+    (gnus-output-to-mail filename t)))
+

 (defun message-cleanup-headers ()
   "Do various automatic cleanups of the headers."
   ;; Remove empty lines in the header.
   (save-restriction
     (message-narrow-to-headers)
 (defun message-cleanup-headers ()
   "Do various automatic cleanups of the headers."
   ;; Remove empty lines in the header.
   (save-restriction
     (message-narrow-to-headers)

+    ;; Remove blank lines.

     (while (re-search-forward "^[ \t]*\n" nil t)
     (while (re-search-forward "^[ \t]*\n" nil t)

-      (replace-match "" t t)))
+      (replace-match "" t t))

 
 

-  ;; Correct Newsgroups and Followup-To headers: change sequence of
-  ;; spaces to comma and eliminate spaces around commas.  Eliminate
-  ;; embedded line breaks.
-  (goto-char (point-min))
-  (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
-    (save-restriction
-      (narrow-to-region
-       (point)
-       (if (re-search-forward "^[^ \t]" nil t)
-          (match-beginning 0)
-        (forward-line 1)
-        (point)))
-      (goto-char (point-min))
-      (while (re-search-forward "\n[ \t]+" nil t)
-       (replace-match " " t t))        ;No line breaks (too confusing)
-      (goto-char (point-min))
-      (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
-       (replace-match "," t t))
-      (goto-char (point-min))
-      ;; Remove trailing commas.
-      (when (re-search-forward ",+$" nil t)
-       (replace-match "" t t)))))
+    ;; Correct Newsgroups and Followup-To headers:  Change sequence of
+    ;; spaces to comma and eliminate spaces around commas.  Eliminate
+    ;; embedded line breaks.
+    (goto-char (point-min))
+    (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
+      (save-restriction
+       (narrow-to-region
+        (point)
+        (if (re-search-forward "^[^ \t]" nil t)
+            (match-beginning 0)
+          (forward-line 1)
+          (point)))
+       (goto-char (point-min))
+       (while (re-search-forward "\n[ \t]+" nil t)
+         (replace-match " " t t))      ;No line breaks (too confusing)
+       (goto-char (point-min))
+       (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
+         (replace-match "," t t))
+       (goto-char (point-min))
+       ;; Remove trailing commas.
+       (when (re-search-forward ",+$" nil t)
+         (replace-match "" t t))))))

 
 (defun message-make-date ()
   "Make a valid data header."
   (let ((now (current-time)))
 
 (defun message-make-date ()
   "Make a valid data header."
   (let ((now (current-time)))

-    (timezone-make-date-arpa-standard 
+    (timezone-make-date-arpa-standard

      (current-time-string now) (current-time-zone now))))
 
 (defun message-make-message-id ()
   "Make a unique Message-ID."
      (current-time-string now) (current-time-zone now))))
 
 (defun message-make-message-id ()
   "Make a unique Message-ID."

-  (concat "<" (message-unique-id) 
-         (let ((psubject (save-excursion (message-fetch-field "subject"))))
-           (if (and message-reply-headers
-                    (mail-header-references message-reply-headers)
-                    (mail-header-subject message-reply-headers)
-                    psubject
-                    (mail-header-subject message-reply-headers)
-                    (not (string= 
-                          (message-strip-subject-re
-                           (mail-header-subject message-reply-headers))
-                          (message-strip-subject-re psubject))))
+  (concat "<" (message-unique-id)
+         (let ((psubject (save-excursion (message-fetch-field "subject")))
+               (psupersedes
+                (save-excursion (message-fetch-field "supersedes"))))
+           (if (or
+                (and message-reply-headers
+                     (mail-header-references message-reply-headers)
+                     (mail-header-subject message-reply-headers)
+                     psubject
+                     (mail-header-subject message-reply-headers)
+                     (not (string=
+                           (message-strip-subject-re
+                            (mail-header-subject message-reply-headers))
+                           (message-strip-subject-re psubject))))
+                (and psupersedes
+                     (string-match "_-_@" psupersedes)))

                "_-_" ""))
          "@" (message-make-fqdn) ">"))
 
                "_-_" ""))
          "@" (message-make-fqdn) ">"))
 


@@ -2223,7 +2595,7 @@ to find out how to use this."
             (aset user (match-beginning 0) ?_))
           user)
        (message-number-base36 (user-uid) -1))
             (aset user (match-beginning 0) ?_))
           user)
        (message-number-base36 (user-uid) -1))

-     (message-number-base36 (+ (car   tm) 
+     (message-number-base36 (+ (car   tm)

                               (lsh (% message-unique-id-char 25) 16)) 4)
      (message-number-base36 (+ (nth 1 tm)
                               (lsh (/ message-unique-id-char 25) 16)) 4)
                               (lsh (% message-unique-id-char 25) 16)) 4)
      (message-number-base36 (+ (nth 1 tm)
                               (lsh (/ message-unique-id-char 25) 16)) 4)


@@ -2233,7 +2605,9 @@ to find out how to use this."
      ".fsf")))
 
 (defun message-number-base36 (num len)
      ".fsf")))
 
 (defun message-number-base36 (num len)

-  (if (if (< len 0) (<= num 0) (= len 0))
+  (if (if (< len 0)
+         (<= num 0)
+       (= len 0))

       ""
     (concat (message-number-base36 (/ num 36) (1- len))
            (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
       ""
     (concat (message-number-base36 (/ num 36) (1- len))
            (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"


@@ -2241,12 +2615,11 @@ to find out how to use this."
 
 (defun message-make-organization ()
   "Make an Organization header."
 
 (defun message-make-organization ()
   "Make an Organization header."

-  (let* ((organization 
-         (or (getenv "ORGANIZATION")
-             (when message-user-organization
+  (let* ((organization
+         (when message-user-organization

                (if (message-functionp message-user-organization)
                    (funcall message-user-organization)
                (if (message-functionp message-user-organization)
                    (funcall message-user-organization)

-                 message-user-organization)))))
+                 message-user-organization))))

     (save-excursion
       (message-set-work-buffer)
       (cond ((stringp organization)
     (save-excursion
       (message-set-work-buffer)
       (cond ((stringp organization)


@@ -2267,7 +2640,7 @@ to find out how to use this."
     (save-restriction
       (widen)
       (goto-char (point-min))
     (save-restriction
       (widen)
       (goto-char (point-min))

-      (re-search-forward 
+      (re-search-forward

        (concat "^" (regexp-quote mail-header-separator) "$"))
       (forward-line 1)
       (int-to-string (count-lines (point) (point-max))))))
        (concat "^" (regexp-quote mail-header-separator) "$"))
       (forward-line 1)
       (int-to-string (count-lines (point) (point-max))))))


@@ -2278,12 +2651,15 @@ to find out how to use this."
     (let ((from (mail-header-from message-reply-headers))
          (date (mail-header-date message-reply-headers)))
       (when from
     (let ((from (mail-header-from message-reply-headers))
          (date (mail-header-date message-reply-headers)))
       (when from

-       (let ((stop-pos 
+       (let ((stop-pos

               (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
               (string-match "  *at \\|  *@ \\| *(\\| *<" from)))

-         (concat (if stop-pos (substring from 0 stop-pos) from)
-                 "'s message of " 
+         (concat (if (and stop-pos
+                          (not (zerop stop-pos)))
+                     (substring from 0 stop-pos) from)
+                 "'s message of \""

                  (if (or (not date) (string= date ""))
                  (if (or (not date) (string= date ""))

-                     "(unknown date)" date)))))))
+                     "(unknown date)" date)
+                 "\""))))))

 
 (defun message-make-distribution ()
   "Make a Distribution header."
 
 (defun message-make-distribution ()
   "Make a Distribution header."


@@ -2300,7 +2676,7 @@ to find out how to use this."
     (setcar current (+ (car current) (round (/ future (expt 2 16)))))
     (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
     ;; Return the date in the future in UT.
     (setcar current (+ (car current) (round (/ future (expt 2 16)))))
     (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
     ;; Return the date in the future in UT.

-    (timezone-make-date-arpa-standard 
+    (timezone-make-date-arpa-standard

      (current-time-string current) (current-time-zone current) '(0 "UT"))))
 
 (defun message-make-path ()
      (current-time-string current) (current-time-zone current) '(0 "UT"))))
 
 (defun message-make-path ()


@@ -2315,8 +2691,9 @@ to find out how to use this."
 
 (defun message-make-from ()
   "Make a From header."
 
 (defun message-make-from ()
   "Make a From header."

-  (let* ((login (message-make-address))
-        (fullname 
+  (let* ((style message-from-style)
+        (login (message-make-address))
+        (fullname

          (or (and (boundp 'user-full-name)
                   user-full-name)
              (user-full-name))))
          (or (and (boundp 'user-full-name)
                   user-full-name)
              (user-full-name))))


@@ -2324,12 +2701,12 @@ to find out how to use this."
       (setq fullname (user-login-name)))
     (save-excursion
       (message-set-work-buffer)
       (setq fullname (user-login-name)))
     (save-excursion
       (message-set-work-buffer)

-      (cond 
-       ((or (null message-from-style)
+      (cond
+       ((or (null style)

            (equal fullname ""))
        (insert login))
            (equal fullname ""))
        (insert login))

-       ((or (eq message-from-style 'angles)
-           (and (not (eq message-from-style 'parens))
+       ((or (eq style 'angles)
+           (and (not (eq style 'parens))

                 ;; Use angles if no quoting is needed, or if parens would
                 ;; need quoting too.
                 (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))
                 ;; Use angles if no quoting is needed, or if parens would
                 ;; need quoting too.
                 (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))


@@ -2363,7 +2740,7 @@ to find out how to use this."
          ;; ... then undo escaping of matching parentheses,
          ;; including matching nested parentheses.
          (goto-char fullname-start)
          ;; ... then undo escaping of matching parentheses,
          ;; including matching nested parentheses.
          (goto-char fullname-start)

-         (while (re-search-forward 
+         (while (re-search-forward

                  "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
                  nil 1)
            (replace-match "\\1(\\3)" t)
                  "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
                  nil 1)
            (replace-match "\\1(\\3)" t)


@@ -2373,7 +2750,7 @@ to find out how to use this."
 
 (defun message-make-sender ()
   "Return the \"real\" user address.
 
 (defun message-make-sender ()
   "Return the \"real\" user address.

-This function tries to ignore all user modifications, and 
+This function tries to ignore all user modifications, and

 give as trustworthy answer as possible."
   (concat (user-login-name) "@" (system-name)))
 
 give as trustworthy answer as possible."
   (concat (user-login-name) "@" (system-name)))
 


@@ -2393,7 +2770,7 @@ give as trustworthy answer as possible."
   "Return user's fully qualified domain name."
   (let ((system-name (system-name))
        (user-mail (message-user-mail-address)))
   "Return user's fully qualified domain name."
   (let ((system-name (system-name))
        (user-mail (message-user-mail-address)))

-    (cond 
+    (cond

      ((string-match "[^.]\\.[^.]" system-name)
       ;; `system-name' returned the right result.
       system-name)
      ((string-match "[^.]\\.[^.]" system-name)
       ;; `system-name' returned the right result.
       system-name)


@@ -2403,7 +2780,8 @@ give as trustworthy answer as possible."
           (string-match "\\." mail-host-address))
       mail-host-address)
      ;; We try `user-mail-address' as a backup.
           (string-match "\\." mail-host-address))
       mail-host-address)
      ;; We try `user-mail-address' as a backup.

-     ((and (string-match "\\." user-mail)
+     ((and user-mail
+          (string-match "\\." user-mail)

           (string-match "@\\(.*\\)\\'" user-mail))
       (match-string 1 user-mail))
      ;; Default to this bogus thing.
           (string-match "@\\(.*\\)\\'" user-mail))
       (match-string 1 user-mail))
      ;; Default to this bogus thing.


@@ -2445,9 +2823,11 @@ Headers already prepared in the buffer are not modified."
           header value elem)
       ;; First we remove any old generated headers.
       (let ((headers message-deletable-headers))
           header value elem)
       ;; First we remove any old generated headers.
       (let ((headers message-deletable-headers))

+       (unless (buffer-modified-p)
+         (setq headers (delq 'Message-ID (copy-sequence headers))))

        (while headers
          (goto-char (point-min))
        (while headers
          (goto-char (point-min))

-         (and (re-search-forward 
+         (and (re-search-forward

                (concat "^" (symbol-name (car headers)) ": *") nil t)
               (get-text-property (1+ (match-beginning 0)) 'message-deletable)
               (message-delete-line))
                (concat "^" (symbol-name (car headers)) ": *") nil t)
               (get-text-property (1+ (match-beginning 0)) 'message-deletable)
               (message-delete-line))


@@ -2455,7 +2835,7 @@ Headers already prepared in the buffer are not modified."
       ;; Go through all the required headers and see if they are in the
       ;; articles already.  If they are not, or are empty, they are
       ;; inserted automatically - except for Subject, Newsgroups and
       ;; Go through all the required headers and see if they are in the
       ;; articles already.  If they are not, or are empty, they are
       ;; inserted automatically - except for Subject, Newsgroups and

-      ;; Distribution. 
+      ;; Distribution.

       (while headers
        (goto-char (point-min))
        (setq elem (pop headers))
       (while headers
        (goto-char (point-min))
        (setq elem (pop headers))


@@ -2464,8 +2844,14 @@ Headers already prepared in the buffer are not modified."
                (setq header (cdr elem))
              (setq header (car elem)))
          (setq header elem))
                (setq header (cdr elem))
              (setq header (car elem)))
          (setq header elem))

-       (when (or (not (re-search-forward 
-                       (concat "^" (downcase (symbol-name header)) ":") 
+       (when (or (not (re-search-forward
+                       (concat "^"
+                               (regexp-quote
+                                (downcase
+                                 (if (stringp header)
+                                     header
+                                   (symbol-name header))))
+                               ":")

                        nil t))
                  (progn
                    ;; The header was found.  We insert a space after the
                        nil t))
                  (progn
                    ;; The header was found.  We insert a space after the


@@ -2475,7 +2861,7 @@ Headers already prepared in the buffer are not modified."
                    (looking-at "[ \t]*$")))
          ;; So we find out what value we should insert.
          (setq value
                    (looking-at "[ \t]*$")))
          ;; So we find out what value we should insert.
          (setq value

-               (cond 
+               (cond

                 ((and (consp elem) (eq (car elem) 'optional))
                  ;; This is an optional header.  If the cdr of this
                  ;; is something that is nil, then we do not insert
                 ((and (consp elem) (eq (car elem) 'optional))
                  ;; This is an optional header.  If the cdr of this
                  ;; is something that is nil, then we do not insert


@@ -2500,48 +2886,51 @@ Headers already prepared in the buffer are not modified."
                  (read-from-minibuffer
                   (format "Empty header for %s; enter value: " header)))))
          ;; Finally insert the header.
                  (read-from-minibuffer
                   (format "Empty header for %s; enter value: " header)))))
          ;; Finally insert the header.

-         (when (and value 
+         (when (and value

                     (not (equal value "")))
            (save-excursion
              (if (bolp)
                  (progn
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))
                     (not (equal value "")))
            (save-excursion
              (if (bolp)
                  (progn
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))

-                   (insert (symbol-name header) ": " value "\n")
+                   (insert (if (stringp header) header (symbol-name header))
+                           ": " value "\n")

                    (forward-line -1))
                ;; The value of this header was empty, so we clear
                ;; totally and insert the new value.
                    (forward-line -1))
                ;; The value of this header was empty, so we clear
                ;; totally and insert the new value.

-               (delete-region (point) (message-point-at-eol))
+               (delete-region (point) (gnus-point-at-eol))

                (insert value))
              ;; Add the deletable property to the headers that require it.
              (and (memq header message-deletable-headers)
                   (progn (beginning-of-line) (looking-at "[^:]+: "))
                (insert value))
              ;; Add the deletable property to the headers that require it.
              (and (memq header message-deletable-headers)
                   (progn (beginning-of-line) (looking-at "[^:]+: "))

-                  (add-text-properties 
+                  (add-text-properties

                    (point) (match-end 0)
                    '(message-deletable t face italic) (current-buffer)))))))
                    (point) (match-end 0)
                    '(message-deletable t face italic) (current-buffer)))))))

-      ;; Insert new Sender if the From is strange. 
+      ;; Insert new Sender if the From is strange.

       (let ((from (message-fetch-field "from"))
            (sender (message-fetch-field "sender"))
            (secure-sender (message-make-sender)))
       (let ((from (message-fetch-field "from"))
            (sender (message-fetch-field "sender"))
            (secure-sender (message-make-sender)))

-       (when (and from 
+       (when (and from

                   (not (message-check-element 'sender))
                   (not (string=
                         (downcase
                          (cadr (mail-extract-address-components from)))
                         (downcase secure-sender)))
                   (or (null sender)
                   (not (message-check-element 'sender))
                   (not (string=
                         (downcase
                          (cadr (mail-extract-address-components from)))
                         (downcase secure-sender)))
                   (or (null sender)

-                      (not 
+                      (not

                        (string=
                         (downcase
                          (cadr (mail-extract-address-components sender)))
                         (downcase secure-sender)))))
                        (string=
                         (downcase
                          (cadr (mail-extract-address-components sender)))
                         (downcase secure-sender)))))

-         (goto-char (point-min))    
+         (goto-char (point-min))

          ;; Rename any old Sender headers to Original-Sender.
          (when (re-search-forward "^\\(Original-\\)*Sender:" nil t)
            (beginning-of-line)
            (insert "Original-")
            (beginning-of-line))
          ;; Rename any old Sender headers to Original-Sender.
          (when (re-search-forward "^\\(Original-\\)*Sender:" nil t)
            (beginning-of-line)
            (insert "Original-")
            (beginning-of-line))

-         (insert "Sender: " secure-sender "\n"))))))
+         (when (or (message-news-p)
+                   (string-match "@.+\\.." secure-sender))
+           (insert "Sender: " secure-sender "\n")))))))

 
 (defun message-insert-courtesy-copy ()
   "Insert a courtesy message in mail copies of combined messages."
 
 (defun message-insert-courtesy-copy ()
   "Insert a courtesy message in mail copies of combined messages."


@@ -2559,7 +2948,7 @@ Headers already prepared in the buffer are not modified."
          (insert (format message-courtesy-message newsgroups)))
         (t
          (insert message-courtesy-message)))))))
          (insert (format message-courtesy-message newsgroups)))
         (t
          (insert message-courtesy-message)))))))

-    
+

 ;;;
 ;;; Setting up a message buffer
 ;;;
 ;;;
 ;;; Setting up a message buffer
 ;;;


@@ -2596,7 +2985,7 @@ Headers already prepared in the buffer are not modified."
 
 (defun message-fill-header (header value)
   (let ((begin (point))
 
 (defun message-fill-header (header value)
   (let ((begin (point))

-       (fill-column 78)
+       (fill-column 990)

        (fill-prefix "\t"))
     (insert (capitalize (symbol-name header))
            ": "
        (fill-prefix "\t"))
     (insert (capitalize (symbol-name header))
            ": "


@@ -2615,10 +3004,28 @@ Headers already prepared in the buffer are not modified."
        (replace-match " " t t))
       (goto-char (point-max)))))
 
        (replace-match " " t t))
       (goto-char (point-max)))))
 

+(defun message-shorten-references (header references)
+  "Limit REFERENCES to be shorter than 988 characters."
+  (let ((max 988)
+       (cut 4)
+       refs)
+    (nnheader-temp-write nil
+      (insert references)
+      (goto-char (point-min))
+      (while (re-search-forward "<[^>]+>" nil t)
+       (push (match-string 0) refs))
+      (setq refs (nreverse refs))
+      (while (> (length (mapconcat 'identity refs " ")) max)
+       (when (< (length refs) (1+ cut))
+         (decf cut))
+       (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs)))))
+    (insert (capitalize (symbol-name header)) ": "
+           (mapconcat 'identity refs " ") "\n")))
+

 (defun message-position-point ()
   "Move point to where the user probably wants to find it."
   (message-narrow-to-headers)
 (defun message-position-point ()
   "Move point to where the user probably wants to find it."
   (message-narrow-to-headers)

-  (cond 
+  (cond

    ((re-search-forward "^[^:]+:[ \t]*$" nil t)
     (search-backward ":" )
     (widen)
    ((re-search-forward "^[^:]+:[ \t]*$" nil t)
     (search-backward ":" )
     (widen)


@@ -2637,7 +3044,7 @@ Headers already prepared in the buffer are not modified."
 (defun message-buffer-name (type &optional to group)
   "Return a new (unique) buffer name based on TYPE and TO."
   (cond
 (defun message-buffer-name (type &optional to group)
   "Return a new (unique) buffer name based on TYPE and TO."
   (cond

-   ;; Check whether `message-generate-new-buffers' is a function, 
+   ;; Check whether `message-generate-new-buffers' is a function,

    ;; and if so, call it.
    ((message-functionp message-generate-new-buffers)
     (funcall message-generate-new-buffers type to group))
    ;; and if so, call it.
    ((message-functionp message-generate-new-buffers)
     (funcall message-generate-new-buffers type to group))


@@ -2658,7 +3065,8 @@ Headers already prepared in the buffer are not modified."
 
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."
 
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."

-  (let ((buffer (get-buffer name)))
+  (let ((buffer (get-buffer name))
+       (cur (current-buffer)))

     (if (and buffer
             (buffer-name buffer))
        (progn
     (if (and buffer
             (buffer-name buffer))
        (progn


@@ -2667,9 +3075,9 @@ Headers already prepared in the buffer are not modified."
                     (not (y-or-n-p
                           "Message already being composed; erase? ")))
            (error "Message being composed")))
                     (not (y-or-n-p
                           "Message already being composed; erase? ")))
            (error "Message being composed")))

-      (set-buffer (pop-to-buffer name))))
-  (erase-buffer)
-  (message-mode))
+      (set-buffer (pop-to-buffer name)))
+    (erase-buffer)
+    (message-mode)))

 
 (defun message-do-send-housekeeping ()
   "Kill old message buffers."
 
 (defun message-do-send-housekeeping ()
   "Kill old message buffers."


@@ -2688,11 +3096,11 @@ Headers already prepared in the buffer are not modified."
   (if message-send-rename-function
       (funcall message-send-rename-function)
     (when (string-match "\\`\\*" (buffer-name))
   (if message-send-rename-function
       (funcall message-send-rename-function)
     (when (string-match "\\`\\*" (buffer-name))

-      (rename-buffer 
+      (rename-buffer

        (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
   ;; Push the current buffer onto the list.
   (when message-max-buffers
        (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
   ;; Push the current buffer onto the list.
   (when message-max-buffers

-    (setq message-buffer-list 
+    (setq message-buffer-list

          (nconc message-buffer-list (list (current-buffer))))))
 
 (defvar mc-modes-alist)
          (nconc message-buffer-list (list (current-buffer))))))
 
 (defvar mc-modes-alist)


@@ -2707,7 +3115,7 @@ Headers already prepared in the buffer are not modified."
   (setq message-reply-buffer replybuffer)
   (goto-char (point-min))
   ;; Insert all the headers.
   (setq message-reply-buffer replybuffer)
   (goto-char (point-min))
   ;; Insert all the headers.

-  (mail-header-format 
+  (mail-header-format

    (let ((h headers)
         (alist message-header-format-alist))
      (while h
    (let ((h headers)
         (alist message-header-format-alist))
      (while h


@@ -2718,7 +3126,8 @@ Headers already prepared in the buffer are not modified."
    headers)
   (delete-region (point) (progn (forward-line -1) (point)))
   (when message-default-headers
    headers)
   (delete-region (point) (progn (forward-line -1) (point)))
   (when message-default-headers

-    (insert message-default-headers))
+    (insert message-default-headers)
+    (or (bolp) (insert ?\n)))

   (put-text-property
    (point)
    (progn
   (put-text-property
    (point)
    (progn


@@ -2728,7 +3137,8 @@ Headers already prepared in the buffer are not modified."
   (forward-line -1)
   (when (message-news-p)
     (when message-default-news-headers
   (forward-line -1)
   (when (message-news-p)
     (when message-default-news-headers

-      (insert message-default-news-headers))
+      (insert message-default-news-headers)
+      (or (bolp) (insert ?\n)))

     (when message-generate-headers-first
       (message-generate-headers
        (delq 'Lines
     (when message-generate-headers-first
       (message-generate-headers
        (delq 'Lines


@@ -2736,7 +3146,8 @@ Headers already prepared in the buffer are not modified."
                   (copy-sequence message-required-news-headers))))))
   (when (message-mail-p)
     (when message-default-mail-headers
                   (copy-sequence message-required-news-headers))))))
   (when (message-mail-p)
     (when message-default-mail-headers

-      (insert message-default-mail-headers))
+      (insert message-default-mail-headers)
+      (or (bolp) (insert ?\n)))

     (when message-generate-headers-first
       (message-generate-headers
        (delq 'Lines
     (when message-generate-headers-first
       (message-generate-headers
        (delq 'Lines


@@ -2744,11 +3155,11 @@ Headers already prepared in the buffer are not modified."
                   (copy-sequence message-required-mail-headers))))))
   (run-hooks 'message-signature-setup-hook)
   (message-insert-signature)
                   (copy-sequence message-required-mail-headers))))))
   (run-hooks 'message-signature-setup-hook)
   (message-insert-signature)

-  (message-set-auto-save-file-name)

   (save-restriction
     (message-narrow-to-headers)
     (run-hooks 'message-header-setup-hook))
   (set-buffer-modified-p nil)
   (save-restriction
     (message-narrow-to-headers)
     (run-hooks 'message-header-setup-hook))
   (set-buffer-modified-p nil)

+  (setq buffer-undo-list nil)

   (run-hooks 'message-setup-hook)
   (message-position-point)
   (undo-boundary))
   (run-hooks 'message-setup-hook)
   (message-position-point)
   (undo-boundary))


@@ -2756,20 +3167,19 @@ Headers already prepared in the buffer are not modified."
 (defun message-set-auto-save-file-name ()
   "Associate the message buffer with a file in the drafts directory."
   (when message-autosave-directory
 (defun message-set-auto-save-file-name ()
   "Associate the message buffer with a file in the drafts directory."
   (when message-autosave-directory

-    (unless (file-exists-p message-autosave-directory)
-      (make-directory message-autosave-directory t))
-    (let ((name (make-temp-name
-                (concat (file-name-as-directory message-autosave-directory)
-                        "msg."))))
-      (setq buffer-auto-save-file-name
-           (save-excursion
-             (prog1
-                 (progn
-                   (set-buffer (get-buffer-create " *draft tmp*"))
-                   (setq buffer-file-name name)
-                   (make-auto-save-file-name))
-               (kill-buffer (current-buffer)))))
-      (clear-visited-file-modtime))))
+    (if (gnus-alive-p)
+       (setq message-draft-article
+             (nndraft-request-associate-buffer "drafts"))
+      (setq buffer-file-name (expand-file-name "*message*"
+                                              message-autosave-directory))
+      (setq buffer-auto-save-file-name (make-auto-save-file-name)))
+    (clear-visited-file-modtime)))
+
+(defun message-disassociate-draft ()
+  "Disassociate the message buffer from the drafts directory."
+  (when message-draft-article
+    (nndraft-request-expire-articles
+     (list message-draft-article) "drafts" nil t)))

 
 \f
 
 
 \f
 


@@ -2785,10 +3195,10 @@ Headers already prepared in the buffer are not modified."
   (interactive)
   (let ((message-this-is-mail t))
     (message-pop-to-buffer (message-buffer-name "mail" to))
   (interactive)
   (let ((message-this-is-mail t))
     (message-pop-to-buffer (message-buffer-name "mail" to))

-    (message-setup 
+    (message-setup

      (nconc
       `((To . ,(or to "")) (Subject . ,(or subject "")))
      (nconc
       `((To . ,(or to "")) (Subject . ,(or subject "")))

-      (when other-headers (list other-headers))))))
+      (when other-headers other-headers)))))

 
 ;;;###autoload
 (defun message-news (&optional newsgroups subject)
 
 ;;;###autoload
 (defun message-news (&optional newsgroups subject)


@@ -2796,16 +3206,16 @@ Headers already prepared in the buffer are not modified."
   (interactive)
   (let ((message-this-is-news t))
     (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
   (interactive)
   (let ((message-this-is-news t))
     (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))

-    (message-setup `((Newsgroups . ,(or newsgroups "")) 
+    (message-setup `((Newsgroups . ,(or newsgroups ""))

                     (Subject . ,(or subject ""))))))
 
 ;;;###autoload
                     (Subject . ,(or subject ""))))))
 
 ;;;###autoload

-(defun message-reply (&optional to-address wide ignore-reply-to)
+(defun message-reply (&optional to-address wide)

   "Start editing a reply to the article in the current buffer."
   (interactive)
   (let ((cur (current-buffer))
        from subject date reply-to to cc
   "Start editing a reply to the article in the current buffer."
   (interactive)
   (let ((cur (current-buffer))
        from subject date reply-to to cc

-       references message-id follow-to 
+       references message-id follow-to

        (inhibit-point-motion-hooks t)
        mct never-mct gnus-warning)
     (save-restriction
        (inhibit-point-motion-hooks t)
        mct never-mct gnus-warning)
     (save-restriction


@@ -2822,24 +3232,24 @@ Headers already prepared in the buffer are not modified."
                    (funcall message-wide-reply-to-function)))))
       ;; Find all relevant headers we need.
       (setq from (message-fetch-field "from")
                    (funcall message-wide-reply-to-function)))))
       ;; Find all relevant headers we need.
       (setq from (message-fetch-field "from")

-           date (message-fetch-field "date") 
+           date (message-fetch-field "date")

            subject (or (message-fetch-field "subject") "none")
            to (message-fetch-field "to")
            cc (message-fetch-field "cc")
            mct (message-fetch-field "mail-copies-to")
            subject (or (message-fetch-field "subject") "none")
            to (message-fetch-field "to")
            cc (message-fetch-field "cc")
            mct (message-fetch-field "mail-copies-to")

-           reply-to (unless ignore-reply-to (message-fetch-field "reply-to"))
+           reply-to (message-fetch-field "reply-to")

            references (message-fetch-field "references")
            references (message-fetch-field "references")

-           message-id (message-fetch-field "message-id"))
+           message-id (message-fetch-field "message-id" t))

       ;; Remove any (buggy) Re:'s that are present and make a
       ;; proper one.
       ;; Remove any (buggy) Re:'s that are present and make a
       ;; proper one.

-      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+      (when (string-match message-subject-re-regexp subject)

        (setq subject (substring subject (match-end 0))))
       (setq subject (concat "Re: " subject))
 
       (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
                 (string-match "<[^>]+>" gnus-warning))
        (setq message-id (match-string 0 gnus-warning)))
        (setq subject (substring subject (match-end 0))))
       (setq subject (concat "Re: " subject))
 
       (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
                 (string-match "<[^>]+>" gnus-warning))
        (setq message-id (match-string 0 gnus-warning)))

-           
+

       ;; Handle special values of Mail-Copies-To.
       (when mct
        (cond ((equal (downcase mct) "never")
       ;; Handle special values of Mail-Copies-To.
       (when mct
        (cond ((equal (downcase mct) "never")


@@ -2851,19 +3261,28 @@ Headers already prepared in the buffer are not modified."
       (unless follow-to
        (if (or (not wide)
                to-address)
       (unless follow-to
        (if (or (not wide)
                to-address)

-           (setq follow-to (list (cons 'To (or to-address reply-to from))))
+           (progn
+             (setq follow-to (list (cons 'To (or to-address reply-to from))))
+             (when (and wide mct)
+               (push (cons 'Cc mct) follow-to)))

          (let (ccalist)
            (save-excursion
              (message-set-work-buffer)
              (unless never-mct
                (insert (or reply-to from "")))
          (let (ccalist)
            (save-excursion
              (message-set-work-buffer)
              (unless never-mct
                (insert (or reply-to from "")))

-             (insert (if (bolp) "" ", ") (or to ""))
+             (insert (if to (concat (if (bolp) "" ", ") to "") ""))

              (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
              (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
              (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
              (insert (if cc (concat (if (bolp) "" ", ") cc) ""))

-             ;; Remove addresses that match `rmail-dont-reply-to-names'. 
+             (goto-char (point-min))
+             (while (re-search-forward "[ \t]+" nil t)
+               (replace-match " " t t))
+             ;; Remove addresses that match `rmail-dont-reply-to-names'.

              (insert (prog1 (rmail-dont-reply-to (buffer-string))
                        (erase-buffer)))
              (goto-char (point-min))
              (insert (prog1 (rmail-dont-reply-to (buffer-string))
                        (erase-buffer)))
              (goto-char (point-min))

+             ;; Perhaps Mail-Copies-To: never removed the only address?
+             (when (eobp)
+               (insert (or reply-to from "")))

              (setq ccalist
                    (mapcar
                     (lambda (addr)
              (setq ccalist
                    (mapcar
                     (lambda (addr)


@@ -2874,7 +3293,7 @@ Headers already prepared in the buffer are not modified."
                  (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
            (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
            (when ccalist
                  (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
            (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
            (when ccalist

-             (let ((ccs (cons 'Cc (mapconcat 
+             (let ((ccs (cons 'Cc (mapconcat

                                    (lambda (addr) (cdr addr)) ccalist ", "))))
                (when (string-match "^ +" (cdr ccs))
                  (setcdr ccs (substring (cdr ccs) (match-end 0))))
                                    (lambda (addr) (cdr addr)) ccalist ", "))))
                (when (string-match "^ +" (cdr ccs))
                  (setcdr ccs (substring (cdr ccs) (match-end 0))))


@@ -2890,7 +3309,7 @@ Headers already prepared in the buffer are not modified."
 
     (message-setup
      `((Subject . ,subject)
 
     (message-setup
      `((Subject . ,subject)

-       ,@follow-to 
+       ,@follow-to

        ,@(if (or references message-id)
             `((References . ,(concat (or references "") (and references " ")
                                      (or message-id ""))))
        ,@(if (or references message-id)
             `((References . ,(concat (or references "") (and references " ")
                                      (or message-id ""))))


@@ -2910,10 +3329,10 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
   (interactive)
   (let ((cur (current-buffer))
        from subject date reply-to mct
   (interactive)
   (let ((cur (current-buffer))
        from subject date reply-to mct

-       references message-id follow-to 
+       references message-id follow-to

        (inhibit-point-motion-hooks t)
        (message-this-is-news t)
        (inhibit-point-motion-hooks t)
        (message-this-is-news t)

-       followup-to distribution newsgroups gnus-warning)
+       followup-to distribution newsgroups gnus-warning posted-to)

     (save-restriction
       (narrow-to-region
        (goto-char (point-min))
     (save-restriction
       (narrow-to-region
        (goto-char (point-min))


@@ -2924,12 +3343,13 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
        (setq follow-to
              (funcall message-followup-to-function)))
       (setq from (message-fetch-field "from")
        (setq follow-to
              (funcall message-followup-to-function)))
       (setq from (message-fetch-field "from")

-           date (message-fetch-field "date") 
+           date (message-fetch-field "date")

            subject (or (message-fetch-field "subject") "none")
            references (message-fetch-field "references")
            subject (or (message-fetch-field "subject") "none")
            references (message-fetch-field "references")

-           message-id (message-fetch-field "message-id")
+           message-id (message-fetch-field "message-id" t)

            followup-to (message-fetch-field "followup-to")
            newsgroups (message-fetch-field "newsgroups")
            followup-to (message-fetch-field "followup-to")
            newsgroups (message-fetch-field "newsgroups")

+           posted-to (message-fetch-field "posted-to")

            reply-to (message-fetch-field "reply-to")
            distribution (message-fetch-field "distribution")
            mct (message-fetch-field "mail-copies-to"))
            reply-to (message-fetch-field "reply-to")
            distribution (message-fetch-field "distribution")
            mct (message-fetch-field "mail-copies-to"))


@@ -2943,7 +3363,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
        (setq distribution nil))
       ;; Remove any (buggy) Re:'s that are present and make a
       ;; proper one.
        (setq distribution nil))
       ;; Remove any (buggy) Re:'s that are present and make a
       ;; proper one.

-      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+      (when (string-match message-subject-re-regexp subject)

        (setq subject (substring subject (match-end 0))))
       (setq subject (concat "Re: " subject))
       (widen))
        (setq subject (substring subject (match-end 0))))
       (setq subject (concat "Re: " subject))
       (widen))


@@ -2952,13 +3372,13 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
 
     (message-setup
      `((Subject . ,subject)
 
     (message-setup
      `((Subject . ,subject)

-       ,@(cond 
+       ,@(cond

          (to-newsgroups
           (list (cons 'Newsgroups to-newsgroups)))
          (follow-to follow-to)
          ((and followup-to message-use-followup-to)
           (list
          (to-newsgroups
           (list (cons 'Newsgroups to-newsgroups)))
          (follow-to follow-to)
          ((and followup-to message-use-followup-to)
           (list

-           (cond 
+           (cond

             ((equal (downcase followup-to) "poster")
              (if (or (eq message-use-followup-to 'use)
                      (message-y-or-n-p "Obey Followup-To: poster? " t "\
             ((equal (downcase followup-to) "poster")
              (if (or (eq message-use-followup-to 'use)
                      (message-y-or-n-p "Obey Followup-To: poster? " t "\


@@ -2968,7 +3388,9 @@ You should normally obey the Followup-To: header.
 
 A typical situation where `Followup-To: poster' is used is when the poster
 does not read the newsgroup, so he wouldn't see any replies sent to it."))
 
 A typical situation where `Followup-To: poster' is used is when the poster
 does not read the newsgroup, so he wouldn't see any replies sent to it."))

-                 (cons 'To (or reply-to from ""))
+                 (progn
+                   (setq message-this-is-news nil)
+                   (cons 'To (or reply-to from "")))

                (cons 'Newsgroups newsgroups)))
             (t
              (if (or (equal followup-to newsgroups)
                (cons 'Newsgroups newsgroups)))
             (t
              (if (or (equal followup-to newsgroups)


@@ -2991,6 +3413,8 @@ Also, some source/announcement newsgroups are not indented for discussion;
 responses here are directed to other newsgroups."))
                  (cons 'Newsgroups followup-to)
                (cons 'Newsgroups newsgroups))))))
 responses here are directed to other newsgroups."))
                  (cons 'Newsgroups followup-to)
                (cons 'Newsgroups newsgroups))))))

+         (posted-to
+          `((Newsgroups . ,posted-to)))

          (t
           `((Newsgroups . ,newsgroups))))
        ,@(and distribution (list (cons 'Distribution distribution)))
          (t
           `((Newsgroups . ,newsgroups))))
        ,@(and distribution (list (cons 'Distribution distribution)))


@@ -3016,19 +3440,25 @@ responses here are directed to other newsgroups."))
   (unless (message-news-p)
     (error "This is not a news article; canceling is impossible"))
   (when (yes-or-no-p "Do you really want to cancel this article? ")
   (unless (message-news-p)
     (error "This is not a news article; canceling is impossible"))
   (when (yes-or-no-p "Do you really want to cancel this article? ")

-    (let (from newsgroups message-id distribution buf)
+    (let (from newsgroups message-id distribution buf sender)

       (save-excursion
        ;; Get header info. from original article.
        (save-restriction
          (message-narrow-to-head)
          (setq from (message-fetch-field "from")
       (save-excursion
        ;; Get header info. from original article.
        (save-restriction
          (message-narrow-to-head)
          (setq from (message-fetch-field "from")

+               sender (message-fetch-field "sender")

                newsgroups (message-fetch-field "newsgroups")
                newsgroups (message-fetch-field "newsgroups")

-               message-id (message-fetch-field "message-id")
+               message-id (message-fetch-field "message-id" t)

                distribution (message-fetch-field "distribution")))
        ;; Make sure that this article was written by the user.
                distribution (message-fetch-field "distribution")))
        ;; Make sure that this article was written by the user.

-       (unless (string-equal
-                (downcase (cadr (mail-extract-address-components from)))
-                (downcase (message-make-address)))
+       (unless (or (and sender
+                        (string-equal
+                         (downcase sender)
+                         (downcase (message-make-sender))))
+                   (string-equal
+                    (downcase (cadr (mail-extract-address-components from)))
+                    (downcase (cadr (mail-extract-address-components
+                                     (message-make-from))))))

          (error "This article is not yours"))
        ;; Make control message.
        (setq buf (set-buffer (get-buffer-create " *message cancel*")))
          (error "This article is not yours"))
        ;; Make control message.
        (setq buf (set-buffer (get-buffer-create " *message cancel*")))


@@ -3044,9 +3474,10 @@ responses here are directed to other newsgroups."))
                mail-header-separator "\n"
                message-cancel-message)
        (message "Canceling your article...")
                mail-header-separator "\n"
                message-cancel-message)
        (message "Canceling your article...")

-       (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
-         (funcall message-send-news-function))
-       (message "Canceling your article...done")
+       (if (let ((message-syntax-checks
+                  'dont-check-for-anything-just-trust-me))
+             (funcall message-send-news-function))
+           (message "Canceling your article...done"))

        (kill-buffer buf)))))
 
 ;;;###autoload
        (kill-buffer buf)))))
 
 ;;;###autoload


@@ -3056,11 +3487,12 @@ This is done simply by taking the old article and adding a Supersedes
 header line with the old Message-ID."
   (interactive)
   (let ((cur (current-buffer)))
 header line with the old Message-ID."
   (interactive)
   (let ((cur (current-buffer)))

-    ;; Check whether the user owns the article that is to be superseded. 
+    ;; Check whether the user owns the article that is to be superseded.

     (unless (string-equal
     (unless (string-equal

-            (downcase (cadr (mail-extract-address-components
-                             (message-fetch-field "from"))))
-            (downcase (message-make-address)))
+            (downcase (or (message-fetch-field "sender")
+                          (cadr (mail-extract-address-components
+                                 (message-fetch-field "from")))))
+            (downcase (message-make-sender)))

       (error "This article is not yours"))
     ;; Get a normal message buffer.
     (message-pop-to-buffer (message-buffer-name "supersede"))
       (error "This article is not yours"))
     ;; Get a normal message buffer.
     (message-pop-to-buffer (message-buffer-name "supersede"))


@@ -3104,14 +3536,14 @@ header line with the old Message-ID."
     (save-restriction
       (current-buffer)
       (message-narrow-to-head)
     (save-restriction
       (current-buffer)
       (message-narrow-to-head)

-      (concat "[" (or (message-fetch-field 
+      (concat "[" (or (message-fetch-field

                       (if (message-news-p) "newsgroups" "from"))
                      "(nowhere)")
              "] " (or (message-fetch-field "Subject") "")))))
 
 ;;;###autoload
 (defun message-forward (&optional news)
                       (if (message-news-p) "newsgroups" "from"))
                      "(nowhere)")
              "] " (or (message-fetch-field "Subject") "")))))
 
 ;;;###autoload
 (defun message-forward (&optional news)

-  "Forward the current message via mail.  
+  "Forward the current message via mail.

 Optional NEWS will use news to forward instead of mail."
   (interactive "P")
   (let ((cur (current-buffer))
 Optional NEWS will use news to forward instead of mail."
   (interactive "P")
   (let ((cur (current-buffer))


@@ -3119,7 +3551,7 @@ Optional NEWS will use news to forward instead of mail."
        art-beg)
     (if news (message-news nil subject) (message-mail nil subject))
     ;; Put point where we want it before inserting the forwarded
        art-beg)
     (if news (message-news nil subject) (message-mail nil subject))
     ;; Put point where we want it before inserting the forwarded

-    ;; message. 
+    ;; message.

     (if message-signature-before-forwarded-message
        (goto-char (point-max))
       (message-goto-body))
     (if message-signature-before-forwarded-message
        (goto-char (point-max))
       (message-goto-body))


@@ -3180,9 +3612,13 @@ Optional NEWS will use news to forward instead of mail."
        (goto-char (point-max)))
       (insert mail-header-separator)
       ;; Rename all old ("Also-")Resent headers.
        (goto-char (point-max)))
       (insert mail-header-separator)
       ;; Rename all old ("Also-")Resent headers.

-      (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
+      (while (re-search-backward "^\\(Also-\\)*Resent-" beg t)

        (beginning-of-line)
        (insert "Also-"))
        (beginning-of-line)
        (insert "Also-"))

+      ;; Quote any "From " lines at the beginning.
+      (goto-char beg)
+      (when (looking-at "From ")
+       (replace-match "X-From-Line: "))

       ;; Send it.
       (message-send-mail)
       (kill-buffer (current-buffer)))
       ;; Send it.
       (message-send-mail)
       (kill-buffer (current-buffer)))


@@ -3215,10 +3651,9 @@ you."
             (forward-line 2))
        (and (re-search-forward message-unsent-separator nil t)
             (forward-line 1))
             (forward-line 2))
        (and (re-search-forward message-unsent-separator nil t)
             (forward-line 1))

-       (and (search-forward "\n\n" nil t)
-            (re-search-forward "^Return-Path:.*\n" nil t)))
+       (re-search-forward "^Return-Path:.*\n" nil t))

     ;; We remove everything before the bounced mail.
     ;; We remove everything before the bounced mail.

-    (delete-region 
+    (delete-region

      (point-min)
      (if (re-search-forward "^[^ \n\t]+:" nil t)
         (match-beginning 0)
      (point-min)
      (if (re-search-forward "^[^ \n\t]+:" nil t)
         (match-beginning 0)


@@ -3244,7 +3679,8 @@ you."
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "mail" to)))
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "mail" to)))

-  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+  (let ((message-this-is-mail t))
+    (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))

 
 ;;;###autoload
 (defun message-mail-other-frame (&optional to subject)
 
 ;;;###autoload
 (defun message-mail-other-frame (&optional to subject)


@@ -3256,7 +3692,8 @@ you."
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "mail" to)))
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "mail" to)))

-  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+  (let ((message-this-is-mail t))
+    (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))

 
 ;;;###autoload
 (defun message-news-other-window (&optional newsgroups subject)
 
 ;;;###autoload
 (defun message-news-other-window (&optional newsgroups subject)


@@ -3268,8 +3705,9 @@ you."
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))

-  (message-setup `((Newsgroups . ,(or newsgroups "")) 
-                  (Subject . ,(or subject "")))))
+  (let ((message-this-is-news t))
+    (message-setup `((Newsgroups . ,(or newsgroups ""))
+                    (Subject . ,(or subject ""))))))

 
 ;;;###autoload
 (defun message-news-other-frame (&optional newsgroups subject)
 
 ;;;###autoload
 (defun message-news-other-frame (&optional newsgroups subject)


@@ -3281,12 +3719,13 @@ you."
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
        (same-window-buffer-names nil)
        (same-window-regexps nil))
     (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))

-  (message-setup `((Newsgroups . ,(or newsgroups "")) 
-                  (Subject . ,(or subject "")))))
+  (let ((message-this-is-news t))
+    (message-setup `((Newsgroups . ,(or newsgroups ""))
+                    (Subject . ,(or subject ""))))))

 
 ;;; underline.el
 
 
 ;;; underline.el
 

-;; This code should be moved to underline.el (from which it is stolen). 
+;; This code should be moved to underline.el (from which it is stolen).

 
 ;;;###autoload
 (defun bold-region (start end)
 
 ;;;###autoload
 (defun bold-region (start end)


@@ -3313,7 +3752,7 @@ which specify the range to operate on."
   (save-excursion
     (let ((end1 (make-marker)))
       (move-marker end1 (max start end))
   (save-excursion
     (let ((end1 (make-marker)))
       (move-marker end1 (max start end))

-      (goto-char (min start end)) 
+      (goto-char (min start end))

       (while (re-search-forward "\b" end1 t)
        (if (eq (following-char) (char-after (- (point) 2)))
            (delete-char -2))))))
       (while (re-search-forward "\b" end1 t)
        (if (eq (following-char) (char-after (- (point) 2)))
            (delete-char -2))))))


@@ -3327,7 +3766,7 @@ which specify the range to operate on."
 ;;; Group name completion.
 
 (defvar message-newgroups-header-regexp
 ;;; Group name completion.
 
 (defvar message-newgroups-header-regexp

-  "^\\(Newsgroups\\|Followup-To\\|Posted-To\\):"
+  "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"

   "Regexp that match headers that lists groups.")
 
 (defun message-tab ()
   "Regexp that match headers that lists groups.")
 
 (defun message-tab ()


@@ -3341,9 +3780,10 @@ Do a `tab-to-tab-stop' if not in those headers."
 
 (defvar gnus-active-hashtb)
 (defun message-expand-group ()
 
 (defvar gnus-active-hashtb)
 (defun message-expand-group ()

-  (let* ((b (save-excursion 
+  "Expand the group name under point."
+  (let* ((b (save-excursion

              (save-restriction
              (save-restriction

-               (narrow-to-region 
+               (narrow-to-region

                 (save-excursion
                   (beginning-of-line)
                   (skip-chars-forward "^:")
                 (save-excursion
                   (beginning-of-line)
                   (skip-chars-forward "^:")


@@ -3351,13 +3791,14 @@ Do a `tab-to-tab-stop' if not in those headers."
                 (point))
                (skip-chars-backward "^, \t\n") (point))))
         (completion-ignore-case t)
                 (point))
                (skip-chars-backward "^, \t\n") (point))))
         (completion-ignore-case t)

-        (string (buffer-substring b (point)))
+        (string (buffer-substring b (progn (skip-chars-forward "^,\t\n ")
+                                           (point))))

         (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))
         (completions (all-completions string hashtb))
         (cur (current-buffer))
         comp)
     (delete-region b (point))
         (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))
         (completions (all-completions string hashtb))
         (cur (current-buffer))
         comp)
     (delete-region b (point))

-    (cond 
+    (cond

      ((= (length completions) 1)
       (if (string= (car completions) string)
          (progn
      ((= (length completions) 1)
       (if (string= (car completions) string)
          (progn


@@ -3371,19 +3812,21 @@ Do a `tab-to-tab-stop' if not in those headers."
       (insert string)
       (if (not comp)
          (message "No matching groups")
       (insert string)
       (if (not comp)
          (message "No matching groups")

-       (pop-to-buffer "*Completions*")
-       (buffer-disable-undo (current-buffer))
-       (let ((buffer-read-only nil))
-         (erase-buffer)
-         (let ((standard-output (current-buffer)))
-           (display-completion-list (sort completions 'string<)))
-         (goto-char (point-min))
-         (pop-to-buffer cur)))))))
+       (save-selected-window
+         (pop-to-buffer "*Completions*")
+         (buffer-disable-undo (current-buffer))
+         (let ((buffer-read-only nil))
+           (erase-buffer)
+           (let ((standard-output (current-buffer)))
+             (display-completion-list (sort completions 'string<)))
+           (goto-char (point-min))
+           (delete-region (point) (progn (forward-line 3) (point))))))))))

 
 ;;; Help stuff.
 
 (defun message-talkative-question (ask question show &rest text)
 
 ;;; Help stuff.
 
 (defun message-talkative-question (ask question show &rest text)

-  "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.  
+  "Call FUNCTION with argument QUESTION; optionally display TEXT... args.
+If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer.

 The following arguments may contain lists of values."
   (if (and show
           (setq text (message-flatten-list text)))
 The following arguments may contain lists of values."
   (if (and show
           (setq text (message-flatten-list text)))


@@ -3401,7 +3844,7 @@ The following arguments may contain lists of values."
 
 \(message-flatten-list '(1 (2 3 (4 5 (6))) 7))
 => (1 2 3 4 5 6 7)"
 
 \(message-flatten-list '(1 (2 3 (4 5 (6))) 7))
 => (1 2 3 4 5 6 7)"

-  (cond ((consp list) 
+  (cond ((consp list)

         (apply 'append (mapcar 'message-flatten-list list)))
        (list
         (list list))))
         (apply 'append (mapcar 'message-flatten-list list)))
        (list
         (list list))))


@@ -3411,19 +3854,43 @@ The following arguments may contain lists of values."
 Then clone the local variables and values from the old buffer to the
 new one, cloning only the locals having a substring matching the
 regexp varstr."
 Then clone the local variables and values from the old buffer to the
 new one, cloning only the locals having a substring matching the
 regexp varstr."

-  (let ((oldlocals (buffer-local-variables)))
+  (let ((oldbuf (current-buffer)))

     (save-excursion
       (set-buffer (generate-new-buffer name))
     (save-excursion
       (set-buffer (generate-new-buffer name))

-      (mapcar (lambda (dude)
-               (when (and (car dude)
-                          (or (not varstr)
-                              (string-match varstr (symbol-name (car dude)))))
-                 (ignore-errors
-                   (set (make-local-variable (car dude))
-                        (cdr dude)))))
-             oldlocals)
+      (message-clone-locals oldbuf)

       (current-buffer))))
 
       (current-buffer))))
 

+(defun message-clone-locals (buffer)
+  "Clone the local variables from BUFFER to the current buffer."
+  (let ((locals (save-excursion
+                 (set-buffer buffer)
+                 (buffer-local-variables)))
+       (regexp "^gnus\\|^nn\\|^message"))
+    (mapcar
+     (lambda (local)
+       (when (and (consp local)
+                 (car local)
+                 (string-match regexp (symbol-name (car local))))
+        (ignore-errors
+          (set (make-local-variable (car local))
+               (cdr local)))))
+     locals)))
+
+;;; Miscellaneous functions
+
+;; stolen (and renamed) from nnheader.el
+(defun message-replace-chars-in-string (string from to)
+  "Replace characters in STRING from FROM to TO."
+  (let ((string (substring string 0))  ;Copy string.
+       (len (length string))
+       (idx 0))
+    ;; Replace all occurrences of FROM with TO.
+    (while (< idx len)
+      (when (= (aref string idx) from)
+       (aset string idx to))
+      (setq idx (1+ idx)))
+    string))
+

 (run-hooks 'message-load-hook)
 
 (provide 'message)
 (run-hooks 'message-load-hook)
 
 (provide 'message)