Initial revision

1 files changed, 2997 insertions, 0 deletions

diff --git a/lisp/message.el b/lisp/message.el
new file mode 100644
index 00000000000..0e94d64b402
--- /dev/null
+++ b/lisp/message.el
@@ -0,0 +1,2997 @@
+;;; message.el --- composing mail and news messages
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This mode provides mail-sending facilities from within Emacs.  It
+;; consists mainly of large chunks of code from the sendmail.el,
+;; gnus-msg.el and rnewspost.el files.
+
+;;; Code:
+
+(eval-when-compile 
+  (require 'cl))
+(require 'mailheader)
+(require 'rmail)
+(require 'nnheader)
+(require 'timezone)
+(require 'easymenu)
+(if (string-match "XEmacs\\|Lucid" emacs-version)
+    (require 'mail-abbrevs)
+  (require 'mailabbrev))
+
+;;;###autoload
+(defvar message-directory "~/Mail/"
+  "*Directory from which all other mail file variables are derived.")
+
+(defvar message-max-buffers 10
+  "*How many buffers to keep before starting to kill them off.")
+
+(defvar message-send-rename-function nil
+  "Function called to rename the buffer after sending it.")
+
+;;;###autoload
+(defvar message-fcc-handler-function 'rmail-output
+  "*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
+mailbox format.")
+
+;;;###autoload
+(defvar message-courtesy-message
+  "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
+  "*This is inserted at the start of a mailed copy of a posted message.
+If this variable is nil, no such courtesy message will be added.")
+
+;;;###autoload
+(defvar message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
+  "*Regexp that matches headers to be removed in resent bounced mail.")
+
+;;;###autoload
+(defvar message-from-style 'default
+  "*Specifies how \"From\" headers look.
+
+If `nil', they contain just the return address like:
+	king@grassland.com
+If `parens', they look like:
+	king@grassland.com (Elvis Parsley)
+If `angles', they look like:
+	Elvis Parsley <king@grassland.com>
+
+Otherwise, most addresses look like `angles', but they look like
+`parens' if `angles' would need quoting and `parens' would not.")
+
+;;;###autoload
+(defvar message-syntax-checks nil
+  "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.
+
+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.")
+
+;;;###autoload
+(defvar message-required-news-headers
+  '(From Newsgroups Subject Date Message-ID 
+	 (optional . Organization) Lines 
+	 (optional . X-Newsreader))
+  "*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
+header, remove it from this list.")
+
+;;;###autoload
+(defvar message-required-mail-headers 
+  '(From Subject Date (optional . In-Reply-To) Message-ID Lines
+	 (optional . X-Mailer))
+  "*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.")
+
+;;;###autoload
+(defvar message-deletable-headers '(Message-ID Date)
+  "*Headers to be deleted if they already exist and were generated by message previously.")
+
+;;;###autoload
+(defvar message-ignored-news-headers 
+  "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:"
+  "*Regexp of headers to be removed unconditionally before posting.")
+
+;;;###autoload
+(defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:"
+  "*Regexp of headers to be removed unconditionally before mailing.")
+
+;;;###autoload
+(defvar message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:"
+  "*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.")
+
+;;;###autoload
+(defvar message-signature-separator "^-- *$"
+  "Regexp matching the signature separator.")
+
+;;;###autoload
+(defvar 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.")
+
+;;;###autoload
+(defvar message-generate-new-buffers t
+  "*Non-nil means that a new message buffer will be created whenever `mail-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.")
+
+;;;###autoload
+(defvar message-kill-buffer-on-exit nil
+  "*Non-nil means that the message buffer will be killed after sending a message.")
+
+(defvar gnus-local-organization)
+(defvar message-user-organization 
+  (or (and (boundp 'gnus-local-organization)
+	   gnus-local-organization)
+      (getenv "ORGANIZATION")
+      t)
+  "*String to be used as an Organization header.
+If t, use `message-user-organization-file'.")
+
+;;;###autoload
+(defvar message-user-organization-file "/usr/lib/news/organization"
+  "*Local news organization file.")
+
+;;;###autoload
+(defvar message-autosave-directory
+  (concat (file-name-as-directory message-directory) "drafts/")
+  "*Directory where message autosaves buffers.
+If nil, message won't autosave.")
+
+(defvar message-forward-start-separator 
+  "------- Start of forwarded message -------\n"
+  "*Delimiter inserted before forwarded messages.")
+
+(defvar message-forward-end-separator
+  "------- End of forwarded message -------\n"
+  "*Delimiter inserted after forwarded messages.")
+
+;;;###autoload
+(defvar message-signature-before-forwarded-message t
+  "*If non-nil, put the signature before any included forwarded message.")
+
+;;;###autoload
+(defvar 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:"
+  "*Regexp matching headers to be included in forwarded messages.")
+
+;;;###autoload
+(defvar message-ignored-resent-headers "^Return-receipt"
+  "*All headers that match this regexp will be deleted when resending a message.")
+
+;;;###autoload
+(defvar message-ignored-cited-headers "."
+  "Delete these headers from the messages you yank.")
+
+;; Useful to set in site-init.el
+;;;###autoload
+(defvar message-send-mail-function 'message-send-mail-with-sendmail
+  "Function to call to send the current buffer as mail.
+The headers should be delimited by a line whose contents match the
+variable `mail-header-separator'.
+
+Legal values include `message-send-mail-with-mh' and
+`message-send-mail-with-sendmail', which is the default.")
+
+;;;###autoload
+(defvar message-send-news-function 'message-send-news
+  "Function to call to send the current buffer as news.
+The headers should be delimited by a line whose contents match the
+variable `mail-header-separator'.")
+
+;;;###autoload
+(defvar message-reply-to-function nil
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+
+;;;###autoload
+(defvar message-wide-reply-to-function nil
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+
+;;;###autoload
+(defvar message-followup-to-function nil
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+
+;;;###autoload
+(defvar message-use-followup-to 'ask
+  "*Specifies what to do with Followup-To header.
+If nil, ignore the header. If it is t, use its value, but query before
+using the \"poster\" value.  If it is the symbol `ask', query the user
+whether to ignore the \"poster\" value.  If it is the symbol `use',
+always use the value.")
+
+(defvar gnus-post-method)
+(defvar gnus-select-method)
+;;;###autoload
+(defvar message-post-method 
+  (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.")
+
+;;;###autoload
+(defvar message-generate-headers-first nil
+  "*If non-nil, generate all possible headers before composing.")
+
+(defvar message-setup-hook nil
+  "Normal hook, run each time a new outgoing message is initialized.
+The function `message-setup' runs this hook.")
+
+(defvar 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 
+the signature is inserted.")
+
+(defvar message-mode-hook nil
+  "Hook run in message mode buffers.")
+
+(defvar message-header-hook nil
+  "Hook run in a message mode buffer narrowed to the headers.")
+
+(defvar message-header-setup-hook nil
+  "Hook called narrowed to the headers when setting up a message buffer.")
+
+;;;###autoload
+(defvar message-citation-line-function 'message-insert-citation-line
+  "*Function called to insert the \"Whomever writes:\" line.")
+
+;;;###autoload
+(defvar message-yank-prefix "> "
+  "*Prefix inserted on the lines of yanked messages.
+nil means use indentation.")
+
+(defvar message-indentation-spaces 3
+  "*Number of spaces to insert at the beginning of each cited line.
+Used by `message-yank-original' via `message-yank-cite'.")
+
+;;;###autoload
+(defvar message-cite-function 'message-cite-original
+  "*Function for citing an original message.")
+
+;;;###autoload
+(defvar message-indent-citation-function 'message-indent-citation
+  "*Function for modifying a citation just inserted in the mail buffer.
+This can also be a list of functions.  Each function can find the
+citation between (point) and (mark t).  And each function should leave
+point and mark around the citation text as modified.")
+
+(defvar message-abbrevs-loaded nil)
+
+;;;###autoload
+(defvar message-signature t
+  "*String to be inserted at the end of the message buffer.
+If t, the `message-signature-file' file will be inserted instead.
+If a function, the result from the function will be used instead.
+If a form, the result from the form will be used instead.")
+
+;;;###autoload
+(defvar message-signature-file "~/.signature"
+  "*File containing the text inserted at end of message. buffer.")
+
+(defvar message-distribution-function nil
+  "*Function called to return a Distribution header.")
+
+(defvar message-expires 14
+  "*Number of days before your article expires.")
+
+(defvar message-user-path nil
+  "If nil, use the NNTP server name in the Path header.
+If stringp, use this; if non-nil, use no host name (user name only).")
+
+(defvar message-reply-buffer nil)
+(defvar message-reply-headers nil)
+(defvar message-newsreader nil)
+(defvar message-mailer nil)
+(defvar message-sent-message-via nil)
+(defvar message-checksum nil)
+(defvar message-send-actions nil
+  "A list of actions to be performed upon successful sending of a message.")
+(defvar message-exit-actions nil
+  "A list of actions to be performed upon exiting after sending a message.")
+(defvar message-kill-actions nil
+  "A list of actions to be performed before killing a message buffer.")
+(defvar message-postpone-actions nil
+  "A list of actions to be performed after postponing a message.")
+
+;;;###autoload
+(defvar message-default-headers nil
+  "*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.")
+
+;;;###autoload
+(defvar message-default-mail-headers nil
+  "*A string of header lines to be inserted in outgoing mails.")
+
+;;;###autoload
+(defvar message-default-news-headers nil
+  "*A string of header lines to be inserted in outgoing news articles.")
+
+;; Note: could use /usr/ucb/mail instead of sendmail;
+;; options -t, and -v if not interactive.
+(defvar message-mailer-swallows-blank-line
+  (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" 
+			 system-configuration)
+	   (file-readable-p "/etc/sendmail.cf")
+	   (let ((buffer (get-buffer-create " *temp*")))
+	     (unwind-protect
+		 (save-excursion
+		   (set-buffer buffer)
+		   (insert-file-contents "/etc/sendmail.cf")
+		   (goto-char (point-min))
+		   (let ((case-fold-search nil))
+		     (re-search-forward "^OR\\>" nil t)))
+	       (kill-buffer buffer))))
+      ;; According to RFC822, "The field-name must be composed of printable
+      ;; ASCII characters (i.e. characters that have decimal values between
+      ;; 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.
+\(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.")
+
+(defvar message-mode-syntax-table 
+  (let ((table (copy-syntax-table text-mode-syntax-table)))
+    (modify-syntax-entry ?% ". " table)
+    table)
+  "Syntax table used while in Message mode.")
+
+(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)))
+  "Additional expressions to highlight in Message mode.")
+
+(defvar message-face-alist
+  '((bold . bold-region)
+    (underline . underline-region)
+    (default . (lambda (b e) 
+		 (unbold-region b e)
+		 (ununderline-region b e))))
+  "Alist of mail and news faces for facemenu.
+The cdr of ech entry is a function for applying the face to a region.")
+
+(defvar message-send-hook nil
+  "Hook run before sending messages.")
+
+(defvar message-sent-hook nil
+  "Hook run after sending messages.")
+
+;;; Internal variables.
+
+(defvar message-buffer-list nil)
+
+;;; Regexp matching the delimiter of messages in UNIX mail format
+;;; (UNIX From lines), minus the initial ^.  
+(defvar message-unix-mail-delimiter
+  (let ((time-zone-regexp
+	 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
+		 "\\|[-+]?[0-9][0-9][0-9][0-9]"
+		 "\\|"
+		 "\\) *")))
+    (concat
+     "From "
+
+     ;; Username, perhaps with a quoted section that can contain spaces.
+     "\\("
+     "[^ \n]*"
+     "\\(\\|\".*\"[^ \n]*\\)"
+     "\\|<[^<>\n]+>"
+     "\\)  ?"
+
+     ;; The time the message was sent.
+     "\\([^ \n]*\\) *"			; day of the week
+     "\\([^ ]*\\) *"			; month
+     "\\([0-9]*\\) *"			; day of month
+     "\\([0-9:]*\\) *"			; time of day
+
+     ;; Perhaps a time zone, specified by an abbreviation, or by a
+     ;; numeric offset.
+     time-zone-regexp
+
+     ;; The year.
+     " [0-9][0-9]\\([0-9]*\\) *"
+
+     ;; On some systems the time zone can appear after the year, too.
+     time-zone-regexp
+
+     ;; Old uucp cruft.
+     "\\(remote from .*\\)?"
+
+     "\n")))
+
+(defvar message-unsent-separator
+  (concat "^ *---+ +Unsent message follows +---+ *$\\|"
+	  "^ *---+ +Returned message +---+ *$\\|"
+	  "^Start of returned message$\\|"
+	  "^ *---+ +Original message +---+ *$\\|"
+	  "^ *--+ +begin message +--+ *$\\|"
+	  "^ *---+ +Original message follows +---+ *$\\|"
+	  "^|? *---+ +Message text follows: +---+ *|?$")
+  "A regexp that matches the separator before the text of a failed message.")
+
+(defvar message-header-format-alist 
+  `((Newsgroups)
+    (To . message-fill-address) 
+    (Cc . message-fill-address)
+    (Subject)
+    (In-Reply-To)
+    (Fcc)
+    (Bcc)
+    (Date)
+    (Organization)
+    (Distribution)
+    (Lines)
+    (Expires)
+    (Message-ID)
+    (References . message-fill-header)
+    (X-Mailer)
+    (X-Newsreader))
+  "Alist used for formatting headers.")
+
+(eval-and-compile
+  (autoload 'message-setup-toolbar "messagexmas")
+  (autoload 'mh-send-letter "mh-comp"))
+
+
+
+;;; 
+;;; 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))))
+
+;; Delete the current line (and the next N lines.);
+(defmacro message-delete-line (&optional n)
+  `(delete-region (progn (beginning-of-line) (point))
+		  (progn (forward-line ,(or n 1)) (point))))
+
+(defun message-tokenize-header (header &optional separator)
+  "Split HEADER into a list of header elements.
+\",\" is used as the separator."
+  (let ((regexp (format "[%s]+" (or separator ",")))
+	(beg 1)
+	quoted elems)
+    (save-excursion
+      (message-set-work-buffer)
+      (insert header)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(forward-char 1)
+	(cond ((and (> (point) beg)
+		    (or (eobp)
+			(and (looking-at regexp)
+			     (not quoted))))
+	       (push (buffer-substring beg (point)) elems)
+	       (setq beg (match-end 0)))
+	      ((= (following-char) ?\")
+	       (setq quoted (not quoted)))))
+      (nreverse elems))))
+
+(defun message-fetch-field (header)
+  "The same as `mail-fetch-field', only remove all newlines."
+  (let ((value (mail-fetch-field header)))
+    (when value
+      (nnheader-replace-chars-in-string value ?\n ? ))))
+
+(defun message-fetch-reply-field (header)
+  "Fetch FIELD from the message we're replying to."
+  (when (and message-reply-buffer
+	     (buffer-name message-reply-buffer))
+    (save-excursion
+      (set-buffer message-reply-buffer)
+      (message-fetch-field header))))
+
+(defun message-set-work-buffer ()
+  (if (get-buffer " *message work*")
+      (progn
+	(set-buffer " *message work*")
+	(erase-buffer))
+    (set-buffer (get-buffer-create " *message work*"))
+    (kill-all-local-variables)
+    (buffer-disable-undo (current-buffer))))
+
+(defun message-functionp (form)
+  "Return non-nil if FORM is funcallable."
+  (or (and (symbolp form) (fboundp form))
+      (and (listp form) (eq (car form) 'lambda))))
+
+(defun message-strip-subject-re (subject)
+  "Remove \"Re:\" from subject lines."
+  (if (string-match "^[Rr][Ee]: *" subject)
+      (substring subject (match-end 0))
+    subject))
+
+(defun message-remove-header (header &optional is-regexp first reverse)
+  "Remove HEADER in the narrowed buffer.
+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))
+  (let ((regexp (if is-regexp header (concat "^" header ":")))
+	(number 0)
+	(case-fold-search t)
+	last)
+    (while (and (not (eobp))
+		(not last))
+      (if (if reverse
+	      (not (looking-at regexp))
+	    (looking-at regexp))
+	  (progn
+	    (incf number)
+	    (when first
+	      (setq last t))
+	    (delete-region
+	     (point)
+	     ;; There might be a continuation header, so we have to search
+	     ;; until we find a new non-continuation line.
+	     (progn
+	       (forward-line 1)
+	       (if (re-search-forward "^[^ \t]" nil t)
+		   (goto-char (match-beginning 0))
+		 (point-max)))))
+	(forward-line 1)
+	(if (re-search-forward "^[^ \t]" nil t)
+	    (goto-char (match-beginning 0))
+	  (point-max))))
+    number))
+
+(defun message-narrow-to-headers ()
+  "Narrow the buffer to the head of the message."
+  (widen)
+  (narrow-to-region
+   (goto-char (point-min))
+   (if (re-search-forward
+	(concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+       (match-beginning 0)
+     (point-max)))
+  (goto-char (point-min)))
+
+(defun message-narrow-to-head ()
+  "Narrow the buffer to the head of the message."
+  (widen)
+  (narrow-to-region
+   (goto-char (point-min))
+   (if (search-forward "\n\n" nil 1)
+       (1- (point))
+     (point-max)))
+  (goto-char (point-min)))
+
+(defun message-news-p ()
+  "Say whether the current buffer contains a news message."
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers)
+      (message-fetch-field "newsgroups"))))
+
+(defun message-mail-p ()
+  "Say whether the current buffer contains a mail message."
+  (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."
+  (beginning-of-line)
+  (or (eobp) (forward-char 1))
+  (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))
+  (sort-subr 
+   nil 'message-next-header 
+   (lambda ()
+     (message-next-header)
+     (unless (bobp)
+       (forward-char -1)))
+   (lambda ()
+     (or (get-text-property (point) 'message-rank)
+	 0))))
+
+(defun message-sort-headers ()
+  "Sort the headers of the current message according to `message-header-format-alist'."
+  (interactive)
+  (save-excursion
+    (save-restriction
+      (let ((max (1+ (length message-header-format-alist)))
+	    rank)
+	(message-narrow-to-headers)
+	(while (re-search-forward "^[^ \n]+:" nil t)
+	  (put-text-property
+	   (match-beginning 0) (1+ (match-beginning 0))
+	   'message-rank
+	   (if (setq rank (length (memq (assq (intern (buffer-substring
+						       (match-beginning 0)
+						       (1- (match-end 0))))
+					      message-header-format-alist)
+					message-header-format-alist)))
+	       (- max rank)
+	     (1+ max)))))
+      (message-sort-headers-1))))
+
+
+
+;;;
+;;; Message mode
+;;;
+
+;;; Set up keymap.
+
+(defvar message-mode-map nil)
+
+(unless message-mode-map
+  (setq message-mode-map (copy-keymap text-mode-map))
+  (define-key message-mode-map "\C-c?" 'describe-mode)
+
+  (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
+  (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
+  (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
+  (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
+  (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
+  (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
+  (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
+  (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
+  (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
+  (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
+  (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
+  (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
+  (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
+
+  (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-r" 'message-caesar-buffer-body)
+  (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
+  (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
+
+  (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
+  (define-key message-mode-map "\C-c\C-s" 'message-send)
+  (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
+  (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
+
+  (define-key message-mode-map "\t" 'message-tab))
+
+(easy-menu-define message-mode-menu message-mode-map
+  "Message Menu."
+  '("Message"
+    "Go to Field:"
+    "----"
+    ["To" message-goto-to t]
+    ["Subject" message-goto-subject t]
+    ["Cc" message-goto-cc t]
+    ["Reply-to" message-goto-reply-to t]
+    ["Summary" message-goto-summary t]
+    ["Keywords" message-goto-keywords t]
+    ["Newsgroups" message-goto-newsgroups t]
+    ["Followup-To" message-goto-followup-to t]
+    ["Distribution" message-goto-distribution t]
+    ["Body" message-goto-body t]
+    ["Signature" message-goto-signature t]
+    "----"
+    "Miscellaneous Commands:"
+    "----"
+    ["Sort Headers" message-sort-headers t]
+    ["Yank Original" message-yank-original t]
+    ["Fill Yanked Message" message-fill-yanked-message t]
+    ["Insert Signature" message-insert-signature t]
+    ["Caesar (rot13) Message" message-caesar-buffer-body t]
+    ["Rename buffer" message-rename-buffer t]
+    ["Spellcheck" ispell-message t]
+    "----"
+    ["Send Message" message-send-and-exit t]
+    ["Abort Message" message-dont-send t]))
+
+(defvar facemenu-add-face-function)
+(defvar facemenu-remove-face-function)
+
+;;;###autoload
+(defun message-mode ()
+  "Major mode for editing mail and news to be sent.
+Like Text Mode but with these additional commands:
+C-c C-s  message-send (send the message)    C-c C-c  message-send-and-exit
+C-c C-f  move to a header field (and create it if there isn't):
+	 C-c C-f C-t  move to To	C-c C-f C-s  move to Subject
+	 C-c C-f C-c  move to Cc	C-c C-f C-b  move to Bcc
+	 C-c C-f C-f  move to Fcc	C-c C-f C-r  move to Reply-To
+	 C-c C-f C-u  move to Summary	C-c C-f C-n  move to Newsgroups
+	 C-c C-f C-k  move to Keywords	C-c C-f C-d  move to Distribution
+	 C-c C-f C-o  move to Followup-To
+C-c C-t  message-insert-to (add a To header to a news followup)
+C-c C-n  message-insert-newsgroups (add a Newsgroup header to a news reply)
+C-c C-b  message-goto-body (move to beginning of message text).
+C-c C-i  message-goto-signature (move to the beginning of the signature).
+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-r  message-ceasar-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-kill-actions)
+  (make-local-variable 'message-postpone-actions)
+  (set-syntax-table message-mode-syntax-table)
+  (use-local-map message-mode-map)
+  (setq local-abbrev-table text-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
+	(lambda (face end)
+	  (let ((face-fun (cdr (assq face message-face-alist))))
+	    (if face-fun
+		(funcall face-fun (point) end)
+	      (error "Face %s not configured for %s mode" face mode-name)))
+	  "")
+	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))
+  (make-local-variable 'message-reply-headers)
+  (setq message-reply-headers nil)
+  (make-local-variable 'message-newsreader)
+  (make-local-variable 'message-mailer)
+  (make-local-variable 'message-post-method)
+  (make-local-variable 'message-sent-message-via)
+  (setq message-sent-message-via nil)
+  (make-local-variable 'message-checksum)
+  (setq message-checksum nil)
+  (when (fboundp 'mail-hist-define-keys)
+    (mail-hist-define-keys))
+  (when (string-match "XEmacs\\|Lucid" emacs-version)
+    (message-setup-toolbar))
+  (easy-menu-add message-mode-menu message-mode-map)
+  ;; Allow mail alias things.
+  (if (fboundp 'mail-abbrevs-setup)
+      (mail-abbrevs-setup)
+    (funcall (intern "mail-aliases-setup")))
+  (run-hooks 'text-mode-hook 'message-mode-hook))
+
+
+
+;;;
+;;; Message mode commands
+;;;
+
+;;; Movement commands
+
+(defun message-goto-to ()
+  "Move point to the To header."
+  (interactive)
+  (message-position-on-field "To"))
+
+(defun message-goto-subject ()
+  "Move point to the Subject header."
+  (interactive)
+  (message-position-on-field "Subject"))
+
+(defun message-goto-cc ()
+  "Move point to the Cc header."
+  (interactive)
+  (message-position-on-field "Cc" "To"))
+
+(defun message-goto-bcc ()
+  "Move point to the Bcc  header."
+  (interactive)
+  (message-position-on-field "Bcc" "Cc" "To"))
+
+(defun message-goto-fcc ()
+  "Move point to the Fcc header."
+  (interactive)
+  (message-position-on-field "Fcc" "To" "Newsgroups"))
+
+(defun message-goto-reply-to ()
+  "Move point to the Reply-To header."
+  (interactive)
+  (message-position-on-field "Reply-To" "Subject"))
+
+(defun message-goto-newsgroups ()
+  "Move point to the Newsgroups header."
+  (interactive)
+  (message-position-on-field "Newsgroups"))
+
+(defun message-goto-distribution ()
+  "Move point to the Distribution header."
+  (interactive)
+  (message-position-on-field "Distribution"))
+
+(defun message-goto-followup-to ()
+  "Move point to the Followup-To header."
+  (interactive)
+  (message-position-on-field "Followup-To" "Newsgroups"))
+
+(defun message-goto-keywords ()
+  "Move point to the Keywords header."
+  (interactive)
+  (message-position-on-field "Keywords" "Subject"))
+
+(defun message-goto-summary ()
+  "Move point to the Summary header."
+  (interactive)
+  (message-position-on-field "Summary" "Subject"))
+
+(defun message-goto-body ()
+  "Move point to the beginning of the message body."
+  (interactive)
+  (if (looking-at "[ \t]*\n") (expand-abbrev))
+  (goto-char (point-min))
+  (search-forward (concat "\n" mail-header-separator "\n") nil t))
+
+(defun message-goto-signature ()
+  "Move point to the beginning of the message signature."
+  (interactive)
+  (goto-char (point-min))
+  (or (re-search-forward message-signature-separator nil t)
+      (goto-char (point-max))))
+
+
+
+(defun message-insert-to ()
+  "Insert a To header that points to the author of the article being replied to."
+  (interactive)
+  (when (and (message-position-on-field "To")
+	     (mail-fetch-field "to")
+	     (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
+    (insert ", "))
+  (insert (or (message-fetch-reply-field "reply-to")
+	      (message-fetch-reply-field "from") "")))
+
+(defun message-insert-newsgroups ()
+  "Insert the Newsgroups header from the article being replied to."
+  (interactive)
+  (when (and (message-position-on-field "Newsgroups")
+	     (mail-fetch-field "newsgroups")
+	     (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
+    (insert ","))
+  (insert (or (message-fetch-reply-field "newsgroups") "")))
+
+
+
+;;; Various commands
+
+(defun message-insert-signature (&optional force)
+  "Insert a signature.  See documentation for the `message-signature' variable."
+  (interactive (list 0))
+  (let* ((signature 
+	  (cond ((and (null message-signature)
+		      (eq force 0))
+		 (save-excursion
+		   (goto-char (point-max))
+		   (not (re-search-backward
+			 message-signature-separator nil t))))
+		((and (null message-signature)
+		      force)
+		 t)
+		((message-functionp message-signature)
+		 (funcall message-signature))
+		((listp message-signature)
+		 (eval message-signature))
+		(t message-signature)))
+	 (signature
+	  (cond ((stringp signature)
+		 signature)
+		((and (eq t signature)
+		      message-signature-file
+		      (file-exists-p message-signature-file))
+		 signature))))
+    (when signature
+;      ;; Remove blank lines at the end of the message.
+      (goto-char (point-max))
+;      (skip-chars-backward " \t\n")
+;      (delete-region (point) (point-max))
+      ;; Insert the signature.
+      (unless (bolp)
+	(insert "\n"))
+      (insert "\n-- \n")
+      (if (eq signature t)
+	  (insert-file-contents message-signature-file)
+	(insert signature))
+      (goto-char (point-max))
+      (or (bolp) (insert "\n")))))
+
+(defvar message-caesar-translation-table nil)
+
+(defun message-caesar-region (b e &optional n)
+  "Caesar rotation of region by N, default 13, for decrypting netnews."
+  (interactive
+   (list
+    (min (point) (or (mark t) (point)))
+    (max (point) (or (mark t) (point)))
+    (when current-prefix-arg
+      (prefix-numeric-value current-prefix-arg))))
+
+  (setq n (if (numberp n) (mod n 26) 13)) ;canonize N
+  (unless (or (zerop n)			; no action needed for a rot of 0
+	      (= b e))			; no region to rotate
+    ;; 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 
+    ;; text properties.
+    (while (< b e)
+      (subst-char-in-region 
+       b (1+ b) (char-after b)
+       (aref message-caesar-translation-table (char-after b)))
+      (incf b))))
+
+(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).
+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
+		   (list (prefix-numeric-value current-prefix-arg))
+		 (list nil)))
+  (save-excursion
+    (save-restriction
+      (when (message-goto-body)
+	(narrow-to-region (point) (point-max)))
+      (message-caesar-region (point-min) (point-max) rotnum))))
+
+(defun message-rename-buffer (&optional enter-string)
+  "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))
+      (narrow-to-region (point) 
+			(search-forward mail-header-separator nil 'end))
+      (let* ((mail-to (if (message-news-p) (message-fetch-field "Newsgroups")
+			(message-fetch-field "To")))
+	     (mail-trimmed-to
+	      (if (string-match "," mail-to)
+		  (concat (substring mail-to 0 (match-beginning 0)) ", ...")
+		mail-to))
+	     (name-default (concat "*message* " mail-trimmed-to))
+	     (name (if enter-string
+		       (read-string "New buffer name: " name-default)
+		     name-default)))
+	(rename-buffer name t)))))
+
+(defun message-fill-yanked-message (&optional justifyp)
+  "Fill the paragraphs of a message yanked into this one.
+Numeric argument means justify as well."
+  (interactive "P")
+  (save-excursion
+    (goto-char (point-min))
+    (search-forward (concat "\n" mail-header-separator "\n") nil t)
+    (let ((fill-prefix message-yank-prefix))
+      (fill-individual-paragraphs (point) (point-max) justifyp t))))
+
+(defun message-indent-citation ()
+  "Modify text just inserted from a message to be cited.
+The inserted text should be the region.
+When this function returns, the region is again around the modified text.
+
+Normally, indent each nonblank line `message-indentation-spaces' spaces.
+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
+      (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)))
+    ;; Do the indentation.
+    (if (null message-yank-prefix)
+	(indent-rigidly start (mark t) message-indentation-spaces)
+      (save-excursion
+	(goto-char start)
+	(while (< (point) (mark t))
+	  (insert message-yank-prefix)
+	  (forward-line 1)))
+      (goto-char start))))
+
+(defun message-yank-original (&optional arg)
+  "Insert the message being replied to, if any.
+Puts point before the text and mark after.
+Normally indents each nonblank line ARG spaces (default 3).  However,
+if `message-yank-prefix' is non-nil, insert that prefix on each line.
+
+Just \\[universal-argument] as argument means don't indent, insert no
+prefix, and don't delete any headers."
+  (interactive "P")
+  (let ((modified (buffer-modified-p)))
+    (when (and message-reply-buffer
+	       message-cite-function)
+      (delete-windows-on message-reply-buffer t)
+      (insert-buffer message-reply-buffer)
+      (funcall message-cite-function)
+      (message-exchange-point-and-mark)
+      (unless (bolp)
+	(insert ?\n))
+      (unless modified
+	(setq message-checksum (cons (message-checksum) (buffer-size)))))))
+
+(defun message-cite-original ()    
+  (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
+    (insert (mail-header-from message-reply-headers) " writes:\n\n")))
+
+(defun message-position-on-field (header &rest afters)
+  (let ((case-fold-search t))
+    (save-restriction
+      (narrow-to-region
+       (goto-char (point-min))
+       (progn
+	 (re-search-forward 
+	  (concat "^" (regexp-quote mail-header-separator) "$"))
+	 (match-beginning 0)))
+      (goto-char (point-min))
+      (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t)
+	  (progn
+	    (re-search-forward "^[^ \t]" nil 'move)
+	    (beginning-of-line)
+	    (skip-chars-backward "\n")
+	    t)
+	(while (and afters
+		    (not (re-search-forward 
+			  (concat "^" (regexp-quote (car afters)) ":")
+			  nil t)))
+	  (pop afters))
+	(when afters
+	  (re-search-forward "^[^ \t]" nil 'move)
+	  (beginning-of-line))
+	(insert header ": \n")
+	(forward-char -1)
+	nil))))
+
+(defun message-remove-signature ()
+  "Remove the signature from the text between point and mark.
+The text will also be indented the normal way."
+  (save-excursion
+    (let ((start (point))
+	  mark)
+    (if (not (re-search-forward message-signature-separator (mark t) t))
+	;; No signature here, so we just indent the cited text.
+	(message-indent-citation)
+      ;; Find the last non-empty line.
+      (forward-line -1)
+      (while (looking-at "[ \t]*$")
+	(forward-line -1))
+      (forward-line 1)
+      (setq mark (set-marker (make-marker) (point)))
+      (goto-char start)
+      (message-indent-citation)
+      ;; Enable undoing the deletion.
+      (undo-boundary)
+      (delete-region mark (mark t))
+      (set-marker mark nil)))))
+
+
+
+;;;
+;;; Sending messages
+;;;
+
+(defun message-send-and-exit (&optional arg)
+  "Send message like `message-send', then, if no errors, exit from mail buffer."
+  (interactive "P")
+  (let ((buf (current-buffer))
+	(actions message-exit-actions))
+    (when (and (message-send arg)
+	       (buffer-name buf))
+      (if message-kill-buffer-on-exit
+	  (kill-buffer buf)
+	(bury-buffer buf)
+	(when (eq buf (current-buffer))
+	  (message-bury buf)))
+      (message-do-actions actions))))
+
+(defun message-dont-send ()
+  "Don't send the message you have been editing."
+  (interactive)
+  (message-bury (current-buffer))
+  (message-do-actions message-postpone-actions))
+
+(defun message-kill-buffer ()
+  "Kill the current buffer."
+  (interactive)
+  (let ((actions message-kill-actions))
+    (kill-buffer (current-buffer))
+    (message-do-actions actions)))
+
+(defun message-bury (buffer)
+  "Bury this mail buffer."
+  (let ((newbuf (other-buffer buffer)))
+    (bury-buffer buffer)
+    (if (and (fboundp 'frame-parameters)
+	     (cdr (assq 'dedicated (frame-parameters)))
+	     (not (null (delq (selected-frame) (visible-frame-list)))))
+	(delete-frame (selected-frame))
+      (switch-to-buffer newbuf))))
+
+(defun message-send (&optional arg)
+  "Send the message in the current buffer.
+If `message-interactive' is non-nil, wait for success indication
+or error messages, and inform user.
+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? ")))
+    ;; Make it possible to undo the coming changes.
+    (undo-boundary)
+    (let ((inhibit-read-only t))
+      (put-text-property (point-min) (point-max) 'read-only nil))
+    (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
+	(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)))
+
+(defun message-fix-before-sending ()
+  "Do various things to make the message nice before sending it."
+  ;; Make sure there's a newline at the end of the message.
+  (goto-char (point-max))
+  (unless (bolp)
+    (insert "\n")))
+
+(defun message-add-action (action &rest types)
+  "Add ACTION to be performed when doing an exit of type TYPES."
+  (let (var)
+    (while types
+      (set (setq var (intern (format "message-%s-actions" (pop types))))
+	   (nconc (symbol-value var) (list action))))))
+
+(defun message-do-actions (actions)
+  "Perform all actions in ACTIONS."
+  ;; Now perform actions on successful sending.
+  (while actions
+    (condition-case nil
+	(cond 
+	 ;; A simple function.
+	 ((message-functionp (car actions))
+	  (funcall (car actions)))
+	 ;; Something to be evaled.
+	 (t
+	  (eval (car actions))))
+      (error))
+    (pop actions)))
+
+(defun message-send-mail (&optional arg)
+  (require 'mail-utils)
+  (let ((tembuf (generate-new-buffer " message temp"))
+	(case-fold-search nil)
+	(news (message-news-p))
+	(mailbuf (current-buffer)))
+    (save-restriction
+      (message-narrow-to-headers)
+      ;; Insert some headers.
+      (let ((message-deletable-headers
+	     (if news nil message-deletable-headers)))
+	(message-generate-headers message-required-mail-headers))
+      ;; Let the user do all of the above.
+      (run-hooks 'message-header-hook))
+    (unwind-protect
+	(save-excursion
+	  (set-buffer tembuf)
+	  (erase-buffer)
+	  (insert-buffer-substring mailbuf)
+	  ;; Remove some headers.
+	  (save-restriction
+	    (message-narrow-to-headers)
+	    ;; Remove some headers.
+	    (message-remove-header message-ignored-mail-headers t))
+	  (goto-char (point-max))
+	  ;; require one newline at the end.
+	  (or (= (preceding-char) ?\n)
+	      (insert ?\n))
+	  (when (and news
+		     (or (message-fetch-field "cc")
+			 (message-fetch-field "to")))
+	    (message-insert-courtesy-copy))
+	  (funcall message-send-mail-function))
+      (kill-buffer tembuf))
+    (set-buffer mailbuf)
+    (push 'mail message-sent-message-via)))
+
+(defun message-send-mail-with-sendmail ()
+  "Send off the prepared buffer with sendmail."
+  (let ((errbuf (if message-interactive
+		    (generate-new-buffer " sendmail errors")
+		  0))
+	resend-to-addresses delimline)
+    (let ((case-fold-search t))
+      (save-restriction
+	(message-narrow-to-headers)
+	(setq resend-to-addresses (message-fetch-field "resent-to")))
+      ;; Change header-delimiter to be what sendmail expects.
+      (goto-char (point-min))
+      (re-search-forward
+       (concat "^" (regexp-quote mail-header-separator) "\n"))
+      (replace-match "\n")
+      (backward-char 1)
+      (setq delimline (point-marker))
+      ;; Insert an extra newline if we need it to work around
+      ;; Sun's bug that swallows newlines.
+      (goto-char (1+ delimline))
+      (when (eval message-mailer-swallows-blank-line)
+	(newline))
+      (when message-interactive
+	(save-excursion
+	  (set-buffer errbuf)
+	  (erase-buffer))))
+    (let ((default-directory "/"))
+      (apply 'call-process-region
+	     (append (list (point-min) (point-max)
+			   (if (boundp 'sendmail-program)
+			       sendmail-program
+			     "/usr/lib/sendmail")
+			   nil errbuf nil "-oi")
+		     ;; Always specify who from,
+		     ;; since some systems have broken sendmails.
+		     (list "-f" (user-login-name))
+		     ;; These mean "report errors by mail"
+		     ;; and "deliver in background".
+		     (if (null message-interactive) '("-oem" "-odb"))
+		     ;; Get the addresses from the message
+		     ;; unless this is a resend.
+		     ;; We must not do that for a resend
+		     ;; because we would find the original addresses.
+		     ;; For a resend, include the specific addresses.
+		     (if resend-to-addresses
+			 (list resend-to-addresses)
+		       '("-t")))))
+    (when message-interactive
+      (save-excursion
+	(set-buffer errbuf)
+	(goto-char (point-min))
+	(while (re-search-forward "\n\n* *" nil t)
+	  (replace-match "; "))
+	(if (not (zerop (buffer-size)))
+	    (error "Sending...failed to %s"
+		   (buffer-substring (point-min) (point-max)))))
+      (when (bufferp errbuf)
+	(kill-buffer errbuf)))))
+
+(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 message-autosave-directory)
+		       "msg."))))
+    (setq buffer-file-name name)
+    (mh-send-letter)
+    (condition-case ()
+	(delete-file name)
+      (error nil))))
+
+(defun message-send-news (&optional arg)
+  (let ((tembuf (generate-new-buffer " *message temp*"))
+	(case-fold-search nil)
+	(method (if (message-functionp message-post-method)
+		    (funcall message-post-method arg)
+		  message-post-method))
+	(messbuf (current-buffer))
+	(message-syntax-checks
+	 (if arg
+	     (cons '(existing-newsgroups . disabled)
+		   message-syntax-checks)
+	   message-syntax-checks))
+	result)
+    (save-restriction
+      (message-narrow-to-headers)
+      ;; Insert some headers.
+      (message-generate-headers message-required-news-headers)
+      ;; Let the user do all of the above.
+      (run-hooks 'message-header-hook))
+    (message-cleanup-headers)
+    (when (message-check-news-syntax)
+      (unwind-protect
+	  (save-excursion
+	    (set-buffer tembuf)
+	    (buffer-disable-undo (current-buffer))
+	    (erase-buffer) 
+	    (insert-buffer-substring messbuf)
+	    ;; Remove some headers.
+	    (save-restriction
+	      (message-narrow-to-headers)
+	      ;; Remove some headers.
+	      (message-remove-header message-ignored-news-headers t))
+	    (goto-char (point-max))
+	    ;; require one newline at the end.
+	    (or (= (preceding-char) ?\n)
+		(insert ?\n))
+	    (let ((case-fold-search t))
+	      ;; Remove the delimeter.
+	      (goto-char (point-min))
+	      (re-search-forward
+	       (concat "^" (regexp-quote mail-header-separator) "\n"))
+	      (replace-match "\n")
+	      (backward-char 1))
+	    (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))))))
+	(kill-buffer tembuf))
+      (set-buffer messbuf)
+      (if result
+	  (push 'news message-sent-message-via)
+	(message "Couldn't send message via news: %s"
+		 (nnheader-get-report (car method)))
+	nil))))
+
+;;;
+;;; Header generation & syntax checking.
+;;;
+
+(defun message-check-news-syntax ()
+  "Check the syntax of the message."
+  (and 
+   ;; We narrow to the headers and check them first.
+   (save-excursion
+     (save-restriction
+       (message-narrow-to-headers)
+       (and 
+	;; Check for commands in Subject.
+	(or 
+	 (message-check-element 'subject-cmsg)
+	 (save-excursion
+	   (if (string-match "^cmsg " (message-fetch-field "subject"))
+	       (y-or-n-p
+		"The control code \"cmsg \" is in the subject. Really post? ")
+	     t)))
+	;; Check for multiple identical headers.
+	(or (message-check-element 'multiple-headers)
+	    (save-excursion
+	      (let (found)
+		(while (and (not found) 
+			    (re-search-forward "^[^ \t:]+: " nil t))
+		  (save-excursion
+		    (or (re-search-forward 
+			 (concat "^" (setq found
+					   (buffer-substring 
+					    (match-beginning 0) 
+					    (- (match-end 0) 2))))
+			 nil t)
+			(setq found nil))))
+		(if found
+		    (y-or-n-p 
+		     (format "Multiple %s headers. Really post? " found))
+		  t))))
+	;; Check for Version and Sendsys.
+	(or (message-check-element 'sendsys)
+	    (save-excursion
+	      (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) 
+					     (1- (match-end 0)))))
+		t)))
+	;; See whether we can shorten Followup-To.
+	(or (message-check-element 'shorten-followup-to)
+	    (let ((newsgroups (message-fetch-field "newsgroups"))
+		  (followup-to (message-fetch-field "followup-to"))
+		  to)
+	      (when (and newsgroups (string-match "," newsgroups)
+			 (not followup-to)
+			 (not
+			  (zerop
+			   (length
+			    (setq to (completing-read 
+				      "Followups to: (default all groups) " 
+				      (mapcar (lambda (g) (list g))
+					      (cons "poster" 
+						    (message-tokenize-header 
+						     newsgroups)))))))))
+		(goto-char (point-min))
+		(insert "Followup-To: " to "\n"))
+	      t))
+	;; Check "Shoot me".
+	(or (message-check-element 'shoot)
+	    (save-excursion
+	      (if (search-forward
+		   ".i-have-a-misconfigured-system-so-shoot-me" nil t)
+		  (y-or-n-p
+		   "You appear to have a misconfigured system.  Really post? ")
+		t)))
+	;; Check for Approved.
+	(or (message-check-element 'approved)
+	    (save-excursion
+	      (if (re-search-forward "^Approved:" nil t)
+		  (y-or-n-p
+		   "The article contains an Approved header. Really post? ")
+		t)))
+	;; Check the Message-Id header.
+	(or (message-check-element 'message-id)
+	    (save-excursion
+	      (let* ((case-fold-search t)
+		     (message-id (message-fetch-field "message-id")))
+		(or (not message-id)
+		    (and (string-match "@" message-id)
+			 (string-match "@[^\\.]*\\." message-id))
+		    (y-or-n-p
+		     (format 
+		      "The Message-ID looks strange: \"%s\". Really post? "
+		      message-id))))))
+	;; Check the Subject header.
+	(or 
+	 (message-check-element 'subject)
+	 (save-excursion
+	   (let* ((case-fold-search t)
+		  (subject (message-fetch-field "subject")))
+	     (or
+	      (and subject
+		   (not (string-match "\\`[ \t]*\\'" subject)))
+	      (progn
+		(message 
+		 "The subject field is empty or missing.  Posting is denied.")
+		nil)))))
+	;; Check the Newsgroups & Followup-To headers.
+	(or
+	 (message-check-element 'existing-newsgroups)
+	 (let* ((case-fold-search t)
+		(newsgroups (message-fetch-field "newsgroups"))
+		(followup-to (message-fetch-field "followup-to"))
+		(groups (message-tokenize-header
+			 (if followup-to
+			     (concat newsgroups "," followup-to)
+			   newsgroups)))
+		(hashtb (and (boundp 'gnus-active-hashtb)
+			     gnus-active-hashtb))
+		errors)
+	   (if (not hashtb)
+	       t
+	     (while groups
+	       (when (and (not (boundp (intern (car groups) hashtb)))
+			  (not (equal (car groups) "poster")))
+		 (push (car groups) errors))
+	       (pop groups))
+	     (if (not errors)
+		 t
+	       (y-or-n-p
+		(format
+		 "Really post to %s unknown group%s: %s "
+		 (if (= (length errors) 1) "this" "these")
+		 (if (= (length errors) 1) "" "s")
+		 (mapconcat 'identity errors ", ")))))))
+	;; Check the Newsgroups & Followup-To headers for syntax errors.
+	(or
+	 (message-check-element 'valid-newsgroups)
+	 (let ((case-fold-search t)
+	       (headers '("Newsgroups" "Followup-To"))
+	       header error)
+	   (while (and headers (not error))
+	     (when (setq header (mail-fetch-field (car headers)))
+	       (if (or
+		    (not 
+		     (string-match
+		      "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'"
+		      header))
+		    (memq 
+		     nil (mapcar 
+			  (lambda (g)
+			    (not (string-match "\\.\\'\\|\\.\\." g)))
+			  (message-tokenize-header header ","))))
+		   (setq error t)))
+	     (unless error
+	       (pop headers)))
+	   (if (not error)
+	       t
+	     (y-or-n-p
+	      (format "The %s header looks odd: \"%s\".  Really post? "
+		      (car headers) header)))))
+	;; Check the From header.
+	(or 
+	 (save-excursion
+	   (let* ((case-fold-search t)
+		  (from (message-fetch-field "from")))
+	     (cond
+	      ((not from)
+	       (message "There is no From line.  Posting is denied.")
+	       nil)
+	      ((not (string-match "@[^\\.]*\\." from))
+	       (message
+		"Denied posting -- the From looks strange: \"%s\"." from)
+	       nil)
+	      ((string-match "@[^@]*@" from)
+	       (message 
+		"Denied posting -- two \"@\"'s in the From header: %s." from)
+	       nil)
+	      ((string-match "(.*).*(.*)" from)
+	       (message
+		"Denied posting -- the From header looks strange: \"%s\"." 
+		from)
+	       nil)
+	      (t t))))))))
+   ;; Check for long lines.
+   (or (message-check-element 'long-lines)
+       (save-excursion
+	 (goto-char (point-min))
+	 (re-search-forward
+	  (concat "^" (regexp-quote mail-header-separator) "$"))
+	 (while (and
+		 (progn
+		   (end-of-line)
+		   (< (current-column) 80))
+		 (zerop (forward-line 1))))
+	 (or (bolp)
+	     (eobp)
+	     (y-or-n-p
+	      "You have lines longer than 79 characters.  Really post? "))))
+   ;; Check whether the article is empty.
+   (or (message-check-element 'empty)
+       (save-excursion
+	 (goto-char (point-min))
+	 (re-search-forward
+	  (concat "^" (regexp-quote mail-header-separator) "$"))
+	 (forward-line 1)
+	 (let ((b (point)))
+	   (or (re-search-forward message-signature-separator nil t)
+	       (goto-char (point-max)))
+	   (beginning-of-line)
+	   (or (re-search-backward "[^ \n\t]" b t)
+	       (y-or-n-p "Empty article.  Really post? ")))))
+   ;; Check for control characters.
+   (or (message-check-element 'control-chars)
+       (save-excursion
+	 (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
+	     (y-or-n-p 
+	      "The article contains control characters. Really post? ")
+	   t)))
+   ;; Check excessive size.
+   (or (message-check-element 'size)
+       (if (> (buffer-size) 60000)
+	   (y-or-n-p
+	    (format "The article is %d octets long. Really post? "
+		    (buffer-size)))
+	 t))
+   ;; Check whether any new text has been added.
+   (or (message-check-element 'new-text)
+       (not message-checksum)
+       (not (and (eq (message-checksum) (car message-checksum))
+		 (eq (buffer-size) (cdr message-checksum))))
+       (y-or-n-p
+	"It looks like no new text has been added.  Really post? "))
+   ;; Check the length of the signature.
+   (or
+    (message-check-element 'signature)
+    (progn
+      (goto-char (point-max))
+      (if (or (not (re-search-backward "^-- $" nil t))
+	      (search-forward message-forward-end-separator nil t))
+	  t
+	(if (> (count-lines (point) (point-max)) 5)
+	    (y-or-n-p
+	     (format
+	      "Your .sig is %d lines; it should be max 4.  Really post? "
+	      (count-lines (point) (point-max))))
+	  t))))))
+
+(defun message-check-element (type)
+  "Returns non-nil if this type is not to be checked."
+  (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
+      t
+    (let ((able (assq type message-syntax-checks)))
+      (and (consp able)
+	   (eq (cdr able) 'disabled)))))
+
+(defun message-checksum ()
+  "Return a \"checksum\" for the current buffer."
+  (let ((sum 0))
+    (save-excursion
+      (goto-char (point-min))
+      (re-search-forward
+       (concat "^" (regexp-quote mail-header-separator) "$"))
+      (while (not (eobp))
+	(when (not (looking-at "[ \t\n]"))
+	  (setq sum (logxor (ash sum 1) (following-char))))
+	(forward-char 1)))
+    sum))
+
+(defun message-do-fcc ()
+  "Process Fcc headers in the current buffer."
+  (let ((case-fold-search t)
+	(buf (current-buffer))
+	list file)
+    (save-excursion
+      (set-buffer (get-buffer-create " *message temp*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (insert-buffer-substring buf)
+      (save-restriction
+	(message-narrow-to-headers)
+	(while (setq file (message-fetch-field "fcc"))
+	  (push file list)
+	  (message-remove-header "fcc" nil t)))
+      (goto-char (point-min))
+      (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+      (replace-match "" t t)
+      ;; Process FCC operations.
+      (while list
+	(setq file (pop list))
+	(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
+	    ;; Pipe the article to the program in question.
+	    (call-process-region (point-min) (point-max) shell-file-name
+				 nil nil nil shell-command-switch
+				 (match-string 1 file))
+	  ;; Save the article.
+	  (setq file (expand-file-name file))
+	  (unless (file-exists-p (file-name-directory file))
+	    (make-directory (file-name-directory file) t))
+	  (if (and message-fcc-handler-function
+		   (not (eq message-fcc-handler-function 'rmail-output)))
+	      (funcall message-fcc-handler-function file)
+	    (if (and (file-readable-p file) (mail-file-babyl-p file))
+		(rmail-output file 1)
+	      (let ((mail-use-rfc822 t))
+		(rmail-output file 1 t t))))))
+      (kill-buffer (current-buffer)))))
+
+(defun message-cleanup-headers ()
+  "Do various automatic cleanups of the headers."
+  ;; Remove empty lines in the header.
+  (save-restriction
+    (message-narrow-to-headers)
+    (while (re-search-forward "^[ \t]*\n" 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)))
+    (timezone-make-date-arpa-standard 
+     (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))))
+		"_-_" ""))
+	  "@" (message-make-fqdn) ">"))
+
+(defvar message-unique-id-char nil)
+
+;; If you ever change this function, make sure the new version
+;; cannot generate IDs that the old version could.
+;; You might for example insert a "." somewhere (not next to another dot
+;; or string boundary), or modify the "fsf" string.
+(defun message-unique-id ()
+  ;; Don't use microseconds from (current-time), they may be unsupported.
+  ;; Instead we use this randomly inited counter.
+  (setq message-unique-id-char
+	(% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+	   ;; (current-time) returns 16-bit ints,
+	   ;; and 2^16*25 just fits into 4 digits i base 36.
+	   (* 25 25)))
+  (let ((tm (current-time)))
+    (concat
+     (if (memq system-type '(ms-dos emx vax-vms))
+	 (let ((user (downcase (user-login-name))))
+	   (while (string-match "[^a-z0-9_]" user)
+	     (aset user (match-beginning 0) ?_))
+	   user)
+       (message-number-base36 (user-uid) -1))
+     (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)
+     ;; Append the newsreader name, because while the generated
+     ;; ID is unique to this newsreader, other newsreaders might
+     ;; otherwise generate the same ID via another algorithm.
+     ".fsf")))
+
+(defun message-number-base36 (num len)
+  (if (if (< len 0) (<= num 0) (= len 0))
+      ""
+    (concat (message-number-base36 (/ num 36) (1- len))
+	    (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
+				  (% num 36))))))
+
+(defun message-make-organization ()
+  "Make an Organization header."
+  (let* ((organization 
+	  (or (getenv "ORGANIZATION")
+	      (when message-user-organization
+		(if (message-functionp message-user-organization)
+		    (funcall message-user-organization)
+		  message-user-organization)))))
+    (save-excursion
+      (message-set-work-buffer)
+      (cond ((stringp organization)
+	     (insert organization))
+	    ((and (eq t organization)
+		  message-user-organization-file
+		  (file-exists-p message-user-organization-file))
+	     (insert-file-contents message-user-organization-file)))
+      (goto-char (point-min))
+      (while (re-search-forward "[\t\n]+" nil t)
+	(replace-match "" t t))
+      (unless (zerop (buffer-size))
+	(buffer-string)))))
+
+(defun message-make-lines ()
+  "Count the number of lines and return numeric string."
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (point-min))
+      (re-search-forward 
+       (concat "^" (regexp-quote mail-header-separator) "$"))
+      (forward-line 1)
+      (int-to-string (count-lines (point) (point-max))))))
+
+(defun message-make-in-reply-to ()
+  "Return the In-Reply-To header for this message."
+  (when message-reply-headers
+    (let ((from (mail-header-from message-reply-headers))
+	  (date (mail-header-date message-reply-headers)))
+      (when from
+	(let ((stop-pos 
+	       (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
+	  (concat (if stop-pos (substring from 0 stop-pos) from)
+		  "'s message of " 
+		  (if (or (not date) (string= date ""))
+		      "(unknown date)" date)))))))
+
+(defun message-make-distribution ()
+  "Make a Distribution header."
+  (let ((orig-distribution (message-fetch-reply-field "distribution")))
+    (cond ((message-functionp message-distribution-function)
+	   (funcall message-distribution-function))
+	  (t orig-distribution))))
+
+(defun message-make-expires ()
+  "Return an Expires header based on `message-expires'."
+  (let ((current (current-time))
+	(future (* 1.0 message-expires 60 60 24)))
+    ;; Add the future to current.
+    (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 
+     (current-time-string current) (current-time-zone current) '(0 "UT"))))
+
+(defun message-make-path ()
+  "Return uucp path."
+  (let ((login-name (user-login-name)))
+    (cond ((null message-user-path)
+	   (concat (system-name) "!" login-name))
+	  ((stringp message-user-path)
+	   ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
+	   (concat message-user-path "!" login-name))
+	  (t login-name))))
+
+(defun message-make-from ()
+  "Make a From header."
+  (let* ((login (message-make-address))
+	 (fullname 
+	  (or (and (boundp 'user-full-name)
+		   user-full-name)
+	      (user-full-name))))
+    (when (string= fullname "&")
+      (setq fullname (user-login-name)))
+    (save-excursion
+      (message-set-work-buffer)
+      (cond 
+       ((or (null message-from-style)
+	    (equal fullname ""))
+	(insert login))
+       ((or (eq message-from-style 'angles)
+	    (and (not (eq message-from-style 'parens))
+		 ;; Use angles if no quoting is needed, or if parens would
+		 ;; need quoting too.
+		 (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))
+		     (let ((tmp (concat fullname nil)))
+		       (while (string-match "([^()]*)" tmp)
+			 (aset tmp (match-beginning 0) ?-)
+			 (aset tmp (1- (match-end 0)) ?-))
+		       (string-match "[\\()]" tmp)))))
+	(insert fullname)
+	(goto-char (point-min))
+	;; Look for a character that cannot appear unquoted
+	;; according to RFC 822.
+	(when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
+	  ;; Quote fullname, escaping specials.
+	  (goto-char (point-min))
+	  (insert "\"")
+	  (while (re-search-forward "[\"\\]" nil 1)
+	    (replace-match "\\\\\\&" t))
+	  (insert "\""))
+	(insert " <" login ">"))
+       (t				; 'parens or default
+	(insert login " (")
+	(let ((fullname-start (point)))
+	  (insert fullname)
+	  (goto-char fullname-start)
+	  ;; RFC 822 says \ and nonmatching parentheses
+	  ;; must be escaped in comments.
+	  ;; Escape every instance of ()\ ...
+	  (while (re-search-forward "[()\\]" nil 1)
+	    (replace-match "\\\\\\&" t))
+	  ;; ... then undo escaping of matching parentheses,
+	  ;; including matching nested parentheses.
+	  (goto-char fullname-start)
+	  (while (re-search-forward 
+		  "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
+		    nil 1)
+	    (replace-match "\\1(\\3)" t)
+	    (goto-char fullname-start)))
+	(insert ")")))
+      (buffer-string))))
+
+(defun message-make-sender ()
+  "Return the \"real\" user address.
+This function tries to ignore all user modifications, and 
+give as trustworthy answer as possible."
+  (concat (user-login-name) "@" (system-name)))
+
+(defun message-make-address ()
+  "Make the address of the user."
+  (or (message-user-mail-address)
+      (concat (user-login-name) "@" (message-make-domain))))
+
+(defun message-user-mail-address ()
+  "Return the pertinent part of `user-mail-address'."
+  (when user-mail-address
+    (nth 1 (mail-extract-address-components user-mail-address))))
+
+(defun message-make-fqdn ()
+  "Return user's fully qualified domain name."
+  (let ((system-name (system-name))
+	(user-mail (message-user-mail-address)))
+    (cond 
+     ((string-match "[^.]\\.[^.]" system-name)
+      ;; `system-name' returned the right result.
+      system-name)
+     ;; Try `mail-host-address'.
+     ((and (boundp 'mail-host-address)
+	   (stringp mail-host-address)
+	   (string-match "\\." mail-host-address))
+      mail-host-address)
+     ;; We try `user-mail-address' as a backup.
+     ((and (string-match "\\." user-mail)
+	   (string-match "@\\(.*\\)\\'" user-mail))
+      (match-string 1 user-mail))
+     ;; Default to this bogus thing.
+     (t
+      (concat system-name ".i-have-a-misconfigured-system-so-shoot-me")))))
+
+(defun message-make-host-name ()
+  "Return the name of the host."
+  (let ((fqdn (message-make-fqdn)))
+    (string-match "^[^.]+\\." fqdn)
+    (substring fqdn 0 (1- (match-end 0)))))
+
+(defun message-make-domain ()
+  "Return the domain name."
+  (or mail-host-address
+      (message-make-fqdn)))
+
+(defun message-generate-headers (headers)
+  "Prepare article HEADERS.
+Headers already prepared in the buffer are not modified."
+  (save-restriction
+    (message-narrow-to-headers)
+    (let* ((Date (message-make-date))
+	   (Message-ID (message-make-message-id))
+	   (Organization (message-make-organization))
+	   (From (message-make-from))
+	   (Path (message-make-path))
+	   (Subject nil)
+	   (Newsgroups nil)
+	   (In-Reply-To (message-make-in-reply-to))
+	   (To nil)
+	   (Distribution (message-make-distribution))
+	   (Lines (message-make-lines))
+	   (X-Newsreader message-newsreader)
+	   (X-Mailer (and (not (message-fetch-field "X-Newsreader"))
+			  message-mailer))
+	   (Expires (message-make-expires))
+	   (case-fold-search t)
+	   header value elem)
+      ;; First we remove any old generated headers.
+      (let ((headers message-deletable-headers))
+	(while headers
+	  (goto-char (point-min))
+	  (and (re-search-forward 
+		(concat "^" (symbol-name (car headers)) ": *") nil t)
+	       (get-text-property (1+ (match-beginning 0)) 'message-deletable)
+	       (message-delete-line))
+	  (pop headers)))
+      ;; 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. 
+      (while headers
+	(goto-char (point-min))
+	(setq elem (pop headers))
+	(if (consp elem)
+	    (if (eq (car elem) 'optional)
+		(setq header (cdr elem))
+	      (setq header (car elem)))
+	  (setq header elem))
+	(when (or (not (re-search-forward 
+			(concat "^" (downcase (symbol-name header)) ":") 
+			nil t))
+		  (progn
+		    ;; The header was found. We insert a space after the
+		    ;; colon, if there is none.
+		    (if (/= (following-char) ? ) (insert " ") (forward-char 1))
+		    ;; Find out whether the header is empty...
+		    (looking-at "[ \t]*$")))
+	  ;; So we find out what value we should insert.
+	  (setq value
+		(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
+		  ;; this header.
+		  (setq header (cdr elem))
+		  (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
+		      (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
+		 ((consp elem)
+		  ;; The element is a cons.  Either the cdr is a
+		  ;; string to be inserted verbatim, or it is a
+		  ;; function, and we insert the value returned from
+		  ;; this function.
+		  (or (and (stringp (cdr elem)) (cdr elem))
+		      (and (fboundp (cdr elem)) (funcall (cdr elem)))))
+		 ((and (boundp header) (symbol-value header))
+		  ;; The element is a symbol.  We insert the value
+		  ;; of this symbol, if any.
+		  (symbol-value header))
+		 (t
+		  ;; We couldn't generate a value for this header,
+		  ;; so we just ask the user.
+		  (read-from-minibuffer
+		   (format "Empty header for %s; enter value: " header)))))
+	  ;; Finally insert the header.
+	  (when (and value 
+		     (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")
+		    (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))
+		(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 
+		    (point) (match-end 0)
+		    '(message-deletable t face italic) (current-buffer)))))))
+      ;; Insert new Sender if the From is strange. 
+      (let ((from (message-fetch-field "from"))
+	    (sender (message-fetch-field "sender"))
+	    (secure-sender (message-make-sender)))
+	(when (and from 
+		   (not (message-check-element 'sender))
+		   (not (string=
+			 (downcase
+			  (cadr (mail-extract-address-components from)))
+			 (downcase secure-sender)))
+		   (or (null sender)
+		       (not 
+			(string=
+			 (downcase
+			  (cadr (mail-extract-address-components sender)))
+			 (downcase secure-sender)))))
+	  (goto-char (point-min))    
+	  ;; Rename any old Sender headers to Original-Sender.
+	  (when (re-search-forward "^Sender:" nil t)
+	    (beginning-of-line)
+	    (insert "Original-")
+	    (beginning-of-line))
+	  (insert "Sender: " secure-sender "\n"))))))
+
+(defun message-insert-courtesy-copy ()
+  "Insert a courtesy message in mail copies of combined messages."
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers)
+      (let ((newsgroups (message-fetch-field "newsgroups")))
+	(when newsgroups
+	  (goto-char (point-max))
+	  (insert "Posted-To: " newsgroups "\n"))))
+    (forward-line 1)
+    (insert message-courtesy-message)))
+    
+;;;
+;;; Setting up a message buffer
+;;;
+
+(defun message-fill-address (header value)
+  (save-restriction
+    (narrow-to-region (point) (point))
+    (insert (capitalize (symbol-name header))
+	    ": "
+	    (if (consp value) (car value) value)
+	    "\n")
+    (narrow-to-region (point-min) (1- (point-max)))
+    (let (quoted last)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(skip-chars-forward "^,\"" (point-max))
+	(if (or (= (following-char) ?,)
+		(eobp))
+	    (when (not quoted)
+	      (if (and (> (current-column) 78)
+		       last)
+		  (progn
+		    (save-excursion
+		      (goto-char last)
+		      (insert "\n\t"))
+		    (setq last (1+ (point))))
+		(setq last (1+ (point)))))
+	  (setq quoted (not quoted)))
+	(unless (eobp)
+	  (forward-char 1))))
+    (goto-char (point-max))
+    (widen)
+    (forward-line 1)))
+
+(defun message-fill-header (header value)
+  (let ((begin (point))
+	(fill-column 78)
+	(fill-prefix "\t"))
+    (insert (capitalize (symbol-name header))
+	    ": "
+	    (if (consp value) (car value) value)
+	    "\n")
+    (save-restriction
+      (narrow-to-region begin (point))
+      (fill-region-as-paragraph begin (point))
+      ;; Tapdance around looong Message-IDs.
+      (forward-line -1)
+      (when (looking-at "[ \t]*$")
+	(message-delete-line))
+      (goto-char begin)
+      (re-search-forward ":" nil t)
+      (when (looking-at "\n[ \t]+")
+	(replace-match " " t t))
+      (goto-char (point-max)))))
+
+(defun message-position-point ()
+  "Move point to where the user probably wants to find it."
+  (message-narrow-to-headers)
+  (cond 
+   ((re-search-forward "^[^:]+:[ \t]*$" nil t)
+    (search-backward ":" )
+    (widen)
+    (forward-char 1)
+    (if (= (following-char) ? )
+	(forward-char 1)
+      (insert " ")))
+   (t
+    (goto-char (point-max))
+    (widen)
+    (forward-line 1)
+    (unless (looking-at "$")
+      (forward-line 2)))
+   (sit-for 0)))
+
+(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, 
+   ;; and if so, call it.
+   ((message-functionp message-generate-new-buffers)
+    (funcall message-generate-new-buffers type to group))
+   ;; Generate a new buffer name The Message Way.
+   (message-generate-new-buffers
+    (generate-new-buffer-name
+     (concat "*" type
+	     (if to
+		 (concat " to "
+			 (or (car (mail-extract-address-components to))
+			     to) "")
+	       "")
+	     (if (and group (not (string= group ""))) (concat " on " group) "")
+	     "*")))
+   ;; Use standard name.
+   (t
+    (format "*%s message*" type))))
+
+(defun message-pop-to-buffer (name)
+  "Pop to buffer NAME, and warn if it already exists and is modified."
+  (let ((buffer (get-buffer name)))
+    (if (and buffer
+	     (buffer-name buffer))
+	(progn
+	  (set-buffer (pop-to-buffer buffer))
+	  (when (and (buffer-modified-p)
+		     (not (y-or-n-p
+			   "Message already being composed; erase? ")))
+	    (error "Message being composed")))
+      (set-buffer (pop-to-buffer name))))
+  (erase-buffer)
+  (message-mode))
+
+(defun message-do-send-housekeeping ()
+  "Kill old message buffers."
+  ;; We might have sent this buffer already.  Delete it from the
+  ;; list of buffers.
+  (setq message-buffer-list (delq (current-buffer) message-buffer-list))
+  (when (and message-max-buffers
+	     (>= (length message-buffer-list) message-max-buffers))
+    ;; Kill the oldest buffer -- unless it has been changed.
+    (let ((buffer (pop message-buffer-list)))
+      (when (and (buffer-name buffer)
+		 (not (buffer-modified-p buffer)))
+	(kill-buffer buffer))))
+  ;; Rename the buffer.
+  (if message-send-rename-function
+      (funcall message-send-rename-function)
+    (when (string-match "\\`\\*" (buffer-name))
+      (rename-buffer 
+       (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
+  ;; Push the current buffer onto the list.
+  (when message-max-buffers
+    (setq message-buffer-list 
+	  (nconc message-buffer-list (list (current-buffer))))))
+
+(defvar mc-modes-alist)
+(defun message-setup (headers &optional replybuffer actions)
+  (when (and (boundp 'mc-modes-alist)
+	     (not (assq 'message-mode mc-modes-alist)))
+    (push '(message-mode (encrypt . mc-encrypt-message)
+			 (sign . mc-sign-message))
+	  mc-modes-alist))
+  (when actions
+    (setq message-send-actions actions))
+  (setq message-reply-buffer replybuffer)
+  (goto-char (point-min))
+  ;; Insert all the headers.
+  (mail-header-format 
+   (let ((h headers)
+	 (alist message-header-format-alist))
+     (while h
+       (unless (assq (caar h) message-header-format-alist)
+	 (push (list (caar h)) alist))
+       (pop h))
+     alist)
+   headers)
+  (delete-region (point) (progn (forward-line -1) (point)))
+  (when message-default-headers
+    (insert message-default-headers))
+  (put-text-property
+   (point)
+   (progn
+     (insert mail-header-separator "\n")
+     (1- (point)))
+   'read-only nil)
+  (forward-line -1)
+  (when (message-news-p)
+    (when message-default-news-headers
+      (insert message-default-news-headers))
+    (when message-generate-headers-first
+      (message-generate-headers
+       (delq 'Lines
+	     (delq 'Subject
+		   (copy-sequence message-required-news-headers))))))
+  (when (message-mail-p)
+    (when message-default-mail-headers
+      (insert message-default-mail-headers))
+    (when message-generate-headers-first
+      (message-generate-headers
+       (delq 'Lines
+	     (delq 'Subject
+		   (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)
+  (run-hooks 'message-setup-hook)
+  (message-position-point)
+  (undo-boundary))
+
+(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))))
+
+
+
+;;;
+;;; Commands for interfacing with message
+;;;
+
+;;;###autoload
+(defun message-mail (&optional to subject)
+  "Start editing a mail message to be sent."
+  (interactive)
+  (message-pop-to-buffer (message-buffer-name "mail" to))
+  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-news (&optional newsgroups subject)
+  "Start editing a news article to be sent."
+  (interactive)
+  (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
+  (message-setup `((Newsgroups . ,(or newsgroups "")) 
+		   (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-reply (&optional to-address wide ignore-reply-to)
+  "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 
+	mct never-mct gnus-warning)
+    (save-restriction
+      (narrow-to-region
+       (goto-char (point-min))
+       (if (search-forward "\n\n" nil t)
+	   (1- (point))
+	 (point-max)))
+      ;; Allow customizations to have their say.
+      (if (not wide)
+	  ;; This is a regular reply.
+	  (if (message-functionp message-reply-to-function)
+	      (setq follow-to (funcall message-reply-to-function)))
+	;; This is a followup.
+	(if (message-functionp message-wide-reply-to-function)
+	    (save-excursion
+	      (setq follow-to
+		    (funcall message-wide-reply-to-function)))))
+      ;; Find all relevant headers we need.
+      (setq from (message-fetch-field "from")
+	    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")
+	    reply-to (unless ignore-reply-to (message-fetch-field "reply-to"))
+	    references (message-fetch-field "references")
+	    message-id (message-fetch-field "message-id"))
+      ;; Remove any (buggy) Re:'s that are present and make a
+      ;; proper one.
+      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" 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)))
+	    
+      ;; Handle special values of Mail-Copies-To.
+      (when mct
+	(cond ((equal (downcase mct) "never")
+	       (setq never-mct t)
+	       (setq mct nil))
+	      ((equal (downcase mct) "always")
+	       (setq mct (or reply-to from)))))
+
+      (unless follow-to
+	(if (or (not wide)
+		to-address)
+	    (setq follow-to (list (cons 'To (or to-address reply-to from))))
+	  (let (ccalist)
+	    (save-excursion
+	      (message-set-work-buffer)
+	      (unless never-mct
+		(insert (or reply-to from "")))
+	      (insert 
+	       (if (bolp) "" ", ") (or to "")
+	       (if mct (concat (if (bolp) "" ", ") mct) "")
+	       (if cc (concat (if (bolp) "" ", ") cc) ""))
+	      ;; Remove addresses that match `rmail-dont-reply-to-names'. 
+	      (insert (prog1 (rmail-dont-reply-to (buffer-string))
+			(erase-buffer)))
+	      (goto-char (point-min))
+	      (setq ccalist
+		    (mapcar
+		     (lambda (addr)
+		       (cons (mail-strip-quoted-names addr) addr))
+		     (nreverse (mail-parse-comma-list))))
+	      (let ((s ccalist))
+		(while s
+		  (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
+	    (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
+	    (when ccalist
+	      (push (cons 'Cc
+			  (mapconcat (lambda (addr) (cdr addr)) ccalist ", "))
+		    follow-to)))))
+      (widen))
+
+    (message-pop-to-buffer (message-buffer-name "reply" from))
+
+    (setq message-reply-headers
+	  (vector 0 subject from date message-id references 0 0 ""))
+
+    (message-setup
+     `((Subject . ,subject)
+       ,@follow-to 
+       ,@(if (or references message-id)
+	     `((References . ,(concat (or references "") (and references " ")
+				      (or message-id ""))))
+	   nil))
+     cur)))
+
+;;;###autoload
+(defun message-wide-reply (&optional to-address)
+  (interactive)
+  (message-reply to-address t))
+
+;;;###autoload
+(defun message-followup ()
+  (interactive)
+  (let ((cur (current-buffer))
+	from subject date reply-to mct
+	references message-id follow-to 
+	followup-to distribution newsgroups gnus-warning)
+    (save-restriction
+      (narrow-to-region
+       (goto-char (point-min))
+       (if (search-forward "\n\n" nil t)
+	   (1- (point))
+	 (point-max)))
+      (when (message-functionp message-followup-to-function)
+	(setq follow-to
+	      (funcall message-followup-to-function)))
+      (setq from (message-fetch-field "from")
+	    date (message-fetch-field "date") 
+	    subject (or (message-fetch-field "subject") "none")
+	    references (message-fetch-field "references")
+	    message-id (message-fetch-field "message-id")
+	    followup-to (message-fetch-field "followup-to")
+	    newsgroups (message-fetch-field "newsgroups")
+	    reply-to (message-fetch-field "reply-to")
+	    distribution (message-fetch-field "distribution")
+	    mct (message-fetch-field "mail-copies-to"))
+      (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+		 (string-match "<[^>]+>" gnus-warning))
+	(setq message-id (match-string 0 gnus-warning)))
+      ;; Remove bogus distribution.
+      (and (stringp distribution)
+	   (string-match "world" distribution)
+	   (setq distribution nil))
+      ;; Remove any (buggy) Re:'s that are present and make a
+      ;; proper one.
+      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+	(setq subject (substring subject (match-end 0))))
+      (setq subject (concat "Re: " subject))
+      (widen))
+
+    (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+
+    (message-setup
+     `((Subject . ,subject)
+       ,@(cond 
+	  (follow-to follow-to)
+	  ((and followup-to message-use-followup-to)
+	   (list
+	    (cond 
+	     ((equal (downcase followup-to) "poster")
+	      (if (or (eq message-use-followup-to 'use)
+		      (message-y-or-n-p "Obey Followup-To: poster? " t "\
+You should normally obey the Followup-To: header.
+
+`Followup-To: poster' sends your response via e-mail instead of news.
+
+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 ""))
+		(cons 'Newsgroups newsgroups)))
+	     (t
+	      (if (or (equal followup-to newsgroups)
+		      (not (eq message-use-followup-to 'ask))
+		      (message-y-or-n-p
+		       (concat "Obey Followup-To: " followup-to "? ") t "\
+You should normally obey the Followup-To: header.
+
+	`Followup-To: " followup-to "'
+directs your response to " (if (string-match "," followup-to)
+			       "the specified newsgroups"
+			     "that newsgroup only") ".
+
+If a message is posted to several newsgroups, Followup-To is often
+used to direct the following discussion to one newsgroup only,
+because discussions that are spread over several newsgroup tend to
+be fragmented and very difficult to follow.
+
+Also, some source/announcment newsgroups are not indented for discussion;
+responses here are directed to other newsgroups."))
+		  (cons 'Newsgroups followup-to)
+		(cons 'Newsgroups newsgroups))))))
+	  (t
+	   `((Newsgroups . ,newsgroups))))
+       ,@(and distribution (list (cons 'Distribution distribution)))
+       (References . ,(concat (or references "") (and references " ")
+			      (or message-id "")))
+       ,@(when (and mct
+		    (not (equal (downcase mct) "never")))
+	   (list (cons 'Cc (if (equal (downcase mct) "always")
+			       (or reply-to from "")
+			     mct)))))
+
+     cur)
+
+    (setq message-reply-headers
+	  (vector 0 subject from date message-id references 0 0 ""))))
+
+
+;;;###autoload
+(defun message-cancel-news ()
+  "Cancel an article you posted."
+  (interactive)
+  (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)
+      (save-excursion
+	;; Get header info. from original article.
+	(save-restriction
+	  (message-narrow-to-head)
+	  (setq from (message-fetch-field "from")
+		newsgroups (message-fetch-field "newsgroups")
+		message-id (message-fetch-field "message-id")
+		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)))
+	  (error "This article is not yours"))
+	;; Make control message.
+	(setq buf (set-buffer (get-buffer-create " *message cancel*")))
+	(buffer-disable-undo (current-buffer))
+	(erase-buffer)
+	(insert "Newsgroups: " newsgroups "\n"
+		"From: " (message-make-from) "\n"
+		"Subject: cmsg cancel " message-id "\n"
+		"Control: cancel " message-id "\n"
+		(if distribution
+		    (concat "Distribution: " distribution "\n")
+		  "")
+		mail-header-separator "\n"
+		"This is a cancel message from " from ".\n")
+	(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")
+	(kill-buffer buf)))))
+
+;;;###autoload
+(defun message-supersede ()
+  "Start composing a message to supersede the current message.
+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)))
+    ;; Check whether the user owns the article that is to be superseded. 
+    (unless (string-equal
+	     (downcase (cadr (mail-extract-address-components
+			      (message-fetch-field "from"))))
+	     (downcase (message-make-address)))
+      (error "This article is not yours"))
+    ;; Get a normal message buffer.
+    (message-pop-to-buffer (message-buffer-name "supersede"))
+    (insert-buffer-substring cur)
+    (message-narrow-to-head)
+    ;; Remove unwanted headers.
+    (when message-ignored-supersedes-headers
+      (message-remove-header message-ignored-supersedes-headers t))
+    (goto-char (point-min))
+    (if (not (re-search-forward "^Message-ID: " nil t))
+	(error "No Message-ID in this article")
+      (replace-match "Supersedes: " t t))
+    (goto-char (point-max))
+    (insert mail-header-separator)
+    (widen)
+    (forward-line 1)))
+
+;;;###autoload
+(defun message-recover ()
+  "Reread contents of current buffer from its last auto-save file."
+  (interactive)
+  (let ((file-name (make-auto-save-file-name)))
+    (cond ((save-window-excursion
+	     (if (not (eq system-type 'vax-vms))
+		 (with-output-to-temp-buffer "*Directory*"
+		   (buffer-disable-undo standard-output)
+		   (let ((default-directory "/"))
+		     (call-process
+		      "ls" nil standard-output nil "-l" file-name))))
+	     (yes-or-no-p (format "Recover auto save file %s? " file-name)))
+	   (let ((buffer-read-only nil))
+	     (erase-buffer)
+	     (insert-file-contents file-name nil)))
+	  (t (error "message-recover cancelled")))))
+
+;;; Forwarding messages.
+
+(defun message-make-forward-subject ()
+  "Return a Subject header suitable for the message in the current buffer."
+  (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from"))
+		  "(nowhere)")
+	  "] " (or (message-fetch-field "Subject") "")))
+
+;;;###autoload
+(defun message-forward (&optional news)
+  "Forward the current message via mail.  
+Optional NEWS will use news to forward instead of mail."
+  (interactive "P")
+  (let ((cur (current-buffer))
+	(subject (message-make-forward-subject)))
+    (if news (message-news nil subject) (message-mail nil subject))
+    ;; Put point where we want it before inserting the forwarded
+    ;; message. 
+    (if message-signature-before-forwarded-message
+	(goto-char (point-max))
+      (message-goto-body))
+    ;; Make sure we're at the start of the line.
+    (unless (eolp)
+      (insert "\n"))
+    ;; Narrow to the area we are to insert.
+    (narrow-to-region (point) (point))
+    ;; Insert the separators and the forwarded buffer.
+    (insert message-forward-start-separator)
+    (insert-buffer-substring cur)
+    (goto-char (point-max))
+    (insert message-forward-end-separator)
+    (set-text-properties (point-min) (point-max) nil)
+    ;; Remove all unwanted headers.
+    (goto-char (point-min))
+    (forward-line 1)
+    (narrow-to-region (point) (if (search-forward "\n\n" nil t)
+				  (1- (point))
+				(point)))
+    (goto-char (point-min))
+    (message-remove-header message-included-forward-headers t nil t)
+    (widen)
+    (message-position-point)))
+
+;;;###autoload
+(defun message-resend (address)
+  "Resend the current article to ADDRESS."
+  (interactive "sResend message to: ")
+  (save-excursion
+    (let ((cur (current-buffer))
+	  beg)
+      ;; We first set up a normal mail buffer.
+      (set-buffer (get-buffer-create " *message resend*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (message-setup `((To . ,address)))
+      ;; Insert our usual headers.
+      (message-generate-headers '(From Date To))
+      (message-narrow-to-headers)
+      ;; Rename them all to "Resent-*".
+      (while (re-search-forward "^[A-Za-z]" nil t)
+	(forward-char -1)
+	(insert "Resent-"))
+      (widen)
+      (forward-line)
+      (delete-region (point) (point-max))
+      (setq beg (point))
+      ;; Insert the message to be resent.
+      (insert-buffer-substring cur)
+      (goto-char (point-min))
+      (search-forward "\n\n")
+      (forward-char -1)
+      (save-restriction
+	(narrow-to-region beg (point))
+	(message-remove-header message-ignored-resent-headers t)
+	(goto-char (point-max)))
+      (insert mail-header-separator)
+      ;; Rename all old ("Also-")Resent headers.
+      (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
+	(beginning-of-line)
+	(insert "Also-"))
+      ;; Send it.
+      (message-send-mail)
+      (kill-buffer (current-buffer)))))
+
+;;;###autoload
+(defun message-bounce ()
+  "Re-mail the current message.
+This only makes sense if the current message is a bounce message than
+contains some mail you have written which has been bounced back to
+you."
+  (interactive)
+  (let ((cur (current-buffer))
+	boundary)
+    (message-pop-to-buffer (message-buffer-name "bounce"))
+    (insert-buffer-substring cur)
+    (undo-boundary)
+    (message-narrow-to-head)
+    (if (and (message-fetch-field "Mime-Version")
+	     (setq boundary (message-fetch-field "Content-Type")))
+	(if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
+	    (setq boundary (concat (match-string 1 boundary) " *\n"
+				   "Content-Type: message/rfc822"))
+	  (setq boundary nil)))
+    (widen)
+    (goto-char (point-min))
+    (search-forward "\n\n" nil t)
+    (or (and boundary
+	     (re-search-forward boundary nil t)
+	     (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)))
+    ;; We remove everything before the bounced mail.
+    (delete-region 
+     (point-min)
+     (if (re-search-forward "^[^ \n\t]+:" nil t)
+	 (match-beginning 0)
+       (point)))
+    (save-restriction
+      (message-narrow-to-head)
+      (message-remove-header message-ignored-bounced-headers t)
+      (goto-char (point-max))
+      (insert mail-header-separator))
+    (message-position-point)))
+
+;;;
+;;; Interactive entry points for new message buffers.
+;;;
+
+;;;###autoload
+(defun message-mail-other-window (&optional to subject)
+  "Like `message-mail' command, but display mail buffer in another window."
+  (interactive)
+  (let ((pop-up-windows t)
+	(special-display-buffer-names nil)
+	(special-display-regexps nil)
+	(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 "")))))
+
+;;;###autoload
+(defun message-mail-other-frame (&optional to subject)
+  "Like `message-mail' command, but display mail buffer in another frame."
+  (interactive)
+  (let ((pop-up-frames t)
+	(special-display-buffer-names nil)
+	(special-display-regexps nil)
+	(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 "")))))
+
+;;;###autoload
+(defun message-news-other-window (&optional newsgroups subject)
+  "Start editing a news article to be sent."
+  (interactive)
+  (let ((pop-up-windows t)
+	(special-display-buffer-names nil)
+	(special-display-regexps nil)
+	(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 "")))))
+
+;;;###autoload
+(defun message-news-other-frame (&optional newsgroups subject)
+  "Start editing a news article to be sent."
+  (interactive)
+  (let ((pop-up-frames t)
+	(special-display-buffer-names nil)
+	(special-display-regexps nil)
+	(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 "")))))
+
+;;; underline.el
+
+;; This code should be moved to underline.el (from which it is stolen). 
+
+;;;###autoload
+(defun bold-region (start end)
+  "Bold all nonblank characters in the region.
+Works by overstriking characters.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+  (interactive "r")
+  (save-excursion
+   (let ((end1 (make-marker)))
+     (move-marker end1 (max start end))
+     (goto-char (min start end))
+     (while (< (point) end1)
+       (or (looking-at "[_\^@- ]")
+	   (insert (following-char) "\b"))
+       (forward-char 1)))))
+
+;;;###autoload
+(defun unbold-region (start end)
+  "Remove all boldness (overstruck characters) in the region.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+  (interactive "r")
+  (save-excursion
+   (let ((end1 (make-marker)))
+     (move-marker end1 (max 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))))))
+
+(fset 'message-exchange-point-and-mark 'exchange-point-and-mark)
+
+;; Support for toolbar
+(when (string-match "XEmacs\\|Lucid" emacs-version)
+  (require 'messagexmas))
+
+;;; Group name completion.
+
+(defvar message-newgroups-header-regexp
+  "^\\(Newsgroups\\|Followup-To\\|Posted-To\\):"
+  "Regexp that match headers that lists groups.")
+
+(defun message-tab ()
+  "Expand group names in Newsgroups and Followup-To headers.
+Do a `tab-to-tab-stop' if not in those headers."
+  (interactive)
+  (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp))
+	(mail-abbrev-in-expansion-header-p))
+      (message-expand-group)
+    (tab-to-tab-stop)))
+
+(defvar gnus-active-hashtb)
+(defun message-expand-group ()
+  (let* ((b (save-excursion (skip-chars-backward "^, :\t\n") (point)))
+	 (completion-ignore-case t)
+	 (string (buffer-substring 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 
+     ((= (length completions) 1)
+      (if (string= (car completions) string)
+	  (progn
+	    (insert string)
+	    (message "Only matching group"))
+	(insert (car completions))))
+     ((and (setq comp (try-completion string hashtb))
+	   (not (string= comp string)))
+      (insert comp))
+     (t
+      (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)))))))
+
+;;; Help stuff.
+
+(defmacro message-y-or-n-p (question show &rest text)
+  "Ask QUESTION, displaying the rest of the arguments in a temporary buffer."
+  `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
+
+(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.  
+The following arguments may contain lists of values."
+  (if (and show
+	   (setq text (message-flatten-list text)))
+      (save-window-excursion
+	(save-excursion
+	  (with-output-to-temp-buffer " *MESSAGE information message*"
+	    (set-buffer " *MESSAGE information message*")
+	    (mapcar 'princ text)
+	    (goto-char (point-min))))
+	(funcall ask question))
+    (funcall ask question)))
+
+(defun message-flatten-list (&rest list)
+  (message-flatten-list-1 list))
+
+(defun message-flatten-list-1 (list)
+  (cond ((consp list) 
+	 (apply 'append (mapcar 'message-flatten-list-1 list)))
+	(list
+	 (list list))))
+
+(run-hooks 'message-load-hook)
+
+(provide 'message)
+
+;;; message.el ends here