Import Gnus v5.10.2.

[elisp/gnus.git-] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 8e9882d..1dc96a2 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -144,7 +144,8 @@ If this variable is nil, no such courtesy message will be added."
   :group 'message-sending
   :type 'string)
 
   :group 'message-sending
   :type 'string)
 

-(defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
+(defcustom message-ignored-bounced-headers
+  "^\\(Received\\|Return-Path\\|Delivered-To\\):"

   "*Regexp that matches headers to be removed in resent bounced mail."
   :group 'message-interface
   :type 'regexp)
   "*Regexp that matches headers to be removed in resent bounced mail."
   :group 'message-interface
   :type 'regexp)

@@ -193,7 +194,8 @@ Checks include `subject-cmsg', `multiple-headers', `sendsys',
   :group 'message-news
   :type '(repeat sexp))                        ; Fixme: improve this
 
   :group 'message-news
   :type '(repeat sexp))                        ; Fixme: improve this
 

-(defcustom message-required-headers '((optional . References) From)
+(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
 `message-required-mail-headers'."
   "*Headers to be generated or prompted for when sending a message.
 Also see `message-required-news-headers' and
 `message-required-mail-headers'."

@@ -302,6 +304,8 @@ few false positives here."
   :group 'message-various
   :type 'regexp)
 
   :group 'message-various
   :type 'regexp)
 

+;; Fixme: Why are all these things autoloaded?
+

 ;;; marking inserted text
 
 ;;;###autoload
 ;;; marking inserted text
 
 ;;;###autoload

@@ -432,7 +436,7 @@ If t, use `message-user-organization-file'."
   :group 'message-headers)
 
 (defcustom message-make-forward-subject-function
   :group 'message-headers)
 
 (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.
   "*List of functions called to generate subject headers for forwarded messages.
 The subject generated by the previous function is passed into each
 successive function.

@@ -441,6 +445,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-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
 * `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended
       to it."
   :group 'message-forwarding

@@ -636,6 +642,15 @@ Doing so would be even more evil than leaving it out."
   :group 'message-sending
   :type 'boolean)
 
   :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."
 ;; qmail-related stuff
 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
   "Location of the qmail-inject program."

@@ -679,7 +694,11 @@ variable isn't used."
   ;; create a dependence to `gnus.el'.
   :type 'sexp)
 
   ;; create a dependence to `gnus.el'.
   :type 'sexp)
 

-(defcustom message-generate-headers-first nil
+;; FIXME: This should be a temporary workaround until someone implements a
+;; proper solution.  If a crash happens while replying, the auto-save file
+;; will *not* have a `References:' header if `message-generate-headers-first'
+;; is nil.  See: http://article.gmane.org/gmane.emacs.gnus.general/51138
+(defcustom message-generate-headers-first '(references)

   "*If non-nil, generate all required headers before composing.
 The variables `message-required-news-headers' and
 `message-required-mail-headers' specify which headers to generate.
   "*If non-nil, generate all required headers before composing.
 The variables `message-required-news-headers' and
 `message-required-mail-headers' specify which headers to generate.

@@ -691,6 +710,7 @@ 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 '(choice (const :tag "None" nil)
 will not have a visible effect for those headers."
   :group 'message-headers
   :type '(choice (const :tag "None" nil)

+                 (const :tag "References" '(references))

                  (const :tag "All" t)
                  (repeat (sexp :tag "Header"))))
 
                  (const :tag "All" t)
                  (repeat (sexp :tag "Header"))))
 

@@ -973,6 +993,13 @@ candidates:
   (or (not (listp message-shoot-gnksa-feet))
       (memq feature message-shoot-gnksa-feet)))
 
   (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.
 
 ;;; Internal variables.
 ;;; Well, not really internal.
 

@@ -1273,6 +1300,22 @@ no, only reply back to the author."
   :group 'message-headers
   :type 'boolean)
 
   :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))
+                                (mm-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...")
 ;;; Internal variables.
 
 (defvar message-sending-message "Sending...")

@@ -1319,7 +1362,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.
      ;; 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
 
      ;; The time the message was sent.
      "\\([^\0-\r \^?]+\\) +"           ; day of the week

@@ -1381,6 +1424,19 @@ no, only reply back to the author."
 (defvar message-bogus-system-names "^localhost\\."
   "The regexp of bogus system names.")
 
 (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")
 (eval-and-compile
   (autoload 'message-setup-toolbar "messagexmas")
   (autoload 'mh-new-draft-name "mh-comp")

@@ -1399,7 +1455,8 @@ no, only reply back to the author."
   (autoload 'gnus-group-name-decode "gnus-group")
   (autoload 'gnus-groups-from-server "gnus")
   (autoload 'rmail-output "rmailout")
   (autoload 'gnus-group-name-decode "gnus-group")
   (autoload 'gnus-groups-from-server "gnus")
   (autoload 'rmail-output "rmailout")

-  (autoload 'gnus-delay-article "gnus-delay"))
+  (autoload 'gnus-delay-article "gnus-delay")
+  (autoload 'gnus-make-local-hook "gnus-util"))

 
 \f
 
 
 \f
 

@@ -1439,8 +1496,8 @@ is used by default."
          (beg 1)
          (first t)
          quoted elems paren)
          (beg 1)
          (first t)
          quoted elems paren)

-      (save-excursion
-       (message-set-work-buffer)
+      (with-temp-buffer
+       (mm-enable-multibyte)

        (insert header)
        (goto-char (point-min))
        (while (not (eobp))
        (insert header)
        (goto-char (point-min))
        (while (not (eobp))

@@ -1533,15 +1590,6 @@ is used by default."
       (mail-narrow-to-head)
       (message-fetch-field header))))
 
       (mail-narrow-to-head)
       (message-fetch-field header))))
 

-(defun message-set-work-buffer ()
-  (if (get-buffer " *message work*")
-      (progn
-       (set-buffer " *message work*")
-       (erase-buffer))
-    (set-buffer (get-buffer-create " *message work*"))
-    (kill-all-local-variables)
-    (mm-enable-multibyte)))
-

 (defun message-functionp (form)
   "Return non-nil if FORM is funcallable."
   (or (and (symbolp form) (fboundp form))
 (defun message-functionp (form)
   "Return non-nil if FORM is funcallable."
   (or (and (symbolp form) (fboundp form))

@@ -1711,7 +1759,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)
              (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
   (end-of-line) ; ensure Followup: comes after Newsgroups:
   ;; unless new followup would be identical to Newsgroups line
   ;; make a new Followup-To line

@@ -2052,6 +2100,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 "\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-c\C-a" 'mml-attach-file)
 
 
   (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
 

@@ -2144,6 +2193,7 @@ Point is left at the beginning of the narrowed-to region."
     ["Reduce To: to Cc:" message-reduce-to-to-cc t]
     "----"
     ["Sort Headers" message-sort-headers t]
     ["Reduce To: to Cc:" message-reduce-to-to-cc 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]))
 
     ["Goto Body" message-goto-body t]
     ["Goto Signature" message-goto-signature t]))
 

@@ -2175,7 +2225,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'.
   ;; 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:
          mouse-face nil modification-hooks nil insert-in-front-hooks nil
          insert-behind-hooks nil point-entered nil point-left nil)
   ;; Other special properties:

@@ -2206,7 +2256,11 @@ 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))
 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)))
+    (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"
 
 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"

@@ -2270,6 +2324,11 @@ 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 'message-checksum) nil)
   (set (make-local-variable 'message-mime-part) 0)
   (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)
   ;; Allow using comment commands to add/remove quoting.
   (set (make-local-variable 'comment-start) message-yank-prefix)
   (if (featurep 'xemacs)

@@ -2280,9 +2339,7 @@ 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)
        (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)
+  (gnus-make-local-hook 'after-change-functions)

   ;; Mmmm... Forbidden properties...
   (add-hook 'after-change-functions 'message-strip-forbidden-properties
            nil 'local)
   ;; Mmmm... Forbidden properties...
   (add-hook 'after-change-functions 'message-strip-forbidden-properties
            nil 'local)

@@ -2562,7 +2619,7 @@ With the prefix argument FORCE, insert the header anyway."
   (let ((point (point)))
     (message-goto-signature)
     (unless (eobp)
   (let ((point (point)))
     (message-goto-signature)
     (unless (eobp)

-      (forward-line -2))
+      (end-of-line -1))

     (kill-region point (point))
     (unless (bolp)
       (insert "\n"))))
     (kill-region point (point))
     (unless (bolp)
       (insert "\n"))))

@@ -2645,6 +2702,7 @@ Prefix arg means justify as well."
        (delete-region (point) (re-search-forward "[ \t]*"))
        (when (and quoted (not bolp))
          (insert quoted leading-space)))
        (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)))
       (if quoted
          (let* ((adaptive-fill-regexp
                  (regexp-quote (concat quoted leading-space)))

@@ -2657,7 +2715,7 @@ Prefix arg means justify as well."
 (defun message-fill-paragraph (&optional arg)
   "Like `fill-paragraph'."
   (interactive (list (if current-prefix-arg 'full)))
 (defun message-fill-paragraph (&optional arg)
   "Like `fill-paragraph'."
   (interactive (list (if current-prefix-arg 'full)))

-  (if (and (boundp 'filladapt-mode) filladapt-mode)
+  (if (if (boundp 'filladapt-mode) filladapt-mode)

       nil
     (message-newline-and-reformat arg t)
     t))
       nil
     (message-newline-and-reformat arg t)
     t))

@@ -3226,14 +3284,22 @@ It should typically alter the sending method in some way or other."
   (goto-char (point-max))
   (unless (bolp)
     (insert "\n"))
   (goto-char (point-max))
   (unless (bolp)
     (insert "\n"))

-  ;; Delete all invisible text.
+  ;; 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)))))
+  ;; Make invisible text visible.

   (message-check 'invisible-text
     (let ((points (message-text-with-property 'invisible)))
       (when points
        (goto-char (car points))
        (dolist (point points)
          (add-text-properties point (1+ point)
   (message-check 'invisible-text
     (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)))
+                              '(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")))))
        (unless (yes-or-no-p
                 "Invisible text found and made visible; continue posting? ")
          (error "Invisible text found and made visible")))))

@@ -3248,14 +3314,15 @@ It should typically alter the sending method in some way or other."
                         (memq (char-charset char)
                               '(eight-bit-control eight-bit-graphic
                                                   control-1)))))
                         (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
          (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")
               '((?d "Remove and continue posting")
                 (?r "Replace with dots and continue posting")
                 (?i "Ignore and continue posting")

@@ -3272,10 +3339,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)
                                 '(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)
              (delete-char 1)

-             (if (eq choice ?r)
-                 (insert "."))))
+             (when (eq choice ?r)
+               (insert "."))))

          (forward-char)
          (skip-chars-forward mm-7bit-chars))))))
 
          (forward-char)
          (skip-chars-forward mm-7bit-chars))))))
 

@@ -3355,7 +3423,7 @@ It should typically alter the sending method in some way or other."
              (message-remove-header "Lines")
              (goto-char (point-max))
              (insert "Mime-Version: 1.0\n")
              (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))
            (goto-char (point-max))
            (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n"
                            id n total))

@@ -3436,6 +3504,7 @@ It should typically alter the sending method in some way or other."
                (message-narrow-to-headers)
                (and news
                     (or (message-fetch-field "cc")
                (message-narrow-to-headers)
                (and news
                     (or (message-fetch-field "cc")

+                        (message-fetch-field "bcc")

                         (message-fetch-field "to"))
                     (let ((content-type (message-fetch-field "content-type")))
                       (or
                         (message-fetch-field "to"))
                     (let ((content-type (message-fetch-field "content-type")))
                       (or

@@ -3467,7 +3536,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
 
 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...")
 ")))
              (mm-with-unibyte-current-buffer
                (message "Sending via mail...")

@@ -3523,7 +3592,7 @@ If you always want Gnus to send messages in one piece, set
                        ;; But some systems are more broken with -f, so
                        ;; we'll let users override this.
                        (if (null message-sendmail-f-is-evil)
                        ;; 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"))
                        ;; These mean "report errors by mail"
                        ;; and "deliver in background".
                        (if (null message-interactive) '("-oem" "-odb"))

@@ -3545,7 +3614,7 @@ If you always want Gnus to send messages in one piece, set
                (replace-match "; "))
              (if (not (zerop (buffer-size)))
                  (error "Sending...failed to %s"
                (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)))))
 
       (when (bufferp errbuf)
        (kill-buffer errbuf)))))
 

@@ -3852,7 +3921,7 @@ Otherwise, generate and save a value for `canlock-password' first."
                    (length
                     (setq to (completing-read
                               "Followups to (default: no Followup-To header) "
                    (length
                     (setq to (completing-read
                               "Followups to (default: no Followup-To header) "

-                              (mapcar (lambda (g) (list g))
+                              (mapcar #'list

                                       (cons "poster"
                                             (message-tokenize-header
                                              newsgroups)))))))))
                                       (cons "poster"
                                             (message-tokenize-header
                                              newsgroups)))))))))

@@ -3862,7 +3931,7 @@ Otherwise, generate and save a value for `canlock-password' first."
    ;; Check "Shoot me".
    (message-check 'shoot
      (if (re-search-forward
    ;; 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.
         (y-or-n-p "You appear to have a misconfigured system.  Really post? ")
        t))
    ;; Check for Approved.

@@ -3915,8 +3984,9 @@ Otherwise, generate and save a value for `canlock-password' first."
                     (gnus-groups-from-server method)))
            errors)
        (while groups
                     (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
           (push (car groups) errors))
         (pop groups))
        (cond

@@ -3931,7 +4001,7 @@ Otherwise, generate and save a value for `canlock-password' first."
              errors)
         (y-or-n-p
          (format
              errors)
         (y-or-n-p
          (format

-          "Really post to %s possibly unknown group%s: %s? "
+          "Really use %s possibly unknown group%s: %s? "

           (if (= (length errors) 1) "this" "these")
           (if (= (length errors) 1) "" "s")
           (mapconcat 'identity errors ", "))))
           (if (= (length errors) 1) "this" "these")
           (if (= (length errors) 1) "" "s")
           (mapconcat 'identity errors ", "))))

@@ -4313,9 +4383,9 @@ If NOW, use that time instead."
                               (lsh (% message-unique-id-char 25) 16)) 4)
      (message-number-base36 (+ (nth 1 tm)
                               (lsh (/ message-unique-id-char 25) 16)) 4)
                               (lsh (% message-unique-id-char 25) 16)) 4)
      (message-number-base36 (+ (nth 1 tm)
                               (lsh (/ message-unique-id-char 25) 16)) 4)

-     ;; Append the newsreader name, because while the generated
-     ;; ID is unique to this newsreader, other newsreaders might
-     ;; otherwise generate the same ID via another algorithm.
+     ;; Append a given name, because while the generated ID is unique
+     ;; to this newsreader, other newsreaders might otherwise generate
+     ;; the same ID via another algorithm.

      ".fsf")))
 
 (defun message-number-base36 (num len)
      ".fsf")))
 
 (defun message-number-base36 (num len)

@@ -4334,8 +4404,8 @@ If NOW, use that time instead."
            (if (message-functionp message-user-organization)
                (funcall message-user-organization)
              message-user-organization))))
            (if (message-functionp message-user-organization)
                (funcall message-user-organization)
              message-user-organization))))

-    (save-excursion
-      (message-set-work-buffer)
+    (with-temp-buffer
+      (mm-enable-multibyte)

       (cond ((stringp organization)
             (insert organization))
            ((and (eq t organization)
       (cond ((stringp organization)
             (insert organization))
            ((and (eq t organization)

@@ -4374,12 +4444,10 @@ If NOW, use that time instead."
          (date (mail-header-date message-reply-headers))
          (msg-id (mail-header-message-id message-reply-headers)))
       (when from
          (date (mail-header-date message-reply-headers))
          (msg-id (mail-header-message-id message-reply-headers)))
       (when from

-       (let ((stop-pos
-              (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
+       (let ((name (mail-extract-address-components from)))

          (concat msg-id (if msg-id " (")
          (concat msg-id (if msg-id " (")

-                 (if (and stop-pos
-                          (not (zerop stop-pos)))
-                     (substring from 0 stop-pos) from)
+                 (or (car name)
+                     (nth 1 name))

                  "'s message of \""
                  (if (or (not date) (string= date ""))
                      "(unknown date)" date)
                  "'s message of \""
                  (if (or (not date) (string= date ""))
                      "(unknown date)" date)

@@ -4421,8 +4489,8 @@ If NOW, use that time instead."
              (user-full-name))))
     (when (string= fullname "&")
       (setq fullname (user-login-name)))
              (user-full-name))))
     (when (string= fullname "&")
       (setq fullname (user-login-name)))

-    (save-excursion
-      (message-set-work-buffer)
+    (with-temp-buffer
+      (mm-enable-multibyte)

       (cond
        ((or (null style)
            (equal fullname ""))
       (cond
        ((or (null style)
            (equal fullname ""))

@@ -4473,30 +4541,53 @@ give as trustworthy answer as possible."
 
 (defun message-user-mail-address ()
   "Return the pertinent part of `user-mail-address'."
 
 (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 (mail-extract-address-components user-mail-address))
       user-mail-address)))
 
     (if (string-match " " user-mail-address)
        (nth 1 (mail-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."
 (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
     (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)
           (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.
       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")))))
      ;; Default to this bogus thing.
      (t
       (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me")))))

@@ -4568,6 +4659,70 @@ subscribed address (and not the additional To and Cc header contents)."
              list
            msg-recipients))))))
 
              list
            msg-recipients))))))
 

+(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."
 (defun message-generate-headers (headers)
   "Prepare article HEADERS.
 Headers already prepared in the buffer are not modified."

@@ -4719,7 +4874,9 @@ Headers already prepared in the buffer are not modified."
            (beginning-of-line))
          (when (or (message-news-p)
                    (string-match "@.+\\.." secure-sender))
            (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."
 
 (defun message-insert-courtesy-copy ()
   "Insert a courtesy message in mail copies of combined messages."

@@ -4772,6 +4929,16 @@ Headers already prepared in the buffer are not modified."
     (widen)
     (forward-line 1)))
 
     (widen)
     (forward-line 1)))
 

+(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)
 (defun message-fill-header (header value)
   (let ((begin (point))
        (fill-column 78)

@@ -5086,6 +5253,10 @@ are not included."
     (when message-default-mail-headers
       (insert message-default-mail-headers)
       (or (bolp) (insert ?\n)))
     (when message-default-mail-headers
       (insert message-default-mail-headers)
       (or (bolp) (insert ?\n)))

+    (save-restriction
+      (message-narrow-to-headers)
+      (if message-alternative-emails
+         (message-use-alternative-email-as-from)))

     (when message-generate-headers-first
       (message-generate-headers
        (message-headers-to-generate
     (when message-generate-headers-first
       (message-generate-headers
        (message-headers-to-generate

@@ -5097,8 +5268,6 @@ are not included."
   (message-insert-signature)
   (save-restriction
     (message-narrow-to-headers)
   (message-insert-signature)
   (save-restriction
     (message-narrow-to-headers)

-    (if message-alternative-emails
-       (message-use-alternative-email-as-from))

     (run-hooks 'message-header-setup-hook))
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
     (run-hooks 'message-header-setup-hook))
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)

@@ -5675,6 +5844,23 @@ the list of newsgroups is was posted to."
              (mail-decode-encoded-word-string prefix)))
          "] " subject))
 
              (mail-decode-encoded-word-string prefix)))
          "] " 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
+                (or (message-fetch-field "newsgroups")
+                    (let ((from (message-fetch-field "from")))
+                      (and from
+                           (cdr (mail-header-parse-address from))))
+                    "(nowhere)")))
+           (if message-forward-decoded-p
+               prefix
+             (mail-decode-encoded-word-string prefix)))
+         "] " 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
 (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

@@ -5752,11 +5938,11 @@ Optional DIGEST will use digest to forward."
               (not message-forward-decoded-p))
          (insert
           (with-temp-buffer
               (not message-forward-decoded-p))
          (insert
           (with-temp-buffer

-            (mm-disable-multibyte-mule4)
+            (mm-disable-multibyte)

             (insert
              (with-current-buffer forward-buffer
             (insert
              (with-current-buffer forward-buffer

-               (mm-with-unibyte-current-buffer-mule4 (buffer-string))))
-            (mm-enable-multibyte-mule4)
+               (mm-with-unibyte-current-buffer (buffer-string))))
+            (mm-enable-multibyte)

             (mime-to-mml)
             (goto-char (point-min))
             (when (looking-at "From ")
             (mime-to-mml)
             (goto-char (point-min))
             (when (looking-at "From ")

@@ -5827,12 +6013,16 @@ Optional DIGEST will use digest to forward."
       (unless (message-mail-user-agent)
        (set-buffer (get-buffer-create " *message resend*"))
        (erase-buffer))
       (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)
        (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-*".
       ;; Rename them all to "Resent-*".

+      (goto-char (point-min))

       (while (re-search-forward "^[A-Za-z]" nil t)
        (forward-char -1)
        (insert "Resent-"))
       (while (re-search-forward "^[A-Za-z]" nil t)
        (forward-char -1)
        (insert "Resent-"))

@@ -6001,6 +6191,9 @@ which specify the range to operate on."
            (delete-char -2))))))
 
 (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
            (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
 
 ;; Support for toolbar
 (eval-when-compile

@@ -6197,11 +6390,6 @@ regexp varstr."
                (cdr local)))))
      locals)))
 
                (cdr local)))))
      locals)))
 

-;;; Miscellaneous functions
-
-(defsubst message-replace-chars-in-string (string from to)
-  (mm-subst-char-in-string from to string))
-

 ;;;
 ;;; MIME functions
 ;;;
 ;;;
 ;;; MIME functions
 ;;;

@@ -6313,6 +6501,39 @@ regexp varstr."
                             (if (and (or to cc) bcc) ", ")
                             (or bcc "")))))))
 
                             (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)
+                '(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))
 (when (featurep 'xemacs)
   (require 'messagexmas)
   (message-xmas-redefine))