T-gnus 6.15.18 revision 00.
[elisp/gnus.git-] / lisp / message.el
index c1f99f4..566585d 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>
@@ -269,9 +269,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)
@@ -296,7 +296,7 @@ Note that you can explicitly override this setting by calling
   "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)
 
@@ -342,14 +342,14 @@ Checks include `subject-cmsg', `multiple-headers', `sendsys',
 `approved', `sender', `empty', `empty-headers', `message-id', `from',
 `subject', `shorten-followup-to', `existing-newsgroups',
 `buffer-file-name', `unchanged', `newsgroups', `reply-to',
-'continuation-headers'."
+'continuation-headers', and `long-header-lines'."
   :group 'message-news
   :type '(repeat sexp))                        ; Fixme: improve this
 
 (defcustom message-required-headers '((optional . References) From)
-  "*Headers to be generated or promted for when sending a message.
+  "*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))
@@ -558,7 +558,7 @@ If t, use `message-user-organization-file'."
   :type 'regexp)
 
 (defcustom message-make-forward-subject-function
-  'message-forward-subject-author-subject
+  'message-forward-subject-name-subject
   "*List of functions called to generate subject headers for forwarded messages.
 The subject generated by the previous function is passed into each
 successive function.
@@ -567,6 +567,8 @@ The provided functions are:
 
 * `message-forward-subject-author-subject' (Source of article (author or
       newsgroup)), in brackets followed by the subject
+* `message-forward-subject-name-subject' (Source of article (name of author
+      or newsgroup)), in brackets followed by the subject
 * `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended
       to it."
   :group 'message-forwarding
@@ -792,6 +794,15 @@ Doing so would be even more evil than leaving it out."
   :group 'message-sending
   :type 'boolean)
 
+(defcustom message-sendmail-envelope-from nil
+  "*Envelope-from when sending mail with sendmail.
+If this is nil, use `user-mail-address'.  If it is the symbol
+`header', use the From: header of the message."
+  :type '(choice (string :tag "From name")
+                (const :tag "Use From: header from message" header)
+                (const :tag "Use `user-mail-address'" nil))
+  :group 'message-sending)
+
 ;; qmail-related stuff
 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
   "Location of the qmail-inject program."
@@ -846,7 +857,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 '(turn-on-mime-edit)
   "Normal hook, run each time a new outgoing message is initialized.
@@ -1164,7 +1177,7 @@ 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;
@@ -1176,6 +1189,13 @@ candidates:
   (or (not (listp message-shoot-gnksa-feet))
       (memq feature message-shoot-gnksa-feet)))
 
+(defcustom message-hidden-headers nil
+  "Regexp of headers to be hidden when composing new messages.
+This can also be a list of regexps to match headers.  Or a list
+starting with `not' and followed by regexps.."
+  :group 'message
+  :type '(repeat regexp))
+
 ;;; Internal variables.
 ;;; Well, not really internal.
 
@@ -1383,18 +1403,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)
 
@@ -1482,6 +1507,23 @@ no, only reply back to the author."
   :group 'message-headers
   :type 'boolean)
 
+(defcustom message-user-fqdn nil
+  "*Domain part of Messsage-Ids."
+  :group 'message-headers
+  :link '(custom-manual "(message)News Headers")
+  :type 'string)
+
+(defcustom message-use-idna (and (condition-case nil (require 'idna)
+                                  (file-error))
+                                (fboundp 'coding-system-p)
+                                (coding-system-p 'utf-8)
+                                'ask)
+  "Whether to encode non-ASCII in domain names into ASCII according to IDNA."
+  :group 'message-headers
+  :type '(choice (const :tag "Ask" ask)
+                (const :tag "Never" nil)
+                (const :tag "Always" t)))
+
 ;;; Internal variables.
 
 (defvar message-sending-message "Sending...")
@@ -1528,7 +1570,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
@@ -1590,6 +1632,19 @@ no, only reply back to the author."
 (defvar message-bogus-system-names "^localhost\\."
   "The regexp of bogus system names.")
 
+(defcustom message-valid-fqdn-regexp
+  (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
+         ;; valid TLDs:
+         "\\([a-z][a-z]" ;; two letter country TDLs
+         "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org"
+         "\\|aero\\|coop\\|info\\|name\\|museum"
+         "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style?
+         "\\)")
+  "Regular expression that matches a valid FQDN."
+  ;; see also: gnus-button-valid-fqdn-regexp
+  :group 'message-headers
+  :type 'regexp)
+
 (eval-and-compile
   (autoload 'message-setup-toolbar "messagexmas")
   (autoload 'mh-new-draft-name "mh-comp")
@@ -1643,6 +1698,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)
@@ -1753,7 +1812,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*")
@@ -1793,7 +1854,7 @@ 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)
@@ -1828,7 +1889,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: ")))
@@ -1838,7 +1899,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)
@@ -1868,7 +1929,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.
@@ -1932,7 +1993,7 @@ With prefix-argument just set Follow-Up, don't cross-post."
              (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
@@ -1978,7 +2039,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
@@ -1998,7 +2059,7 @@ With prefix-argument just set Follow-Up, don't cross-post."
                           (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]*"
@@ -2226,8 +2287,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)
@@ -2245,12 +2308,13 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-fc" 'message-goto-mail-copies-to)
 
   (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)
@@ -2272,6 +2336,7 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
   (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
   ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
+  (define-key message-mode-map [remap split-line]  'message-split-line)
 
   (define-key message-mode-map "\C-a" 'message-beginning-of-line)
   (define-key message-mode-map "\t" 'message-tab)
@@ -2282,27 +2347,22 @@ 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]
    ["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"))]
@@ -2311,7 +2371,8 @@ Point is left at the beginning of the narrowed-to region."
        '(:help "Attach a file at point"))]
    "----"
    ["Insert Region Marked" message-mark-inserted-region
-    ,@(if (featurep 'xemacs) '(t)
+    :active (message-mark-active-p)
+    ,@(if (featurep 'xemacs) nil
        '(:help "Mark region with enclosing tags"))]
    ["Insert File Marked..." message-mark-insert-file
     ,@(if (featurep 'xemacs) '(t)
@@ -2332,7 +2393,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]
    "----"
@@ -2344,6 +2405,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]
@@ -2362,8 +2433,10 @@ Point is left at the beginning of the narrowed-to region."
    ["Mail-Copies-To" message-goto-mail-copies-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]
+   ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
+   ["Goto Body" message-goto-body t]
+   ["Goto Signature" message-goto-signature t]))
 
 (defvar message-tool-bar-map nil)
 
@@ -2393,7 +2466,7 @@ message composition doesn't break too bad."
   ;; 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
+  '(field nil read-only nil invisible nil intangible 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:
@@ -2426,7 +2499,11 @@ See also `message-forbidden-properties'."
             (message-tamago-not-in-use-p begin)
             ;; Check whether the invisible MIME part is not inserted.
             (not (text-property-any begin end 'mime-edit-invisible t)))
-    (remove-text-properties begin end message-forbidden-properties)))
+    (while (not (= begin end))
+      (when (not (get-text-property begin 'message-hidden))
+       (remove-text-properties begin (1+ begin)
+                               message-forbidden-properties))
+      (incf begin))))
 
 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"
@@ -2491,6 +2568,11 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (setq message-parameter-alist
        (copy-sequence message-startup-parameter-alist))
   (message-setup-fill-variables)
+  (set
+   (make-local-variable 'paragraph-separate)
+   (format "\\(%s\\)\\|\\(%s\\)"
+          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)
@@ -2683,15 +2765,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")
@@ -2886,6 +2968,7 @@ Prefix arg means justify as well."
        (delete-region (point) (re-search-forward "[ \t]*"))
        (when (and quoted (not bolp))
          (insert quoted leading-space)))
+      (undo-boundary)
       (if quoted
          (let* ((adaptive-fill-regexp
                  (regexp-quote (concat quoted leading-space)))
@@ -3178,7 +3261,6 @@ to REFS-LIST."
       (push (pop saved-id) refs-list))
     refs-list))
 
-(defvar gnus-article-copy)
 (defun message-yank-original (&optional arg)
   "Insert the message being replied to, if any.
 Puts point before the text and mark after.
@@ -3192,51 +3274,61 @@ prefix, and don't delete any headers.
 
 In addition, if `message-yank-add-new-references' is non-nil and this
 command is called interactively, new IDs from the yanked article will
-be added to \"References\" field.
-\(See also `message-yank-add-new-references'.)"
+be added to the \"References\" field."
   (interactive "P")
-  (let ((modified (buffer-modified-p))
-       (buffer (message-eval-parameter message-reply-buffer))
-       start end refs)
-    (when (and buffer
-              message-cite-function)
-      (delete-windows-on buffer t)
-      (insert-buffer buffer) ; mark will be set at the end of article.
-      (setq start (point)
-           end (mark t))
-
-      ;; Add new IDs to References field.
-      (when (and message-yank-add-new-references (interactive-p))
-       (save-excursion
-         (save-restriction
-           (message-narrow-to-headers)
-           (setq refs (message-list-references
-                       nil
-                       (message-fetch-field "References")))
-           (widen)
-           (narrow-to-region start end)
-           (std11-narrow-to-header)
-           (when (setq refs (message-list-references
-                             refs
-                             (unless (eq message-yank-add-new-references
-                                         'message-id-only)
-                               (or (message-fetch-field "References")
-                                   (message-fetch-field "In-Reply-To")))
-                             (message-fetch-field "Message-ID")))
+  (let ((modified (buffer-modified-p)))
+    (when (let ((buffer (message-eval-parameter message-reply-buffer)))
+           (and buffer
+                message-cite-function
+                (prog1
+                    t
+                  (delete-windows-on buffer t)
+                  ; The mark will be set at the end of the article.
+                  (insert-buffer buffer))))
+      ;; Add new IDs to the References field.
+      (when (and message-yank-add-new-references
+                (interactive-p))
+       (let ((start (point))
+             (end (mark t))
+             refs newrefs)
+         (save-excursion
+           (save-restriction
              (widen)
-             (message-narrow-to-headers)
-             (goto-char (point-min))
-             (let ((case-fold-search t))
-               (if (re-search-forward "^References:\\([\t ]+.+\n\\)+" nil t)
+             (setq refs (message-list-references
+                         nil
+                         (or (message-make-references)
+                             (prog2
+                                 (message-narrow-to-headers)
+                                 (message-fetch-field "References")
+                               (widen)))))
+             (narrow-to-region start end)
+             (std11-narrow-to-header)
+             (unless (equal (setq newrefs
+                                  (message-list-references
+                                   (copy-sequence refs)
+                                   (unless (eq message-yank-add-new-references
+                                               'message-id-only)
+                                     (or (message-fetch-field "References")
+                                         (message-fetch-field "In-Reply-To")))
+                                   (message-fetch-field "Message-ID")))
+                            refs)
+               ;; If the References field has been changed, we make it
+               ;; visible in the header.
+               (mail-header-set-message-id message-reply-headers nil)
+               (mail-header-set-references message-reply-headers nil)
+               (widen)
+               (message-narrow-to-headers)
+               (if (let ((case-fold-search t))
+                     (re-search-forward "^References:\\([\t ]+.+\n\\)+"
+                                        nil t))
                    (replace-match "")
-                 (goto-char (point-max))))
-             (mail-header-format
-              (list (or (assq 'References message-header-format-alist)
-                        '(References . message-fill-references)))
-              (list (cons 'References
-                          (mapconcat 'identity (nreverse refs) " "))))
-             (backward-delete-char 1)))))
-
+                 (goto-char (point-max)))
+               (mail-header-format
+                (list (or (assq 'References message-header-format-alist)
+                          '(References . message-fill-references)))
+                (list (cons 'References (mapconcat 'identity
+                                                   (nreverse newrefs) " "))))
+               (backward-delete-char 1))))))
       (unless arg
        (if (and message-suspend-font-lock-when-citing
                 (boundp 'font-lock-mode)
@@ -3559,6 +3651,7 @@ It should typically alter the sending method in some way or other."
                  (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
@@ -3657,6 +3750,13 @@ used to distinguish whether the invisible text is a MIME part or not."
   (goto-char (point-max))
   (unless (bolp)
     (insert "\n"))
+  ;; Make the hidden headers visible.
+  (let ((points (message-text-with-property 'message-hidden)))
+    (when points
+      (goto-char (car points))
+      (dolist (point points)
+       (add-text-properties point (1+ point)
+                            '(invisible nil intangible nil)))))
   ;; Delete all invisible text except for the mime parts which might
   ;; be inserted by the MIME-Edit.
   (message-check 'invisible-text
@@ -3671,13 +3771,17 @@ used to distinguish whether the invisible text is a MIME part or not."
                                                  'mime-edit-invisible t))
          (when (> mime-from mime-to)
            (setq hidden-start (or hidden-start mime-to))
-           (put-text-property mime-to mime-from 'invisible nil))
+           (add-text-properties mime-to mime-from
+                                '(invisible nil face highlight
+                                            font-lock-face highlight)))
          (setq mime-to (or (text-property-not-all mime-from to
                                                   'mime-edit-invisible t)
                            to)))
        (when (< mime-to to)
          (setq hidden-start (or hidden-start mime-to))
-         (put-text-property mime-to to 'invisible nil)))
+         (add-text-properties mime-to to
+                              '(invisible nil face highlight
+                                          font-lock-face highlight))))
       (when hidden-start
        (goto-char hidden-start)
        (set-window-start (selected-window) (gnus-point-at-bol))
@@ -3696,14 +3800,15 @@ used to distinguish whether the invisible text is a MIME part or not."
                         (memq (char-charset char)
                               '(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? "
+              "Illegible text found.  Continue posting?"
               '((?d "Remove and continue posting")
                 (?r "Replace with dots and continue posting")
                 (?i "Ignore and continue posting")
@@ -3720,10 +3825,11 @@ used to distinguish whether the invisible text is a MIME part or not."
                                 '(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))))))
 
@@ -3849,7 +3955,7 @@ This sub function is for exclusive use of `message-send-mail'."
              (message-remove-header "Lines")
              (goto-char (point-max))
              (insert "Mime-Version: 1.0\n")
-             (setq header (buffer-substring (point-min) (point-max))))
+             (setq header (buffer-string)))
            (goto-char (point-max))
            (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n"
                            id n total))
@@ -3886,7 +3992,7 @@ This sub function is for exclusive use of `message-send-mail'."
               (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"))
@@ -3927,6 +4033,7 @@ This sub function is for exclusive use of `message-send-mail'."
                  (message-narrow-to-headers)
                  (and news
                       (or (message-fetch-field "cc")
+                          (message-fetch-field "bcc")
                           (message-fetch-field "to"))
                       (let ((ct (mime-read-Content-Type)))
                         (or (not ct)
@@ -3987,7 +4094,7 @@ This sub function is for exclusive use of `message-send-mail'."
                         ;; But some systems are more broken with -f, so
                         ;; we'll let users override this.
                         (if (null message-sendmail-f-is-evil)
-                            (list "-f" (message-make-address)))
+                            (list "-f" (message-sendmail-envelope-from)))
                         ;; These mean "report errors by mail"
                         ;; and "deliver in background".
                         (if (null message-interactive) '("-oem" "-odb"))
@@ -4009,7 +4116,7 @@ This sub function is for exclusive use of `message-send-mail'."
                (replace-match "; "))
              (if (not (zerop (buffer-size)))
                  (error "Sending...failed to %s"
-                        (buffer-substring (point-min) (point-max)))))))
+                        (buffer-string))))))
       (when (bufferp errbuf)
        (kill-buffer errbuf)))))
 
@@ -4315,6 +4422,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)
@@ -4364,7 +4489,7 @@ Otherwise, generate and save a value for `canlock-password' first."
    ;; Check "Shoot me".
    (message-check 'shoot
      (if (re-search-forward
-         "Message-ID.*.i-did-not-set--mail-host-address--so-shoot-me" nil t)
+         "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t)
         (y-or-n-p "You appear to have a misconfigured system.  Really post? ")
        t))
    ;; Check for Approved.
@@ -4417,8 +4542,9 @@ Otherwise, generate and save a value for `canlock-password' first."
                     (gnus-groups-from-server method)))
            errors)
        (while groups
-        (unless (or (equal (car groups) "poster")
-                    (member (car groups) known-groups))
+        (when (and (not (equal (car groups) "poster"))
+                   (not (member (car groups) known-groups))
+                   (not (member (car groups) errors)))
           (push (car groups) errors))
         (pop groups))
        (cond
@@ -4931,16 +5057,15 @@ If NOW, use that time instead."
     (let ((from (mail-header-from message-reply-headers))
          (date (mail-header-date message-reply-headers))
          (msg-id (mail-header-message-id message-reply-headers)))
-      (when msg-id
-       (concat msg-id
-               (when from
-                 (let ((pair (std11-extract-address-components from)))
-                   (concat "\n ("
-                           (or (car pair) (cadr pair))
-                           "'s message of \""
-                           (if (or (not date) (string= date ""))
-                               "(unknown date)" date)
-                           "\")"))))))))
+      (when from
+       (let ((name (std11-extract-address-components from)))
+         (concat msg-id (if msg-id " (")
+                 (or (car name)
+                     (nth 1 name))
+                 "'s message of \""
+                 (if (or (not date) (string= date ""))
+                     "(unknown date)" date)
+                 "\"" (if msg-id ")")))))))
 
 (defun message-make-distribution ()
   "Make a Distribution header."
@@ -5030,30 +5155,53 @@ give as trustworthy answer as possible."
 
 (defun message-user-mail-address ()
   "Return the pertinent part of `user-mail-address'."
-  (when user-mail-address
+  (when (and user-mail-address
+            (string-match "@.*\\." user-mail-address))
     (if (string-match " " user-mail-address)
        (nth 1 (std11-extract-address-components user-mail-address))
       user-mail-address)))
 
+(defun message-sendmail-envelope-from ()
+  "Return the envelope from."
+  (cond ((eq message-sendmail-envelope-from 'header)
+        (nth 1 (mail-extract-address-components
+                (message-fetch-field "from"))))
+       ((stringp message-sendmail-envelope-from)
+        message-sendmail-envelope-from)
+       (t
+        (message-make-address))))
+
 (defun message-make-fqdn ()
   "Return user's fully qualified domain name."
-  (let ((system-name (system-name))
-       (user-mail (message-user-mail-address)))
+  (let* ((system-name (system-name))
+        (user-mail (message-user-mail-address))
+        (user-domain
+         (if (and user-mail
+                  (string-match "@\\(.*\\)\\'" user-mail))
+             (match-string 1 user-mail))))
     (cond
-     ((and (string-match "[^.]\\.[^.]" system-name)
+     ((and message-user-fqdn
+          (stringp message-user-fqdn)
+          (string-match message-valid-fqdn-regexp message-user-fqdn)
+          (not (string-match message-bogus-system-names message-user-fqdn)))
+      message-user-fqdn)
+     ;; `message-user-fqdn' seems to be valid
+     ((and (string-match message-valid-fqdn-regexp system-name)
           (not (string-match message-bogus-system-names 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))
+          (string-match message-valid-fqdn-regexp mail-host-address)
+          (not (string-match message-bogus-system-names mail-host-address)))
       mail-host-address)
      ;; We try `user-mail-address' as a backup.
-     ((and user-mail
-          (string-match "\\." user-mail)
-          (string-match "@\\(.*\\)\\'" user-mail))
-      (match-string 1 user-mail))
+     ((and user-domain
+          (stringp user-domain)
+          (string-match message-valid-fqdn-regexp user-domain)
+          (not (string-match message-bogus-system-names user-domain)))
+      user-domain)
      ;; Default to this bogus thing.
      (t
       (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me")))))
@@ -5073,7 +5221,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")
@@ -5081,10 +5229,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"))
@@ -5154,6 +5302,70 @@ string."
              (concat message-user-agent " " user-agent))
          message-user-agent)))))
 
+(defun message-idna-inside-rhs-p ()
+  "Return t iff point is inside a RHS (heuristically).
+Only works properly if header contains mailbox-list or address-list.
+I.e., calling it on a Subject: header is useless."
+  (save-restriction
+    (narrow-to-region (save-excursion (or (re-search-backward "^[^ \t]" nil t)
+                                         (point-min)))
+                     (save-excursion (or (re-search-forward "^[^ \t]" nil t)
+                                         (point-max))))
+    (if (re-search-backward "[\\\n\r\t ]"
+                           (save-excursion (search-backward "@" nil t)) t)
+       ;; whitespace between @ and point
+       nil
+      (let ((dquote 1) (paren 1))
+       (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote))
+         (incf dquote))
+       (while (save-excursion (re-search-backward "[^\\]\(" nil t paren))
+         (incf paren))
+       (and (= (% dquote 2) 1) (= (% paren 2) 1))))))
+
+(autoload 'idna-to-ascii "idna")
+
+(defun message-idna-to-ascii-rhs-1 (header)
+  "Interactively potentially IDNA encode domain names in HEADER."
+  (let (rhs ace start startpos endpos ovl)
+    (goto-char (point-min))
+    (while (re-search-forward (concat "^" header) nil t)
+      (while (re-search-forward "@\\([^ \t\r\n>]+\\)"
+                               (or (save-excursion
+                                     (re-search-forward "^[^ \t]" nil t))
+                                   (point-max))
+                               t)
+       (setq rhs (match-string-no-properties 1)
+             startpos (match-beginning 1)
+             endpos (match-end 1))
+       (when (save-match-data
+               (and (message-idna-inside-rhs-p)
+                    (setq ace (idna-to-ascii rhs))
+                    (not (string= rhs ace))
+                    (if (eq message-use-idna 'ask)
+                        (unwind-protect
+                            (progn
+                              (setq ovl (message-make-overlay startpos
+                                                              endpos))
+                              (message-overlay-put ovl 'face 'highlight)
+                              (y-or-n-p
+                               (format "Replace with `%s'? " ace)))
+                          (message "")
+                          (message-delete-overlay ovl))
+                      message-use-idna)))
+         (replace-match (concat "@" ace)))))))
+
+(defun message-idna-to-ascii-rhs ()
+  "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
+See `message-idna-encode'."
+  (interactive)
+  (when message-use-idna
+    (save-excursion
+      (save-restriction
+       (message-narrow-to-head)
+       (message-idna-to-ascii-rhs-1 "From")
+       (message-idna-to-ascii-rhs-1 "To")
+       (message-idna-to-ascii-rhs-1 "Cc")))))
+
 (defun message-generate-headers (headers)
   "Prepare article HEADERS.
 Headers already prepared in the buffer are not modified."
@@ -5175,6 +5387,7 @@ Headers already prepared in the buffer are not modified."
           (User-Agent (message-make-user-agent))
           (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))
@@ -5196,7 +5409,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
@@ -5212,7 +5426,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
@@ -5269,9 +5483,12 @@ Headers already prepared in the buffer are not modified."
                ;; 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)
-               (when (bolp)
-                 (delete-char -1)))
+               ;; If the header is optional, and the header was
+               ;; empty, we can't insert it anyway.
+               (unless optionalp
+                 (insert value)
+                 (when (bolp)
+                   (delete-char -1))))
              ;; Add the deletable property to the headers that require it.
              (and (memq header message-deletable-headers)
                   (progn (beginning-of-line) (looking-at "[^:]+: "))
@@ -5302,7 +5519,9 @@ Headers already prepared in the buffer are not modified."
            (beginning-of-line))
          (when (or (message-news-p)
                    (string-match "@.+\\.." secure-sender))
-           (insert "Sender: " secure-sender "\n")))))))
+           (insert "Sender: " secure-sender "\n"))))
+      ;; Check for IDNA
+      (message-idna-to-ascii-rhs))))
 
 (defun message-insert-courtesy-copy ()
   "Insert a courtesy message in mail copies of combined messages."
@@ -5361,6 +5580,16 @@ Headers already prepared in the buffer are not modified."
           (if (consp value) (car value) value))
          "\n"))
 
+(defun message-split-line ()
+  "Split current line, moving portion beyond point vertically down.
+If the current line has `message-yank-prefix', insert it on the new line."
+  (interactive "*")
+  (condition-case nil
+      (split-line message-yank-prefix) ;; Emacs 21.3.50+ supports arg.
+    (error
+     (split-line))))
+     
+
 (defun message-fill-header (header value)
   (let ((begin (point))
        (fill-column 78)
@@ -6373,6 +6602,20 @@ the list of newsgroups is was posted to."
                "(nowhere)"))
          "] " subject))
 
+(defun message-forward-subject-name-subject (subject)
+  "Generate a SUBJECT for a forwarded message.
+The form is: [Source] Subject, where if the original message was mail,
+Source is the name of the sender, and if the original message was
+news, Source is the list of newsgroups is was posted to."
+  (concat "["
+         (let ((prefix (message-fetch-field "newsgroups")))
+           (or prefix
+               (and (setq prefix (message-fetch-field "from"))
+                    (car (std11-extract-address-components
+                          (nnheader-decode-from prefix))))
+               "(nowhere)"))
+         "] " subject))
+
 (defun message-forward-subject-fwd (subject)
   "Generate a SUBJECT for a forwarded message.
 The form is: Fwd: Subject, where Subject is the original subject of
@@ -6479,15 +6722,17 @@ Optional NEWS will use news to forward instead of mail."
       ;; We first set up a normal mail buffer.
       (unless (message-mail-user-agent)
        (set-buffer (get-buffer-create " *message resend*"))
-       (erase-buffer)
-       (let ((message-this-is-mail t)
-             ;; avoid to turn-on-mime-edit
-             message-setup-hook)
-         (message-setup `((To . ,address)))))
+       (erase-buffer))
+      (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-"))
@@ -6668,6 +6913,9 @@ which specify the range to operate on."
            (delete-char -2))))))
 
 (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
+(defalias 'message-make-overlay 'make-overlay)
+(defalias 'message-delete-overlay 'delete-overlay)
+(defalias 'message-overlay-put 'overlay-put)
 
 ;; Support for toolbar
 (eval-when-compile
@@ -6707,6 +6955,9 @@ which specify the range to operate on."
 ;;             tool-bar-map mime-edit-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
+;;             'mime-edit-preview-message "preview"
+;;             tool-bar-map mime-edit-mode-map)
               (message-tool-bar-local-item-from-menu
                'message-insert-importance-high "important"
                tool-bar-map message-mode-map)
@@ -7039,6 +7290,39 @@ regexp varstr."
                             (if (and (or to cc) bcc) ", ")
                             (or bcc "")))))))
 
+(defun message-hide-headers ()
+  "Hide headers based on the `message-hidden-headers' variable."
+  (let ((regexps (if (stringp message-hidden-headers)
+                    (list message-hidden-headers)
+                  message-hidden-headers))
+       (inhibit-point-motion-hooks t)
+       (after-change-functions nil))
+    (when regexps
+      (save-excursion
+       (save-restriction
+         (message-narrow-to-headers)
+         (goto-char (point-min))
+         (while (not (eobp))
+           (if (not (message-hide-header-p regexps))
+               (message-next-header)
+             (let ((begin (point)))
+               (message-next-header)
+               (add-text-properties begin (point)
+                                    '(intangible t invisible t
+                                                 message-hidden t))))))))))
+
+(defun message-hide-header-p (regexps)
+  (let ((result nil)
+       (reverse nil))
+    (when (eq (car regexps) 'not)
+      (setq reverse t)
+      (pop regexps))
+    (dolist (regexp regexps)
+      (setq result (or result (looking-at regexp))))
+    (if reverse
+       (not result)
+      result)))
+
 (when (featurep 'xemacs)
   (require 'messagexmas)
   (message-xmas-redefine))