* gnus-agent.el (gnus-agent-request-article): Make sure it is not
[gnus] / lisp / message.el
index c9da66f..82e8d68 100644 (file)
@@ -1,5 +1,5 @@
-;;; message.el --- composing mail and news messages  -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;;; message.el --- composing mail and news messages
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -33,6 +33,7 @@
 (eval-when-compile
   (require 'cl)
   (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+(require 'canlock)
 (require 'mailheader)
 (require 'nnheader)
 ;; This is apparently necessary even though things are autoloaded:
@@ -41,6 +42,8 @@
 (require 'mail-parse)
 (require 'mml)
 (require 'rfc822)
+(eval-and-compile
+  (autoload 'sha1 "sha1-el"))
 
 (defgroup message '((user-mail-address custom-variable)
                    (user-full-name custom-variable))
@@ -124,6 +127,11 @@ mailbox format."
                (function :tag "Other"))
   :group 'message-sending)
 
+(defcustom message-fcc-externalize-attachments nil
+  "If non-nil, attachments are included as external parts in Fcc copies."
+  :type 'boolean
+  :group 'message-sending)
+
 (defcustom message-courtesy-message
   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
   "*This is inserted at the start of a mailed copy of a posted message.
@@ -203,20 +211,20 @@ included.  Organization, Lines and User-Agent are optional."
   :type 'sexp)
 
 (defcustom message-ignored-news-headers
-  "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:"
+  "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
   "*Regexp of headers to be removed unconditionally before posting."
   :group 'message-news
   :group 'message-headers
   :type 'regexp)
 
 (defcustom message-ignored-mail-headers
-  "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:"
+  "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
   "*Regexp of headers to be removed unconditionally before mailing."
   :group 'message-mail
   :group 'message-headers
   :type 'regexp)
 
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:"
   "*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."
@@ -424,6 +432,49 @@ always use the value."
                 (const use)
                 (const ask)))
 
+(defcustom message-subscribed-address-functions nil
+  "*Specifies functions for determining list subscription.
+If nil, do not attempt to determine list subscribtion with functions.
+If non-nil, this variable contains a list of functions which return
+regular expressions to match lists.  These functions can be used in
+conjunction with `message-subscribed-regexps' and
+`message-subscribed-addresses'."
+  :group 'message-interface
+  :type '(repeat sexp))
+
+(defcustom message-subscribed-address-file nil
+  "*A file containing addresses the user is subscribed to.
+If nil, do not look at any files to determine list subscriptions.  If
+non-nil, each line of this file should be a mailing list address."
+  :group 'message-interface
+  :type 'string)
+
+(defcustom message-subscribed-addresses nil
+  "*Specifies a list of addresses the user is subscribed to.
+If nil, do not use any predefined list subscriptions.  This list of
+addresses can be used in conjuction with
+`message-subscribed-address-functions' and `message-subscribed-regexps'."
+  :group 'message-interface
+  :type '(repeat string))
+
+(defcustom message-subscribed-regexps nil
+  "*Specifies a list of addresses the user is subscribed to.
+If nil, do not use any predefined list subscriptions.  This list of
+regular expressions can be used in conjuction with
+`message-subscribed-address-functions' and `message-subscribed-addresses'."
+  :group 'message-interface
+  :type '(repeat regexp))
+
+(defcustom message-allow-no-recipients 'ask
+  "Specifies what to do when there are no recipients other than Gcc/Fcc.
+If it is the symbol `always', the posting is allowed.  If it is the
+symbol `never', the posting is not allowed.  If it is the symbol
+`ask', you are prompted."
+  :group 'message-interface
+  :type '(choice (const always)
+                (const never)
+                (const ask)))
+
 (defcustom message-sendmail-f-is-evil nil
   "*Non-nil means don't add \"-f username\" to the sendmail command line.
 Doing so would be even more evil than leaving it out."
@@ -919,7 +970,7 @@ candidates:
          nil)
       (,(concat "^\\(" message-cite-prefix-regexp "\\).*")
        (0 'message-cited-text-face))
-      ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
+      ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\).*>"
        (0 'message-mml-face))))
   "Additional expressions to highlight in Message mode.")
 
@@ -1010,6 +1061,11 @@ no, only reply back to the author."
   :group 'message-headers
   :type 'boolean)
 
+(defcustom message-insert-canlock t
+  "Whether to insert a Cancel-Lock header in news postings."
+  :group 'message-headers
+  :type 'boolean)
+
 ;;; Internal variables.
 
 (defvar message-sending-message "Sending...")
@@ -1460,6 +1516,7 @@ Point is left at the beginning of the narrowed-to region."
   (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-o" 'message-goto-from)
   (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)
@@ -1468,14 +1525,19 @@ Point is left at the beginning of the narrowed-to region."
   (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-m" 'message-goto-mail-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-f\C-i" 'message-insert-or-toggle-importance)
   (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-u" 'message-insert-or-toggle-importance)
+  (define-key message-mode-map "\C-c\M-n" 'message-insert-disposition-notification-to)
+
   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
   (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
@@ -1498,7 +1560,8 @@ Point is left at the beginning of the narrowed-to region."
   ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
 
   (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
-
+  
+  (define-key message-mode-map "\C-a" 'message-beginning-of-line)
   (define-key message-mode-map "\t" 'message-tab)
   (define-key message-mode-map "\M-;" 'comment-region))
 
@@ -1516,6 +1579,16 @@ Point is left at the beginning of the narrowed-to region."
     ["Kill To Signature" message-kill-to-signature t]
     ["Newline and Reformat" message-newline-and-reformat t]
     ["Rename buffer" message-rename-buffer t]
+    ["Flag As Important" message-insert-importance-high
+     ,@(if (featurep 'xemacs) '(t)
+        '(:help "Mark this message as important"))]
+    ["Flag As Unimportant" message-insert-importance-low
+     ,@(if (featurep 'xemacs) '(t)
+        '(:help "Mark this message as unimportant"))]
+    ["Request Receipt" 
+     message-insert-disposition-notification-to
+     ,@(if (featurep 'xemacs) '(t)
+        '(:help "Request a Disposition Notification of this article"))]
     ["Spellcheck" ispell-message
      ,@(if (featurep 'xemacs) '(t)
         '(:help "Spellcheck this message"))]
@@ -1540,6 +1613,7 @@ Point is left at the beginning of the narrowed-to region."
     ["Fetch Newsgroups" message-insert-newsgroups t]
     "----"
     ["To" message-goto-to t]
+    ["From" message-goto-from t]
     ["Subject" message-goto-subject t]
     ["Cc" message-goto-cc t]
     ["Reply-To" message-goto-reply-to t]
@@ -1547,6 +1621,7 @@ Point is left at the beginning of the narrowed-to region."
     ["Keywords" message-goto-keywords t]
     ["Newsgroups" message-goto-newsgroups t]
     ["Followup-To" message-goto-followup-to t]
+    ["Mail-Followup-To" message-goto-mail-followup-to t]
     ["Distribution" message-goto-distribution t]
     ["Body" message-goto-body t]
     ["Signature" message-goto-signature t]))
@@ -1557,6 +1632,61 @@ Point is left at the beginning of the narrowed-to region."
   (defvar facemenu-add-face-function)
   (defvar facemenu-remove-face-function))
 
+;;; Forbidden properties
+;;
+;; We use `after-change-functions' to keep special text properties
+;; that interfer with the normal function of message mode out of the
+;; buffer. 
+
+(defcustom message-strip-special-text-properties t
+  "Strip special properties from the message buffer.
+
+Emacs has a number of special text properties which can break message
+composing in various ways.  If this option is set, message will strip
+these properties from the message composition buffer.  However, some
+packages requires these properties to be present in order to work.
+If you use one of these packages, turn this option off, and hope the
+message composition doesn't break too bad."
+  :group 'message-various
+  :type 'boolean)
+
+(defconst message-forbidden-properties 
+  ;; No reason this should be clutter up customize.  We make it a
+  ;; property list (rather than a list of property symbols), to be
+  ;; directly useful for `remove-text-properties'.
+  '(field nil read-only nil intangible nil invisible nil 
+         mouse-face nil modification-hooks nil insert-in-front-hooks nil
+         insert-behind-hooks nil point-entered nil point-left nil) 
+  ;; Other special properties:
+  ;; category, face, display: probably doesn't do any harm.
+  ;; fontified: is used by font-lock.
+  ;; syntax-table, local-map: I dunno.
+  ;; We need to add XEmacs names to the list.
+  "Property list of with properties.forbidden in message buffers.
+The values of the properties are ignored, only the property names are used.")
+
+(defun message-tamago-not-in-use-p (pos)
+  "Return t when tamago version 4 is not in use at the cursor position.
+Tamago version 4 is a popular input method for writing Japanese text.
+It uses the properties `intangible', `invisible', `modification-hooks'
+and `read-only' when translating ascii or kana text to kanji text.
+These properties are essential to work, so we should never strip them."
+  (not (and (boundp 'egg-modefull-mode)
+           (symbol-value 'egg-modefull-mode)
+           (or (memq (get-text-property pos 'intangible)
+                     '(its-part-1 its-part-2))
+               (get-text-property pos 'egg-end)
+               (get-text-property pos 'egg-lang)
+               (get-text-property pos 'egg-start)))))
+
+(defun message-strip-forbidden-properties (begin end &optional old-length)
+  "Strip forbidden properties between BEGIN and END, ignoring the third arg.
+This function is intended to be called from `after-change-functions'.
+See also `message-forbidden-properties'."
+  (when (and message-strip-special-text-properties
+            (message-tamago-not-in-use-p begin))
+    (remove-text-properties begin end message-forbidden-properties)))
+
 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"
   "Major mode for editing mail and news to be sent.
@@ -1570,6 +1700,8 @@ C-c C-f  move to a header field (and create it if there isn't):
         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-f  move to Followup-To
+        C-c C-f C-m  move to Mail-Followup-To
+        C-c C-f C-i  cycle through Importance values
 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).
@@ -1582,6 +1714,8 @@ C-c C-v  `message-delete-not-region' (remove the text outside the region).
 C-c C-z  `message-kill-to-signature' (kill the text up to the signature).
 C-c C-r  `message-caesar-buffer-body' (rot13 the message body).
 C-c C-a  `mml-attach-file' (attach a file as MIME).
+C-c C-u  `message-insert-or-toggle-importance'  (insert or cycle importance).
+C-c M-n  `message-insert-disposition-notification-to'  (request receipt).
 M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (set (make-local-variable 'message-reply-buffer) nil)
   (make-local-variable 'message-send-actions)
@@ -1616,6 +1750,12 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
        (set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
+  ;; make-local-hook is harmless though obsolete in Emacs 21.
+  ;; Emacs 20 and XEmacs need make-local-hook. 
+  (make-local-hook 'after-change-functions)
+  ;; Mmmm... Forbidden properties...
+  (add-hook 'after-change-functions 'message-strip-forbidden-properties 
+           nil 'local)
   ;; Allow mail alias things.
   (when (eq message-mail-alias-type 'abbrev)
     (if (fboundp 'mail-abbrevs-setup)
@@ -1681,6 +1821,11 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (interactive)
   (message-position-on-field "To"))
 
+(defun message-goto-from ()
+  "Move point to the From header."
+  (interactive)
+  (message-position-on-field "From"))
+
 (defun message-goto-subject ()
   "Move point to the Subject header."
   (interactive)
@@ -1721,6 +1866,11 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (interactive)
   (message-position-on-field "Followup-To" "Newsgroups"))
 
+(defun message-goto-mail-followup-to ()
+  "Move point to the Mail-Followup-To header."
+  (interactive)
+  (message-position-on-field "Mail-Followup-To" "From"))
+
 (defun message-goto-keywords ()
   "Move point to the Keywords header."
   (interactive)
@@ -1914,10 +2064,14 @@ Prefix arg means justify as well."
       (if not-break
          (setq point nil)
        (if bolp
-           (insert "\n")
-         (insert "\n\n"))
+           (newline)
+         (newline)
+         (newline))
        (setq point (point))
-       (insert "\n\n")
+       ;; (newline 2) doesn't mark both newline's as hard, so call
+       ;; newline twice. -jas
+       (newline)
+       (newline)
        (delete-region (point) (re-search-forward "[ \t]*"))
        (when (and quoted (not bolp))
          (insert quoted leading-space)))
@@ -1938,9 +2092,19 @@ Prefix arg means justify as well."
     (message-newline-and-reformat arg t)
     t))
 
+;; Is it better to use `mail-header-end'?
+(defun message-point-in-header-p ()
+  "Return t if point is in the header."
+  (save-excursion
+    (let ((p (point)))
+      (goto-char (point-min))
+      (not (re-search-forward
+           (concat "^" (regexp-quote mail-header-separator) "\n")
+           p t)))))
+
 (defun message-do-auto-fill ()
   "Like `do-auto-fill', but don't fill in message header."
-  (when (> (point) (save-excursion (rfc822-goto-eoh)))
+  (unless (message-point-in-header-p)
     (do-auto-fill)))
 
 (defun message-insert-signature (&optional force)
@@ -1980,6 +2144,52 @@ Prefix arg means justify as well."
       (goto-char (point-max))
       (or (bolp) (insert "\n")))))
 
+(defun message-insert-importance-high ()
+  "Insert header to mark message as important."
+  (interactive)
+  (save-excursion
+    (message-remove-header "Importance")
+    (message-goto-eoh)
+    (insert "Importance: high\n")))
+
+(defun message-insert-importance-low ()
+  "Insert header to mark message as unimportant."
+  (interactive)
+  (save-excursion
+    (message-remove-header "Importance")
+    (message-goto-eoh)
+    (insert "Importance: low\n")))
+
+(defun message-insert-or-toggle-importance ()
+  "Insert a \"Importance: high\" header, or cycle through the header values.
+The three allowed values according to RFC 1327 are `high', `normal'
+and `low'."
+  (interactive)
+  (save-excursion
+    (let ((valid '("high" "normal" "low"))
+         (new "high")
+         cur)
+      (when (setq cur (message-fetch-field "Importance"))
+       (message-remove-header "Importance")
+       (setq new (cond ((string= cur "high")
+                        "low")
+                       ((string= cur "low")
+                        "normal")
+                       (t
+                        "high"))))
+      (message-goto-eoh)
+      (insert (format "Importance: %s\n" new)))))
+
+(defun message-insert-disposition-notification-to ()
+  "Request a disposition notification (return receipt) to this message.
+Note that this should not be used in newsgroups."
+  (interactive)
+  (save-excursion
+    (message-remove-header "Disposition-Notification-To")
+    (message-goto-eoh)
+    (insert (format "Disposition-Notification-To: %s\n"
+                   (or (message-fetch-field "From") (message-make-from))))))
+
 (defun message-elide-region (b e)
   "Elide the text in the region.
 An ellipsis (from `message-elide-ellipsis') will be inserted where the
@@ -2122,8 +2332,8 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
        (indent-rigidly start (mark t) message-indentation-spaces)
       (save-excursion
        (goto-char start)
-         (while (< (point) (mark t))
-         (if (looking-at ">")
+       (while (< (point) (mark t))
+         (if (or (looking-at ">") (looking-at "^$"))
              (insert message-yank-cited-prefix)
            (insert message-yank-prefix))
          (forward-line 1))))
@@ -2301,7 +2511,8 @@ The text will also be indented the normal way."
       t)))
 
 (defun message-dont-send ()
-  "Don't send the message you have been editing."
+  "Don't send the message you have been editing.
+Instead, just auto-save the buffer and then bury it."
   (interactive)
   (set-buffer-modified-p t)
   (save-buffer)
@@ -2314,9 +2525,23 @@ The text will also be indented the normal way."
   (interactive)
   (when (or (not (buffer-modified-p))
            (yes-or-no-p "Message modified; kill anyway? "))
-    (let ((actions message-kill-actions))
+    (let ((actions message-kill-actions)
+         (draft-article message-draft-article)
+         (auto-save-file-name buffer-auto-save-file-name)
+         (file-name buffer-file-name)
+         (modified (buffer-modified-p)))
       (setq buffer-file-name nil)
       (kill-buffer (current-buffer))
+      (when (and (or (and auto-save-file-name
+                         (file-exists-p auto-save-file-name))
+                    (and file-name
+                         (file-exists-p file-name)))
+              (yes-or-no-p (format "Remove the backup file%s? "
+                                   (if modified " too" ""))))
+       (ignore-errors
+         (delete-file auto-save-file-name))
+       (let ((message-draft-article draft-article))
+         (message-disassociate-draft)))
       (message-do-actions actions))))
 
 (defun message-bury (buffer)
@@ -2347,7 +2572,7 @@ It should typically alter the sending method in some way or other."
   (message message-sending-message)
   (let ((alist message-send-method-alist)
        (success t)
-       elem sent
+       elem sent dont-barf-on-no-method
        (message-options message-options))
     (message-options-set-recipient)
     (while (and success
@@ -2364,9 +2589,22 @@ It should typically alter the sending method in some way or other."
                         (error "Denied posting -- multiple copies")))
                   (setq success (funcall (caddr elem) arg)))
          (setq sent t))))
-    (unless (or sent (not success))
+    (unless (or sent
+               (not success)
+               (let ((fcc (message-fetch-field "Fcc"))
+                     (gcc (message-fetch-field "Gcc")))
+                 (when (or fcc gcc)
+                   (or (eq message-allow-no-recipients 'always)
+                       (and (not (eq message-allow-no-recipients 'never))
+                            (setq dont-barf-on-no-method
+                                  (gnus-y-or-n-p
+                                   (format "No receiver, perform %s anyway? "
+                                           (cond ((and fcc gcc) "Fcc and Gcc")
+                                                 (fcc "Fcc")
+                                                 (t "Gcc"))))))))))
       (error "No methods specified to send by"))
-    (when (and success sent)
+    (when (or dont-barf-on-no-method
+             (and success sent))
       (message-do-fcc)
       (save-excursion
        (run-hooks 'message-sent-hook))
@@ -2398,6 +2636,17 @@ It should typically alter the sending method in some way or other."
 (put 'message-check 'lisp-indent-function 1)
 (put 'message-check 'edebug-form-spec '(form body))
 
+(defun message-text-with-property (prop)
+  "Return a list of all points where the text has PROP."
+  (let ((points nil)
+       (point (point-min)))
+    (save-excursion
+      (while (< point (point-max))
+       (when (get-text-property point prop)
+         (push point points))
+       (incf point)))
+    (nreverse points)))
+
 (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.
@@ -2406,11 +2655,15 @@ It should typically alter the sending method in some way or other."
     (insert "\n"))
   ;; Delete all invisible text.
   (message-check 'invisible-text
-    (when (text-property-any (point-min) (point-max) 'invisible t)
-      (put-text-property (point-min) (point-max) 'invisible nil)
-      (unless (yes-or-no-p
-              "Invisible text found and made visible; continue posting? ")
-       (error "Invisible text found and made visible")))))
+    (let ((points (message-text-with-property 'invisible)))
+      (when points
+       (goto-char (car points))
+       (dolist (point points)
+         (add-text-properties point (1+ point)
+                              '(invisible nil highlight t)))
+       (unless (yes-or-no-p
+                "Invisible text found and made visible; continue posting? ")
+         (error "Invisible text found and made visible"))))))
 
 (defun message-add-action (action &rest types)
   "Add ACTION to be performed when doing an exit of type TYPES."
@@ -2514,22 +2767,37 @@ It should typically alter the sending method in some way or other."
         (message-posting-charset
          (if (fboundp 'gnus-setup-posting-charset)
              (gnus-setup-posting-charset nil)
-           message-posting-charset)))
+           message-posting-charset))
+        (headers message-required-mail-headers))
     (save-restriction
       (message-narrow-to-headers)
+      ;; Generate the Mail-Followup-To header if the header is not there...
+      (if (and (or message-subscribed-regexps
+                  message-subscribed-addresses
+                  message-subscribed-address-file
+                  message-subscribed-address-functions)
+              (not (mail-fetch-field "mail-followup-to")))
+         (setq headers
+               (cons
+                (cons "Mail-Followup-To" (message-make-mft))
+                message-required-mail-headers))
+       ;; otherwise, delete the MFT header if the field is empty
+       (when (equal "" (mail-fetch-field "mail-followup-to"))
+         (message-remove-header "^Mail-Followup-To:")))
       ;; Insert some headers.
       (let ((message-deletable-headers
             (if news nil message-deletable-headers)))
-       (message-generate-headers message-required-mail-headers))
+       (message-generate-headers headers))
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))
     (unwind-protect
        (save-excursion
          (set-buffer tembuf)
          (erase-buffer)
-         ;; Avoid copying text props.
+         ;; Avoid copying text props (except hard newlines).
          (insert (with-current-buffer mailbuf
-                   (buffer-substring-no-properties (point-min) (point-max))))
+                   (mml-buffer-substring-no-properties-except-hard-newlines
+                    (point-min) (point-max))))
          ;; Remove some headers.
          (message-encode-message-body)
          (save-restriction
@@ -2696,6 +2964,27 @@ to find out how to use this."
     ;; Pass it on to mh.
     (mh-send-letter)))
 
+(defun message-canlock-generate ()
+  "Return a string that is non-trival to guess.
+Do not use this for anything important, it is cryptographically weak."
+  (sha1 (concat (message-unique-id)
+               (format "%x%x%x" (random) (random t) (random))
+               (prin1-to-string (recent-keys))
+               (prin1-to-string (garbage-collect)))))
+
+(defun message-canlock-password ()
+  "The password used by message for cancel locks.
+This is the value of `canlock-password', if that option is non-nil.
+Otherwise, generate and save a value for `canlock-password' first."
+  (unless canlock-password
+    (customize-save-variable 'canlock-password (message-canlock-generate)))
+  canlock-password)
+
+(defun message-insert-canlock ()
+  (when message-insert-canlock
+    (message-canlock-password)
+    (canlock-insert-header)))
+
 (defun message-send-news (&optional arg)
   (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
         (case-fold-search nil)
@@ -2739,6 +3028,7 @@ to find out how to use this."
        (message-narrow-to-headers)
        ;; Insert some headers.
        (message-generate-headers message-required-news-headers)
+       (message-insert-canlock)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))
       ;; Note: This check will be disabled by the ".*" default value for
@@ -2757,10 +3047,11 @@ to find out how to use this."
              (set-buffer tembuf)
              (buffer-disable-undo)
              (erase-buffer)
-             ;; Avoid copying text props.
-             (insert (with-current-buffer messbuf
-                       (buffer-substring-no-properties
-                        (point-min) (point-max))))
+             ;; Avoid copying text props (except hard newlines).
+             (insert
+              (with-current-buffer messbuf
+                (mml-buffer-substring-no-properties-except-hard-newlines
+                 (point-min) (point-max))))
              (message-encode-message-body)
              ;; Remove some headers.
              (save-restriction
@@ -2884,7 +3175,7 @@ to find out how to use this."
                   (zerop
                    (length
                     (setq to (completing-read
-                              "Followups to: (default all groups) "
+                              "Followups to (default: no Followup-To header) "
                               (mapcar (lambda (g) (list g))
                                       (cons "poster"
                                             (message-tokenize-header
@@ -3180,7 +3471,8 @@ to find out how to use this."
   "Process Fcc headers in the current buffer."
   (let ((case-fold-search t)
        (buf (current-buffer))
-       list file)
+       list file
+       (mml-externalize-attachments message-fcc-externalize-attachments))
     (save-excursion
       (save-restriction
        (message-narrow-to-headers)
@@ -3329,7 +3621,7 @@ If NOW, use that time instead."
             (aset user (match-beginning 0) ?_))
           user)
        (message-number-base36 (user-uid) -1))
-     (message-number-base36 (+ (car   tm)
+     (message-number-base36 (+ (car tm)
                               (lsh (% message-unique-id-char 25) 16)) 4)
      (message-number-base36 (+ (nth 1 tm)
                               (lsh (/ message-unique-id-char 25) 16)) 4)
@@ -3447,16 +3739,6 @@ If NOW, use that time instead."
                         (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 " (")
@@ -3518,7 +3800,7 @@ give as trustworthy answer as possible."
       (match-string 1 user-mail))
      ;; Default to this bogus thing.
      (t
-      (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me")))))
+      (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me")))))
 
 (defun message-make-host-name ()
   "Return the name of the host."
@@ -3531,6 +3813,45 @@ give as trustworthy answer as possible."
   (or mail-host-address
       (message-make-fqdn)))
 
+(defun message-make-mft ()
+  "Return the Mail-Followup-To header."
+  (let* ((msg-recipients (message-options-get 'message-recipients))
+        (recipients
+         (mapcar 'mail-strip-quoted-names
+                 (message-tokenize-header msg-recipients)))
+        (file-regexps
+         (if message-subscribed-address-file
+             (let (begin end item re)
+               (save-excursion
+                 (with-temp-buffer
+                   (insert-file-contents message-subscribed-address-file)
+                   (while (not (eobp))
+                     (setq begin (point))
+                     (forward-line 1)
+                     (setq end (point))
+                     (if (bolp) (setq end (1- end)))
+                     (setq item (regexp-quote (buffer-substring begin end)))
+                     (if re (setq re (concat re "\\|" item))
+                       (setq re (concat "\\`\\(" item))))
+                   (and re (list (concat re "\\)\\'"))))))))
+        (mft-regexps (apply 'append message-subscribed-regexps
+                            (mapcar 'regexp-quote
+                                    message-subscribed-addresses)
+                            file-regexps
+                            (mapcar 'funcall
+                                    message-subscribed-address-functions))))
+    (save-match-data
+      (when (eval (apply 'append '(or)
+                        (mapcar
+                         (function (lambda (regexp)
+                                     (mapcar
+                                      (function (lambda (recipient)
+                                                  `(string-match ,regexp
+                                                                 ,recipient)))
+                                      recipients)))
+                         mft-regexps)))
+       msg-recipients))))
+
 (defun message-generate-headers (headers)
   "Prepare article HEADERS.
 Headers already prepared in the buffer are not modified."
@@ -3624,7 +3945,11 @@ Headers already prepared in the buffer are not modified."
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))
                    (insert (if (stringp header) header (symbol-name header))
-                           ": " value "\n")
+                           ": " value)
+                   ;; We check whether the value was ended by a
+                   ;; newline.  If now, we insert one.
+                   (unless (bolp)
+                     (insert "\n"))
                    (forward-line -1))
                ;; The value of this header was empty, so we clear
                ;; totally and insert the new value.
@@ -3811,6 +4136,19 @@ than 988 characters long, and if they are not, trim them until they are."
       (forward-line 2)))
    (sit-for 0)))
 
+(defun message-beginning-of-line (&optional n)
+  "Move point to beginning of header value or to beginning of line."
+  (interactive "p")
+  (if (message-point-in-header-p)
+      (let* ((here (point))
+            (bol (progn (beginning-of-line n) (point)))
+            (eol (gnus-point-at-eol))
+            (eoh (re-search-forward ": *" eol t)))
+       (if (or (not eoh) (equal here eoh))
+           (goto-char bol)
+         (goto-char eoh)))
+    (beginning-of-line n)))
+
 (defun message-buffer-name (type &optional to group)
   "Return a new (unique) buffer name based on TYPE and TO."
   (cond
@@ -3882,7 +4220,7 @@ than 988 characters long, and if they are not, trim them until they are."
            to group)
        (if (not (or (null name)
                     (string-equal name "mail")
-                    (string-equal name "news")))
+                    (string-equal name "posting")))
            (setq name (concat "*sent " name "*"))
          (message-narrow-to-headers)
          (setq to (message-fetch-field "to"))
@@ -3894,7 +4232,7 @@ than 988 characters long, and if they are not, trim them until they are."
                             (or (car (mail-extract-address-components to))
                                 to) "*"))
                 ((and group (not (string= group "")))
-                 (concat "*sent news on " group "*"))
+                 (concat "*sent posting on " group "*"))
                 (t "*sent mail*"))))
        (unless (string-equal name (buffer-name))
          (rename-buffer name t)))))
@@ -3937,15 +4275,11 @@ than 988 characters long, and if they are not, trim them until they are."
                              headers)
                      nil switch-function yank-action actions)))))
 
-;;;(defvar mc-modes-alist)
 (defun message-setup-1 (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))
+  (dolist (action actions)
+    (condition-case nil
+       (add-to-list 'message-send-actions
+                    `(apply ',(car action) ',(cdr action)))))
   (setq message-reply-buffer replybuffer)
   (goto-char (point-min))
   ;; Insert all the headers.
@@ -4077,19 +4411,20 @@ OTHER-HEADERS is an alist of header/value pairs."
   "Start editing a news article to be sent."
   (interactive)
   (let ((message-this-is-news t))
-    (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
+    (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))
 
 (defun message-get-reply-headers (wide &optional to-address)
-  (let (follow-to mct never-mct from to cc reply-to mrt mft ccalist)
+  (let (follow-to mct never-mct to cc author mft recipients)
     ;; Find all relevant headers we need.
-    (setq from (message-fetch-field "from")
-         to (message-fetch-field "to")
+    (setq to (message-fetch-field "to")
          cc (message-fetch-field "cc")
          mct (message-fetch-field "mail-copies-to")
-         reply-to (message-fetch-field "reply-to")
-         mrt (message-fetch-field "mail-reply-to")
+         author (or (message-fetch-field "mail-reply-to")
+                    (message-fetch-field "reply-to")
+                    (message-fetch-field "from")
+                    "")
          mft (and message-use-mail-followup-to
                   (message-fetch-field "mail-followup-to")))
 
@@ -4101,24 +4436,17 @@ OTHER-HEADERS is an alist of header/value pairs."
             (setq mct nil))
            ((or (equal (downcase mct) "always")
                 (equal (downcase mct) "poster"))
-            (setq mct (or mrt reply-to from)))))
+            (setq mct author))))
 
-    (if (and (not mft)
-            (or (not wide)
-                to-address))
-       (progn
-         (setq follow-to (list (cons 'To (or to-address mrt reply-to from))))
-         (when (and (and wide mct)
-                    (not (member (cons 'To mct) follow-to)))
-           (push (cons 'Cc mct) follow-to)))
-      (let (ccalist)
-       (save-excursion
-         (message-set-work-buffer)
-         (if (and mft
-                  wide
-                  (or (not (eq message-use-mail-followup-to 'ask))
-                      (message-y-or-n-p
-                       (concat "Obey Mail-Followup-To? ") t "\
+    (save-match-data
+      ;; Build (textual) list of new recipient addresses.
+      (cond
+       ((not wide)
+       (setq recipients (concat ", " author)))
+       ((and mft
+            (string-match "[^ \t,]" mft)
+            (or (not (eq message-use-mail-followup-to 'ask))
+                (message-y-or-n-p "Obey Mail-Followup-To? " t "\
 You should normally obey the Mail-Followup-To: header.  In this
 article, it has the value of
 
@@ -4139,46 +4467,51 @@ fragmented and very difficult to follow.
 
 Also, some source/announcement lists are not intended for discussion;
 responses here are directed to other addresses.")))
-             (insert mft)
-           (unless never-mct
-             (insert (or mrt reply-to from "")))
-           (insert (if to (concat (if (bolp) "" ", ") to "") ""))
-           (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
-           (insert (if cc (concat (if (bolp) "" ", ") cc) "")))
-         (goto-char (point-min))
-         (while (re-search-forward "[ \t]+" nil t)
-           (replace-match " " t t))
-         ;; Remove addresses that match `rmail-dont-reply-to-names'.
-         (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
-           (insert (prog1 (rmail-dont-reply-to (buffer-string))
-                     (erase-buffer))))
-         (goto-char (point-min))
-         ;; Perhaps "Mail-Copies-To: never" removed the only address?
-         (when (eobp)
-           (insert (or mrt reply-to from "")))
-         (setq ccalist
-               (mapcar
-                (lambda (addr)
-                  (cons (mail-strip-quoted-names addr) addr))
-                (message-tokenize-header (buffer-string))))
-         (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
-         (let ((ccs (cons 'Cc (mapconcat
-                               (lambda (addr) (cdr addr)) ccalist ", "))))
-           (when (string-match "^ +" (cdr ccs))
-             (setcdr ccs (substring (cdr ccs) (match-end 0))))
-           (push ccs follow-to)))
-       ;; Allow the user to be asked whether or not to reply to all
-       ;; recipients in a wide reply.
-       (if (and ccalist wide message-wide-reply-confirm-recipients
-                (not (y-or-n-p "Reply to all recipients? ")))
-           (setq follow-to (delq (assoc 'Cc follow-to) follow-to)))))
+       (setq recipients (concat ", " mft)))
+       (to-address
+       (setq recipients (concat ", " to-address))
+       ;; If the author explicitly asked for a copy, we don't deny it to them.
+       (if mct (setq recipients (concat recipients ", " mct))))
+       (t
+       (setq recipients (if never-mct "" (concat ", " author)))
+       (if to  (setq recipients (concat recipients ", " to)))
+       (if cc  (setq recipients (concat recipients ", " cc)))
+       (if mct (setq recipients (concat recipients ", " mct)))))
+      (if (>= (length recipients) 2)
+         ;; Strip the leading ", ".
+         (setq recipients (substring recipients 2)))
+      ;; Squeeze whitespace.
+      (while (string-match "[ \t][ \t]+" recipients)
+       (setq recipients (replace-match " " t t recipients)))
+      ;; Remove addresses that match `rmail-dont-reply-to-names'.
+      (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+       (setq recipients (rmail-dont-reply-to recipients)))
+      ;; Perhaps "Mail-Copies-To: never" removed the only address?
+      (if (string-equal recipients "")
+         (setq recipients author))
+      ;; Convert string to a list of (("foo@bar" . "Name <foo@bar>") ...).
+      (setq recipients
+           (mapcar
+            (lambda (addr)
+              (cons (mail-strip-quoted-names addr) addr))
+            (message-tokenize-header recipients)))
+      ;; Remove first duplicates.  (Why not all duplicates?  Is this a bug?)
+      (let ((s recipients))
+       (while s
+         (setq recipients (delq (assoc (car (pop s)) s) recipients))))
+      ;; Build the header alist.  Allow the user to be asked whether
+      ;; or not to reply to all recipients in a wide reply.
+      (setq follow-to (list (cons 'To (cdr (pop recipients)))))
+      (when (and recipients
+                (or (not message-wide-reply-confirm-recipients)
+                    (y-or-n-p "Reply to all recipients? ")))
+       (setq recipients (mapconcat
+                         (lambda (addr) (cdr addr)) recipients ", "))
+       (if (string-match "^ +" recipients)
+           (setq recipients (substring recipients (match-end 0))))
+       (push (cons 'Cc recipients) follow-to)))
     follow-to))
 
-
 ;;;###autoload
 (defun message-reply (&optional to-address wide)
   "Start editing a reply to the article in the current buffer."
@@ -4374,15 +4707,31 @@ If ARG, allow editing of the cancellation message."
              message-id (message-fetch-field "message-id" t)
              distribution (message-fetch-field "distribution")))
       ;; Make sure that this article was written by the user.
-      (unless (or (message-gnksa-enable-p 'cancel-messages)
-                 (and sender
-                      (string-equal
-                       (downcase sender)
-                       (downcase (message-make-sender))))
-                 (string-equal
-                  (downcase (cadr (mail-extract-address-components from)))
-                  (downcase (cadr (mail-extract-address-components
-                                   (message-make-from))))))
+      (unless (or
+              ;; Canlock-logic as suggested by Per Abrahamsen
+              ;; <abraham@dina.kvl.dk>
+              ;;
+              ;; IF article has cancel-lock THEN
+              ;;   IF we can verify it THEN
+              ;;     issue cancel
+              ;;   ELSE
+              ;;     error: cancellock: article is not yours
+              ;; ELSE
+              ;;   Use old rules, comparing sender...
+              (if (message-fetch-field "Cancel-Lock")
+                  (if (null (canlock-verify))
+                      t
+                    (error "Failed to verify Cancel-lock: This article is not yours"))
+                nil)
+              (message-gnksa-enable-p 'cancel-messages)
+              (and sender
+                   (string-equal
+                    (downcase sender)
+                    (downcase (message-make-sender))))
+              (string-equal
+               (downcase (cadr (mail-extract-address-components from)))
+               (downcase (cadr (mail-extract-address-components
+                                (message-make-from))))))
        (error "This article is not yours"))
       (when (yes-or-no-p "Do you really want to cancel this article? ")
        ;; Make control message.
@@ -4418,7 +4767,23 @@ header line with the old Message-ID."
        (sender (message-fetch-field "sender"))
        (from (message-fetch-field "from")))
     ;; Check whether the user owns the article that is to be superseded.
-    (unless (or (message-gnksa-enable-p 'cancel-messages)
+    (unless (or
+            ;; Canlock-logic as suggested by Per Abrahamsen
+            ;; <abraham@dina.kvl.dk>
+            ;;
+            ;; IF article has cancel-lock THEN
+            ;;   IF we can verify it THEN
+            ;;     issue cancel
+            ;;   ELSE
+            ;;     error: cancellock: article is not yours
+            ;; ELSE
+            ;;   Use old rules, comparing sender...
+            (if (message-fetch-field "Cancel-Lock")
+                (if (null (canlock-verify))
+                    t
+                  (error "Failed to verify Cancel-lock: This article is not yours"))
+              nil)
+            (message-gnksa-enable-p 'cancel-messages)
                (and sender
                     (string-equal
                      (downcase sender)
@@ -4471,7 +4836,7 @@ header line with the old Message-ID."
   "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT.
 Previous forwarders, replyers, etc. may add it."
   (with-temp-buffer
-    (insert-string subject)
+    (insert subject)
     (goto-char (point-min))
     ;; strip Re/Fwd stuff off the beginning
     (while (re-search-forward
@@ -4510,8 +4875,8 @@ Source is the sender, and if the original message was news, Source is
 the list of newsgroups is was posted to."
   (concat "["
          (let ((prefix
-                (or (message-fetch-field
-                     (if (message-news-p) "newsgroups" "from"))
+                (or (message-fetch-field "newsgroups")
+                    (message-fetch-field "from")
                     "(nowhere)")))
            (if message-forward-decoded-p
                prefix
@@ -4554,6 +4919,7 @@ the message."
 (eval-when-compile
   (defvar gnus-article-decoded-p))
 
+
 ;;;###autoload
 (defun message-forward (&optional news digest)
   "Forward the current message via mail.
@@ -4565,35 +4931,38 @@ Optional DIGEST will use digest to forward."
          (if (local-variable-p 'gnus-article-decoded-p (current-buffer))
              gnus-article-decoded-p ;; In an article buffer.
            message-forward-decoded-p))
-        (subject (message-make-forward-subject))
-        art-beg)
+        (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-forward-before-signature
-       (message-goto-body)
-      (goto-char (point-max)))
-    (if message-forward-as-mime
-       (if digest
-           (insert "\n<#multipart type=digest>\n")
-         (if message-forward-show-mml
-             (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
-           (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
-      (insert "\n-------------------- Start of forwarded message --------------------\n"))
-    (let ((b (point)) e)
+    (message-forward-make-body cur digest)))
+
+;;;###autoload
+(defun message-forward-make-body (forward-buffer &optional digest)
+  ;; Put point where we want it before inserting the forwarded
+  ;; message.
+  (if message-forward-before-signature
+      (message-goto-body)
+    (goto-char (point-max)))
+  (if message-forward-as-mime
       (if digest
-         (if message-forward-as-mime
-             (insert-buffer-substring cur)
-           (mml-insert-buffer cur))
-       (if (and message-forward-show-mml
-                (not message-forward-decoded-p))
-           (insert
-            (with-temp-buffer
-              (mm-disable-multibyte-mule4) ;; Must copy buffer in unibyte mode
+         (insert "\n<#multipart type=digest>\n")
+       (if message-forward-show-mml
+           (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+         (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
+    (insert "\n-------------------- Start of forwarded message --------------------\n"))
+  (let ((b (point)) e)
+    (if digest
+       (if message-forward-as-mime
+           (insert-buffer-substring forward-buffer)
+         (mml-insert-buffer forward-buffer))
+      (if (and message-forward-show-mml
+              (not message-forward-decoded-p))
+         (insert
+          (with-temp-buffer
+            (mm-disable-multibyte-mule4) ;; Must copy buffer in unibyte mode
               (insert
-               (with-current-buffer cur
+               (with-current-buffer forward-buffer
                  (mm-string-as-unibyte (buffer-string))))
               (mm-enable-multibyte-mule4)
               (mime-to-mml)
@@ -4601,37 +4970,53 @@ Optional DIGEST will use digest to forward."
               (when (looking-at "From ")
                 (replace-match "X-From-Line: "))
               (buffer-string)))
-         (save-restriction
-           (narrow-to-region (point) (point))
-           (mml-insert-buffer cur)
-           (goto-char (point-min))
-           (when (looking-at "From ")
-             (replace-match "X-From-Line: "))
-           (goto-char (point-max)))))
-      (setq e (point))
-      (if message-forward-as-mime
-         (if digest
-             (insert "<#/multipart>\n")
-           (if message-forward-show-mml
-               (insert "<#/mml>\n")
-             (insert "<#/part>\n")))
-       (insert "\n-------------------- End of forwarded message --------------------\n"))
-      (if (and digest message-forward-as-mime)
-         (save-restriction
-           (narrow-to-region b e)
-           (goto-char b)
-           (narrow-to-region (point)
-                             (or (search-forward "\n\n" nil t) (point)))
-           (delete-region (point-min) (point-max)))
-       (when (and (not current-prefix-arg)
-                  message-forward-ignored-headers)
-         (save-restriction
-           (narrow-to-region b e)
-           (goto-char b)
-           (narrow-to-region (point)
-                             (or (search-forward "\n\n" nil t) (point)))
-           (message-remove-header message-forward-ignored-headers t)))))
-    (message-position-point)))
+       (save-restriction
+         (narrow-to-region (point) (point))
+         (mml-insert-buffer forward-buffer)
+         (goto-char (point-min))
+         (when (looking-at "From ")
+           (replace-match "X-From-Line: "))
+         (goto-char (point-max)))))
+    (setq e (point))
+    (if message-forward-as-mime
+       (if digest
+           (insert "<#/multipart>\n")
+         (if message-forward-show-mml
+             (insert "<#/mml>\n")
+           (insert "<#/part>\n")))
+      (insert "\n-------------------- End of forwarded message --------------------\n"))
+    (if (and digest message-forward-as-mime)
+       (save-restriction
+         (narrow-to-region b e)
+         (goto-char b)
+         (narrow-to-region (point)
+                           (or (search-forward "\n\n" nil t) (point)))
+         (delete-region (point-min) (point-max)))
+      (when (and (not current-prefix-arg)
+                message-forward-ignored-headers)
+       (save-restriction
+         (narrow-to-region b e)
+         (goto-char b)
+         (narrow-to-region (point)
+                           (or (search-forward "\n\n" nil t) (point)))
+         (message-remove-header message-forward-ignored-headers t)))))
+  (message-position-point))
+
+;;;###autoload
+(defun message-forward-rmail-make-body (forward-buffer)
+  (save-window-excursion
+    (set-buffer forward-buffer)
+    (let (rmail-enable-mime)
+      (rmail-toggle-header 0)))
+  (message-forward-make-body forward-buffer))
+
+;;;###autoload
+(defun message-insinuate-rmail ()
+  "Let RMAIL uses message to forward."
+  (interactive)
+  (setq rmail-enable-mime-composing t)
+  (setq rmail-insert-mime-forwarded-message-function 
+       'message-forward-rmail-make-body))
 
 ;;;###autoload
 (defun message-resend (address)
@@ -4766,7 +5151,7 @@ you."
        (special-display-regexps nil)
        (same-window-buffer-names nil)
        (same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+    (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
   (let ((message-this-is-news t))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))
@@ -4780,7 +5165,7 @@ you."
        (special-display-regexps nil)
        (same-window-buffer-names nil)
        (same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+    (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
   (let ((message-this-is-news t))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))
@@ -4845,35 +5230,55 @@ which specify the range to operate on."
                   (tool-bar-add-item-from-menu
                    'message-dont-send "cancel" message-mode-map)
                   (tool-bar-add-item-from-menu
-                   'mml-attach-file "attach" message-mode-map)
+                   'mml-attach-file "attach" mml-mode-map)
                   (tool-bar-add-item-from-menu
                    'ispell-message "spell" message-mode-map)
+                  (tool-bar-add-item-from-menu
+                   'message-insert-importance-high "important"
+                   message-mode-map)
+                  (tool-bar-add-item-from-menu
+                   'message-insert-importance-low "unimportant"
+                   message-mode-map)
+                  (tool-bar-add-item-from-menu
+                   'message-insert-disposition-notification-to "receipt"
+                   message-mode-map)
                   tool-bar-map)))))
 
 ;;; Group name completion.
 
-(defvar message-newgroups-header-regexp
+(defcustom message-newgroups-header-regexp
   "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
-  "Regexp that match headers that lists groups.")
+  "Regexp that match headers that lists groups."
+  :group 'message
+  :type 'regexp)
 
-(defvar message-completion-alist
+(defcustom message-completion-alist
   (list (cons message-newgroups-header-regexp 'message-expand-group)
        '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name))
-  "Alist of (RE . FUN).  Use FUN for completion on header lines matching RE.")
+  "Alist of (RE . FUN).  Use FUN for completion on header lines matching RE."
+  :group 'message
+  :type '(alist :key-type regexp :value-type function))
 
-(defvar message-tab-body-function 'indent-relative
-  "*Function to execute when `message-tab' (TAB) is executed in the body.")
+(defcustom message-tab-body-function nil
+  "*Function to execute when `message-tab' (TAB) is executed in the body.
+If nil, the function bound in `text-mode-map' or `global-map' is executed."
+  :group 'message
+  :type 'function)
 
 (defun message-tab ()
   "Complete names according to `message-completion-alist'.
-Do an `indent-relative' if not in those headers."
+Execute function specified by `message-tab-body-function' when not in
+those headers."
   (interactive)
   (let ((alist message-completion-alist))
     (while (and alist
                (let ((mail-abbrev-mode-regexp (caar alist)))
                  (not (mail-abbrev-in-expansion-header-p))))
       (setq alist (cdr alist)))
-    (funcall (or (cdar alist) message-tab-body-function))))
+    (funcall (or (cdar alist) message-tab-body-function
+                (lookup-key text-mode-map "\t")
+                (lookup-key global-map "\t")
+                'indent-relative))))
 
 (defun message-expand-group ()
   "Expand the group name under point."
@@ -5023,27 +5428,28 @@ regexp varstr."
        (message-narrow-to-headers-or-head)
        (message-remove-first-header "Content-Type")
        (message-remove-first-header "Content-Transfer-Encoding"))
-      ;; We always make sure that the message has a Content-Type header.
-      ;; This is because some broken MTAs and MUAs get awfully confused
-      ;; when confronted with a message with a MIME-Version header and
-      ;; without a Content-Type header.  For instance, Solaris'
-      ;; /usr/bin/mail.
+      ;; We always make sure that the message has a Content-Type
+      ;; header.  This is because some broken MTAs and MUAs get
+      ;; awfully confused when confronted with a message with a
+      ;; MIME-Version header and without a Content-Type header.  For
+      ;; instance, Solaris' /usr/bin/mail.
       (unless content-type-p
        (goto-char (point-min))
-       (re-search-forward "^MIME-Version:")
-       (forward-line 1)
-       (insert "Content-Type: text/plain; charset=us-ascii\n")))))
+       ;; For unknown reason, MIME-Version doesn't exist.
+       (when (re-search-forward "^MIME-Version:" nil t)
+         (forward-line 1)
+         (insert "Content-Type: text/plain; charset=us-ascii\n"))))))
 
-(defun message-read-from-minibuffer (prompt)
+(defun message-read-from-minibuffer (prompt &optional initial-contents)
   "Read from the minibuffer while providing abbrev expansion."
   (if (fboundp 'mail-abbrevs-setup)
       (let ((mail-abbrev-mode-regexp "")
            (minibuffer-setup-hook 'mail-abbrevs-setup)
            (minibuffer-local-map message-minibuffer-local-map))
-       (read-from-minibuffer prompt))
+       (read-from-minibuffer prompt initial-contents))
     (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
          (minibuffer-local-map message-minibuffer-local-map))
-      (read-string prompt))))
+      (read-string prompt initial-contents))))
 
 (defun message-use-alternative-email-as-from ()
   (require 'mail-utils)