(defun): Remove debug.
[gnus] / lisp / message.el
index d07d98a..f4562ce 100644 (file)
@@ -1,5 +1,5 @@
 ;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -174,7 +174,7 @@ Otherwise, most addresses look like `angles', but they look like
   :group 'message-headers
   :type 'boolean)
 
-(defcustom message-syntax-checks 
+(defcustom message-syntax-checks
   (if message-insert-canlock '((sender . disabled)) nil)
   ;; Guess this one shouldn't be easy to customize...
   "*Controls what syntax checks should not be performed on outgoing posts.
@@ -188,19 +188,20 @@ Checks include `subject-cmsg', `multiple-headers', `sendsys',
 `new-text', `quoting-style', `redirected-followup', `signature',
 `approved', `sender', `empty', `empty-headers', `message-id', `from',
 `subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups', `reply-to'."
+`buffer-file-name', `unchanged', `newsgroups', `reply-to',
+'continuation-headers', and `long-header-lines'."
   :group 'message-news
   :type '(repeat sexp))                        ; Fixme: improve this
 
-(defcustom message-required-headers '((optional . References))
-  "*Headers to be generated or promted for when sending a message.
+(defcustom message-required-headers '((optional . References) From)
+  "*Headers to be generated or prompted for when sending a message.
 Also see `message-required-news-headers' and
-1message-required-mail-headers'."
+`message-required-mail-headers'."
   :group 'message-news
   :group 'message-headers
   :type '(repeat sexp))
 
-(defcustom message-draft-headers '(References)
+(defcustom message-draft-headers '(References From)
   "*Headers to be generated when saving a draft message."
   :group 'message-news
   :group 'message-headers
@@ -328,7 +329,7 @@ Archives \(such as groups.googgle.com\) respect this header."
 ;;;###autoload
 (defcustom message-archive-note
   "X-No-Archive: Yes - save http://groups.google.com/"
-  "Note to insert why you wouldn't want this posting archived. 
+  "Note to insert why you wouldn't want this posting archived.
 If nil, don't insert any text in the body."
   :type 'string
   :group 'message-various)
@@ -343,9 +344,9 @@ If nil, don't insert any text in the body."
 
 ;;;###autoload
 (defcustom message-cross-post-default t
-  "When non-nil `message-cross-post-followup-to' will normally perform a
-crosspost.  If nil, `message-cross-post-followup-to' will only do a followup.
-Note that you can explicitly override this setting by calling
+  "When non-nil `message-cross-post-followup-to' will perform a crosspost.
+If nil, `message-cross-post-followup-to' will only do a followup.  Note that
+you can explicitly override this setting by calling
 `message-cross-post-followup-to' with a prefix."
   :type 'boolean
   :group 'message-various)
@@ -367,10 +368,10 @@ Note that you can explicitly override this setting by calling
 ;;;###autoload
 (defcustom message-cross-post-note-function
   'message-cross-post-insert-note
-  "Function to use to insert note about Crosspost or Followup-To.  
+  "Function to use to insert note about Crosspost or Followup-To.
 The function will be called with four arguments.  The function should not only
 insert a note, but also ensure old notes are deleted.  See the documentation
-for `message-cross-post-insert-note'. "
+for `message-cross-post-insert-note'."
   :type 'function
   :group 'message-various)
 
@@ -689,7 +690,9 @@ Note that the variable `message-deletable-headers' specifies headers which
 are to be deleted and then re-generated before sending, so this variable
 will not have a visible effect for those headers."
   :group 'message-headers
-  :type 'boolean)
+  :type '(choice (const :tag "None" nil)
+                 (const :tag "All" t)
+                 (repeat (sexp :tag "Header"))))
 
 (defcustom message-setup-hook nil
   "Normal hook, run each time a new outgoing message is initialized.
@@ -800,6 +803,12 @@ If nil, don't insert a signature."
   :type '(choice file (const :tags "None" nil))
   :group 'message-insertion)
 
+;;;###autoload
+(defcustom message-signature-insert-empty-line t
+  "*If non-nil, insert an empty line before the signature separator."
+  :type 'boolean
+  :group 'message-insertion)
+
 (defcustom message-distribution-function nil
   "*Function called to return a Distribution header."
   :group 'message-news
@@ -952,12 +961,12 @@ A value of nil means exclude your own user name only."
   "*A list of GNKSA feet you are allowed to shoot.
 Gnus gives you all the opportunity you could possibly want for
 shooting yourself in the foot.  Also, Gnus allows you to shoot the
-feet of Good Net-Keeping Seal of Approval. The following are foot
+feet of Good Net-Keeping Seal of Approval.  The following are foot
 candidates:
 `empty-article'     Allow you to post an empty article;
 `quoted-text-only'  Allow you to post quoted text only;
 `multiple-copies'   Allow you to post multiple copies;
-`cancel-messages'   Allow you to cancel or supersede messages from 
+`cancel-messages'   Allow you to cancel or supersede messages from
                     your other email addresses.")
 
 (defsubst message-gnksa-enable-p (feature)
@@ -1169,18 +1178,23 @@ candidates:
 The cdr of each entry is a function for applying the face to a region.")
 
 (defcustom message-send-hook nil
-  "Hook run before sending messages."
+  "Hook run before sending messages.
+This hook is run quite early when sending."
   :group 'message-various
   :options '(ispell-message)
   :type 'hook)
 
 (defcustom message-send-mail-hook nil
-  "Hook run before sending mail messages."
+  "Hook run before sending mail messages.
+This hook is run very late -- just before the message is sent as
+mail."
   :group 'message-various
   :type 'hook)
 
 (defcustom message-send-news-hook nil
-  "Hook run before sending news messages."
+  "Hook run before sending news messages.
+This hook is run very late -- just before the message is sent as
+news."
   :group 'message-various
   :type 'hook)
 
@@ -1305,7 +1319,7 @@ no, only reply back to the author."
      ;; We want to match the results of any of these manglings.
      ;; The following regexp rejects names whose first characters are
      ;; obviously bogus, but after that anything goes.
-     "\\([^\0-\b\n-\r\^?].*\\)? "
+     "\\([^\0-\b\n-\r\^?].*\\)?"
 
      ;; The time the message was sent.
      "\\([^\0-\r \^?]+\\) +"           ; day of the week
@@ -1402,6 +1416,10 @@ no, only reply back to the author."
   `(delete-region (progn (beginning-of-line) (point))
                  (progn (forward-line ,(or n 1)) (point))))
 
+(defun message-mark-active-p ()
+  "Non-nil means the mark and region are currently active in this buffer."
+  mark-active)
+
 (defun message-unquote-tokens (elems)
   "Remove double quotes (\") from strings in list ELEMS."
   (mapcar (lambda (item)
@@ -1511,7 +1529,9 @@ is used by default."
 (defun message-fetch-reply-field (header)
   "Fetch field HEADER from the message we're replying to."
   (message-with-reply-buffer
-    (message-fetch-field header)))
+    (save-restriction
+      (mail-narrow-to-head)
+      (message-fetch-field header))))
 
 (defun message-set-work-buffer ()
   (if (get-buffer " *message work*")
@@ -1552,13 +1572,13 @@ is used by default."
 ;;; Start of functions adopted from `message-utils.el'.
 
 (defun message-strip-subject-trailing-was (subject)
-  "Remove trailing \"(Was: <old subject>)\" from subject lines.   
+  "Remove trailing \"(Was: <old subject>)\" from SUBJECT lines.
 Leading \"Re: \" is not stripped by this function.  Use the function
 `message-strip-subject-re' for this."
   (let* ((query message-subject-trailing-was-query)
         (new) (found))
     (setq found
-         (string-match 
+         (string-match
           (if (eq query 'ask)
               message-subject-trailing-was-ask-regexp
             message-subject-trailing-was-regexp)
@@ -1570,7 +1590,7 @@ Leading \"Re: \" is not stripped by this function.  Use the function
       (if (eq query 'ask)
          (if (message-y-or-n-p
               "Strip `(was: <old subject>)' in subject? " t
-              (concat 
+              (concat
                "Strip `(was: <old subject>)' in subject "
                "and use the new one instead?\n\n"
                "Current subject is:   \""
@@ -1587,7 +1607,7 @@ Leading \"Re: \" is not stripped by this function.  Use the function
 
 ;;;###autoload
 (defun message-change-subject (new-subject)
-  "Ask for new Subject: header, append (was: <Old Subject>)."
+  "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
   (interactive
    (list
     (read-from-minibuffer "New subject: ")))
@@ -1597,7 +1617,7 @@ Leading \"Re: \" is not stripped by this function.  Use the function
         (save-excursion
           (let ((old-subject (message-fetch-field "Subject")))
             (cond ((not old-subject)
-                   (error "No current subject."))
+                   (error "No current subject"))
                   ((not (string-match
                          (concat "^[ \t]*"
                                  (regexp-quote new-subject)
@@ -1627,7 +1647,7 @@ See `message-mark-insert-begin' and `message-mark-insert-end'."
 
 ;;;###autoload
 (defun message-mark-insert-file (file)
-  "Inserts FILE at point, marking it with enclosing tags.
+  "Insert FILE at point, marking it with enclosing tags.
 See `message-mark-insert-begin' and `message-mark-insert-end'."
   (interactive "fFile to insert: ")
     ;; reverse insertion to get correct result.
@@ -1684,14 +1704,14 @@ With prefix-argument just set Follow-Up, don't cross-post."
   ;; add target-group to Newsgroups line.
   (cond ((and (or
               ;; def: cross-post, req:no
-              (and message-cross-post-default (not current-prefix-arg))  
+              (and message-cross-post-default (not current-prefix-arg))
               ;; def: no-cross-post, req:yes
               (and (not message-cross-post-default) current-prefix-arg))
              (not (string-match "poster" target-group))
              (not (string-match (regexp-quote target-group)
                                 (message-fetch-field "Newsgroups"))))
         (end-of-line)
-        (insert-string (concat "," target-group))))
+        (insert (concat "," target-group))))
   (end-of-line) ; ensure Followup: comes after Newsgroups:
   ;; unless new followup would be identical to Newsgroups line
   ;; make a new Followup-To line
@@ -1737,7 +1757,7 @@ been made to before the user asked for a Crosspost."
 
 ;;;###autoload
 (defun message-cross-post-followup-to (target-group)
-  "Crossposts message and sets Followup-To to TARGET-GROUP.
+  "Crossposts message and set Followup-To to TARGET-GROUP.
 With prefix-argument just set Follow-Up, don't cross-post."
   (interactive
    (list ; Completion based on Gnus
@@ -1753,11 +1773,11 @@ With prefix-argument just set Follow-Up, don't cross-post."
         (save-excursion
           (let* ((old-groups (message-fetch-field "Newsgroups"))
                  (in-old (string-match
-                          (regexp-quote target-group) 
+                          (regexp-quote target-group)
                           (or old-groups ""))))
             ;; check whether target exactly matches old Newsgroups
             (cond ((not old-groups)
-                   (error "No current newsgroup."))
+                   (error "No current newsgroup"))
                   ((or (not in-old)
                        (not (string-match
                              (concat "^[ \t]*"
@@ -1766,7 +1786,7 @@ With prefix-argument just set Follow-Up, don't cross-post."
                              old-groups)))
                    ;; yes, Newsgroups line must change
                    (message-cross-post-followup-to-header target-group)
-                   ;; insert note whether we do cross-post or fup2
+                   ;; insert note whether we do cross-post or followup-to
                    (funcall message-cross-post-note-function
                             target-group
                             (if (or (and message-cross-post-default
@@ -1984,8 +2004,10 @@ Point is left at the beginning of the narrowed-to region."
   (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-f\C-a" 'message-gen-unsubscribed-mft)
+  (define-key message-mode-map "\C-c\C-f\C-i"
+    'message-insert-or-toggle-importance)
+  (define-key message-mode-map "\C-c\C-f\C-a"
+    'message-generate-unsubscribed-mail-followup-to)
 
   ;; modify headers (and insert notes in body)
   (define-key message-mode-map "\C-c\C-fs"    'message-change-subject)
@@ -1997,17 +2019,18 @@ Point is left at the beginning of the narrowed-to region."
   ;; mark inserted text
   (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
   (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
-  
+
   (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-p" 'message-insert-wide-reply)
+  (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
   (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
 
   (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\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)
@@ -2039,35 +2062,31 @@ Point is left at the beginning of the narrowed-to region."
 (easy-menu-define
   message-mode-menu message-mode-map "Message Menu."
   `("Message"
-    ["Sort Headers" message-sort-headers t]
-    ["Yank Original" message-yank-original t]
+    ["Yank Original" message-yank-original message-reply-buffer]
     ["Fill Yanked Message" message-fill-yanked-message t]
     ["Insert Signature" message-insert-signature t]
     ["Caesar (rot13) Message" message-caesar-buffer-body t]
-    ["Caesar (rot13) Region" message-caesar-region (mark t)]
-    ["Elide Region" message-elide-region (mark t)]
-    ["Delete Outside Region" message-delete-not-region (mark t)]
+    ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)]
+    ["Elide Region" message-elide-region 
+     :active (message-mark-active-p)
+     ,@(if (featurep 'xemacs) nil
+        '(:help "Replace text in region with an ellipsis"))]
+    ["Delete Outside Region" message-delete-not-region 
+     :active (message-mark-active-p)
+     ,@(if (featurep 'xemacs) nil
+        '(:help "Delete all quoted text outside 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"))]
     "----"
-    ["Insert Region Marked" message-mark-inserted-region 
-     ,@(if (featurep 'xemacs) '(t)
+    ["Insert Region Marked" message-mark-inserted-region
+     :active (message-mark-active-p)
+     ,@(if (featurep 'xemacs) nil
         '(:help "Mark region with enclosing tags"))]
-    ["Insert File Marked..." message-mark-insert-file 
+    ["Insert File Marked..." message-mark-insert-file
      ,@(if (featurep 'xemacs) '(t)
         '(:help "Insert file at point marked with enclosing tags"))]
     "----"
@@ -2086,7 +2105,7 @@ Point is left at the beginning of the narrowed-to region."
 
 (easy-menu-define
   message-mode-field-menu message-mode-map ""
-  '("Field"
+  `("Field"
     ["Fetch To" message-insert-to t]
     ["Fetch Newsgroups" message-insert-newsgroups t]
     "----"
@@ -2098,6 +2117,16 @@ Point is left at the beginning of the narrowed-to region."
     ["Bcc" message-goto-bcc t]
     ["Fcc" message-goto-fcc t]
     ["Reply-To" message-goto-reply-to 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 receipt notification"))]
     "----"
     ;; (typical) news stuff
     ["Summary" message-goto-summary t]
@@ -2114,8 +2143,9 @@ Point is left at the beginning of the narrowed-to region."
     ["Mail-Followup-To" message-goto-mail-followup-to t]
     ["Reduce To: to Cc:" message-reduce-to-to-cc t]
     "----"
-    ["Body" message-goto-body t]
-    ["Signature" message-goto-signature t]))
+    ["Sort Headers" message-sort-headers t]
+    ["Goto Body" message-goto-body t]
+    ["Goto Signature" message-goto-signature t]))
 
 (defvar message-tool-bar-map nil)
 
@@ -2240,6 +2270,9 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (set (make-local-variable 'message-checksum) nil)
   (set (make-local-variable 'message-mime-part) 0)
   (message-setup-fill-variables)
+  (set (make-local-variable 'paragraph-separate)
+       (concat paragraph-separate
+              "\\|<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
   ;; Allow using comment commands to add/remove quoting.
   (set (make-local-variable 'comment-start) message-yank-prefix)
   (if (featurep 'xemacs)
@@ -2412,15 +2445,15 @@ return nil."
     (goto-char (point-max))
     nil))
 
-(defun message-gen-unsubscribed-mft (&optional include-cc)
+(defun message-generate-unsubscribed-mail-followup-to (&optional include-cc)
   "Insert a reasonable MFT header in a post to an unsubscribed list.
 When making original posts to a mailing list you are not subscribed to,
 you have to type in a MFT header by hand.  The contents, usually, are
 the addresses of the list and your own address.  This function inserts
 such a header automatically.  It fetches the contents of the To: header
-in the current mail buffer, and appends the current user-mail-address.
+in the current mail buffer, and appends the current `user-mail-address'.
 
-If the optional argument `include-cc' is non-nil, the addresses in the
+If the optional argument INCLUDE-CC is non-nil, the addresses in the
 Cc: header are also put into the MFT."
 
   (interactive "P")
@@ -2677,7 +2710,9 @@ Prefix arg means justify as well."
       ;; Insert the signature.
       (unless (bolp)
        (insert "\n"))
-      (insert "\n-- \n")
+      (when message-signature-insert-empty-line
+       (insert "\n"))
+      (insert "-- \n")
       (if (eq signature t)
          (insert-file-contents message-signature-file)
        (insert signature))
@@ -3120,6 +3155,7 @@ It should typically alter the sending method in some way or other."
       (when (funcall (cadr elem))
        (when (and (or (not (memq (car elem)
                                  message-sent-message-via))
+                      (not (message-fetch-field "supersedes"))
                       (if (or (message-gnksa-enable-p 'multiple-copies)
                               (not (eq (car elem) 'news)))
                           (y-or-n-p
@@ -3200,7 +3236,8 @@ It should typically alter the sending method in some way or other."
        (goto-char (car points))
        (dolist (point points)
          (add-text-properties point (1+ point)
-                              '(invisible nil highlight t)))
+                              '(invisible nil face highlight
+                                          font-lock-face highlight)))
        (unless (yes-or-no-p
                 "Invisible text found and made visible; continue posting? ")
          (error "Invisible text found and made visible")))))
@@ -3213,16 +3250,17 @@ It should typically alter the sending method in some way or other."
                (or (< (mm-char-int char) 128)
                    (and (mm-multibyte-p)
                         (memq (char-charset char)
-                              '(eight-bit-control eight-bit-graphic 
+                              '(eight-bit-control eight-bit-graphic
                                                   control-1)))))
-         (add-text-properties (point) (1+ (point)) '(highlight t))
+         (add-text-properties (point) (1+ (point))
+                              '(font-lock-face highlight face highlight))
          (setq found t))
        (forward-char)
        (skip-chars-forward mm-7bit-chars))
       (when found
        (setq choice
-             (gnus-multiple-choice 
-              "Illegible text found. Continue posting? "
+             (gnus-multiple-choice
+              "Illegible text found.  Continue posting?"
               '((?d "Remove and continue posting")
                 (?r "Replace with dots and continue posting")
                 (?i "Ignore and continue posting")
@@ -3239,10 +3277,11 @@ It should typically alter the sending method in some way or other."
                                 '(eight-bit-control eight-bit-graphic
                                                     control-1)))))
            (if (eq choice ?i)
-               (remove-text-properties (point) (1+ (point)) '(highlight t))
+               (remove-text-properties (point) (1+ (point))
+                                       '(font-lock-face highlight face highlight))
              (delete-char 1)
-             (if (eq choice ?r)
-                 (insert "."))))
+             (when (eq choice ?r)
+               (insert "."))))
          (forward-char)
          (skip-chars-forward mm-7bit-chars))))))
 
@@ -3363,7 +3402,7 @@ It should typically alter the sending method in some way or other."
               (not (mail-fetch-field "mail-followup-to")))
          (setq headers
                (cons
-                (cons "Mail-Followup-To" (message-make-mft))
+                (cons "Mail-Followup-To" (message-make-mail-followup-to))
                 message-required-mail-headers))
        ;; otherwise, delete the MFT header if the field is empty
        (when (equal "" (mail-fetch-field "mail-followup-to"))
@@ -3434,7 +3473,7 @@ sent in one piece.
 
 The size limit is controlled by `message-send-mail-partially-limit'.
 If you always want Gnus to send messages in one piece, set
-`message-send-mail-partially-limit' to `nil'.
+`message-send-mail-partially-limit' to nil.
 ")))
              (mm-with-unibyte-current-buffer
                (message "Sending via mail...")
@@ -3762,6 +3801,24 @@ Otherwise, generate and save a value for `canlock-password' first."
         (y-or-n-p
          "The control code \"cmsg\" is in the subject.  Really post? ")
        t))
+   ;; Check long header lines.
+   (message-check 'long-header-lines
+     (let ((start (point))
+          (header nil)
+          (length 0)
+          found)
+       (while (and (not found)
+                  (re-search-forward "^\\([^ \t:]+\\): " nil t))
+        (if (> (- (point) (match-beginning 0)) 998)
+            (setq found t
+                  length (- (point) (match-beginning 0)))
+          (setq header (match-string-no-properties 1)))
+        (setq start (match-beginning 0))
+        (forward-line 1))
+       (if found
+          (y-or-n-p (format "Your %s header is too long (%d).  Really post? "
+                            header length))
+        t)))
    ;; Check for multiple identical headers.
    (message-check 'multiple-headers
      (let (found)
@@ -3895,6 +3952,18 @@ Otherwise, generate and save a value for `canlock-password' first."
           (if (= (length errors) 1) "this" "these")
           (if (= (length errors) 1) "" "s")
           (mapconcat 'identity errors ", ")))))))
+   ;; Check continuation headers.
+   (message-check 'continuation-headers
+     (goto-char (point-min))
+     (let ((do-posting t))
+       (while (re-search-forward "^[^ \t\n][^:\n]*$" nil t)
+        (if (y-or-n-p "Fix continuation lines? ")
+            (progn
+              (goto-char (match-beginning 0))
+              (insert " "))
+          (unless (y-or-n-p "Send anyway? ")
+            (setq do-posting nil))))
+       do-posting))
    ;; Check the Newsgroups & Followup-To headers for syntax errors.
    (message-check 'valid-newsgroups
      (let ((case-fold-search t)
@@ -4453,7 +4522,7 @@ give as trustworthy answer as possible."
   "Send a message to the list only.
 Remove all addresses but the list address from To and Cc headers."
   (interactive)
-  (let ((listaddr (message-make-mft t)))
+  (let ((listaddr (message-make-mail-followup-to t)))
     (when listaddr
       (save-excursion
        (message-remove-header "to")
@@ -4461,10 +4530,10 @@ Remove all addresses but the list address from To and Cc headers."
        (message-position-on-field "To" "X-Draft-From")
        (insert listaddr)))))
 
-(defun message-make-mft (&optional only-show-subscribed)
-  "Return the Mail-Followup-To header. If passed the optional
-argument `only-show-subscribed' only return the subscribed address (and
-not the additional To and Cc header contents)."
+(defun message-make-mail-followup-to (&optional only-show-subscribed)
+  "Return the Mail-Followup-To header.
+If passed the optional argument ONLY-SHOW-SUBSCRIBED only return the
+subscribed address (and not the additional To and Cc header contents)."
   (let* ((case-fold-search t)
         (to (message-fetch-field "To"))
         (cc (message-fetch-field "cc"))
@@ -4526,6 +4595,7 @@ Headers already prepared in the buffer are not modified."
           (User-Agent message-newsreader)
           (Expires (message-make-expires))
           (case-fold-search t)
+          (optionalp nil)
           header value elem)
       ;; First we remove any old generated headers.
       (let ((headers message-deletable-headers))
@@ -4547,7 +4617,8 @@ Headers already prepared in the buffer are not modified."
        (setq elem (pop headers))
        (if (consp elem)
            (if (eq (car elem) 'optional)
-               (setq header (cdr elem))
+               (setq header (cdr elem)
+                     optionalp t)
              (setq header (car elem)))
          (setq header elem))
        (when (or (not (re-search-forward
@@ -4563,7 +4634,7 @@ Headers already prepared in the buffer are not modified."
                    ;; The header was found.  We insert a space after the
                    ;; colon, if there is none.
                    (if (/= (char-after) ? ) (insert " ") (forward-char 1))
-                   ;; Find out whether the header is empty...
+                   ;; Find out whether the header is empty.
                    (looking-at "[ \t]*\n[^ \t]")))
          ;; So we find out what value we should insert.
          (setq value
@@ -4605,17 +4676,25 @@ Headers already prepared in the buffer are not modified."
                  (progn
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))
-                   (insert (if (stringp header) header (symbol-name header))
-                           ": " value)
-                   ;; We check whether the value was ended by a
-                   ;; newline.  If now, we insert one.
-                   (unless (bolp)
-                     (insert "\n"))
-                   (forward-line -1))
+                   (let ((formatter
+                          (cdr (assq header message-header-format-alist))))
+                     (if formatter
+                         (funcall formatter header value)
+                       (insert (if (stringp header)
+                                   header (symbol-name header))
+                               ": " 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.
                (delete-region (point) (gnus-point-at-eol))
-               (insert value))
+               ;; If the header is optional, and the header was
+               ;; empty, we con't insert it anyway.
+               (unless optionalp
+                 (insert value)))
              ;; Add the deletable property to the headers that require it.
              (and (memq header message-deletable-headers)
                   (progn (beginning-of-line) (looking-at "[^:]+: "))
@@ -5348,7 +5427,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
 
     (setq message-reply-headers
          (vector 0 subject from date message-id references 0 0 ""))
-    
+
     (message-setup
      `((Subject . ,subject)
        ,@(cond
@@ -5682,7 +5761,7 @@ Optional DIGEST will use digest to forward."
             (mm-disable-multibyte-mule4)
             (insert
              (with-current-buffer forward-buffer
-               (mm-string-as-unibyte (buffer-string))))
+               (mm-with-unibyte-current-buffer-mule4 (buffer-string))))
             (mm-enable-multibyte-mule4)
             (mime-to-mml)
             (goto-char (point-min))
@@ -5754,12 +5833,16 @@ Optional DIGEST will use digest to forward."
       (unless (message-mail-user-agent)
        (set-buffer (get-buffer-create " *message resend*"))
        (erase-buffer))
-      (let ((message-this-is-mail t))
+      (let ((message-this-is-mail t)
+           message-setup-hook)
        (message-setup `((To . ,address))))
       ;; Insert our usual headers.
       (message-generate-headers '(From Date To))
       (message-narrow-to-headers)
+      ;; Remove X-Draft-From header etc.
+      (message-remove-header message-ignored-mail-headers t)
       ;; Rename them all to "Resent-*".
+      (goto-char (point-min))
       (while (re-search-forward "^[A-Za-z]" nil t)
        (forward-char -1)
        (insert "Resent-"))
@@ -5945,7 +6028,7 @@ which specify the range to operate on."
 (defun message-tool-bar-map ()
   (or message-tool-bar-map
       (setq message-tool-bar-map
-           (and 
+           (and
             (condition-case nil (require 'tool-bar) (error nil))
             (fboundp 'tool-bar-add-item-from-menu)
             tool-bar-mode
@@ -5966,6 +6049,9 @@ which specify the range to operate on."
                'mml-attach-file "attach" tool-bar-map mml-mode-map)
               (message-tool-bar-local-item-from-menu
                'ispell-message "spell" tool-bar-map message-mode-map)
+              (message-tool-bar-local-item-from-menu
+               'mml-preview "preview"
+               tool-bar-map mml-mode-map)
               (message-tool-bar-local-item-from-menu
                'message-insert-importance-high "important"
                tool-bar-map message-mode-map)
@@ -5988,9 +6074,9 @@ which specify the range to operate on."
 (defcustom message-completion-alist
   (list (cons message-newgroups-header-regexp 'message-expand-group)
        '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
-       '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" 
+       '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
          . message-expand-name)
-       '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" 
+       '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
          . message-expand-name))
   "Alist of (RE . FUN).  Use FUN for completion on header lines matching RE."
   :group 'message