Move compiler macros to gnus-clfns.el; load gnus-clfns.el.
[elisp/gnus.git-] / lisp / message.el
index 9a69178..27c419d 100644 (file)
 
 ;;; Code:
 
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl)
-  (require 'smtp)
-  )
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'smtp))
 
 (require 'mailheader)
 (require 'nnheader)
 
 (require 'mailheader)
 (require 'nnheader)
@@ -48,6 +46,7 @@
     (require 'mail-abbrevs)
   (require 'mailabbrev))
 (require 'mime-edit)
     (require 'mail-abbrevs)
   (require 'mailabbrev))
 (require 'mime-edit)
+(eval-when-compile (require 'static))
 
 ;; Avoid byte-compile warnings.
 (eval-when-compile
 
 ;; Avoid byte-compile warnings.
 (eval-when-compile
@@ -192,7 +191,7 @@ Otherwise, most addresses look like `angles', but they look like
   :group 'message-headers)
 
 (defcustom message-syntax-checks nil
   :group 'message-headers)
 
 (defcustom message-syntax-checks nil
-  ; Guess this one shouldn't be easy to customize...
+  ;; Guess this one shouldn't be easy to customize...
   "*Controls what syntax checks should not be performed on outgoing posts.
 To disable checking of long signatures, for instance, add
  `(signature . disabled)' to this list.
   "*Controls what syntax checks should not be performed on outgoing posts.
 To disable checking of long signatures, for instance, add
  `(signature . disabled)' to this list.
@@ -202,7 +201,8 @@ Don't touch this variable unless you really know what you're doing.
 Checks include subject-cmsg multiple-headers sendsys message-id from
 long-lines control-chars size new-text redirected-followup signature
 approved sender empty empty-headers message-id from subject
 Checks include subject-cmsg multiple-headers sendsys message-id from
 long-lines control-chars size new-text redirected-followup signature
 approved sender empty empty-headers message-id from subject
-shorten-followup-to existing-newsgroups buffer-file-name unchanged."
+shorten-followup-to existing-newsgroups buffer-file-name unchanged
+newsgroups."
   :group 'message-news)
 
 (defcustom message-required-news-headers
   :group 'message-news)
 
 (defcustom message-required-news-headers
@@ -311,7 +311,7 @@ is the symbol `guess', try to detect \"Re: \" within an encoded-word."
   :type 'regexp
   :group 'message-various)
 
   :type 'regexp
   :group 'message-various)
 
-(defcustom message-elide-elipsis "\n[...]\n\n"
+(defcustom message-elide-ellipsis "\n[...]\n\n"
   "*The string which is inserted for elided text."
   :type 'string
   :group 'message-various)
   "*The string which is inserted for elided text."
   :type 'string
   :group 'message-various)
@@ -392,7 +392,7 @@ If t, use `message-user-organization-file'."
 
 (defcustom message-make-forward-subject-function
   'message-forward-subject-author-subject
 
 (defcustom message-make-forward-subject-function
   'message-forward-subject-author-subject
- "*A list of functions that are called to generate a subject header for forwarded messages.
+  "*A list of functions that are called to generate a subject header for forwarded messages.
 The subject generated by the previous function is passed into each
 successive function.
 
 The subject generated by the previous function is passed into each
 successive function.
 
@@ -402,9 +402,14 @@ The provided functions are:
       newsgroup)), in brackets followed by the subject
 * message-forward-subject-fwd (Subject of article with 'Fwd:' prepended
       to it."
       newsgroup)), in brackets followed by the subject
 * message-forward-subject-fwd (Subject of article with 'Fwd:' prepended
       to it."
- :group 'message-forwarding
- :type '(radio (function-item message-forward-subject-author-subject)
-              (function-item message-forward-subject-fwd)))
+  :group 'message-forwarding
+  :type '(radio (function-item message-forward-subject-author-subject)
+               (function-item message-forward-subject-fwd)))
+
+(defcustom message-forward-as-mime t
+  "*If non-nil, forward messages as an inline/rfc822 MIME section.  Otherwise, directly inline the old message in the forwarded message."
+  :group 'message-forwarding
+  :type 'boolean)
 
 (defcustom message-wash-forwarded-subjects nil
   "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
 
 (defcustom message-wash-forwarded-subjects nil
   "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
@@ -416,6 +421,12 @@ The provided functions are:
   :group 'message-interface
   :type 'regexp)
 
   :group 'message-interface
   :type 'regexp)
 
+(defcustom message-forward-ignored-headers nil
+  "*All headers that match this regexp will be deleted when forwarding a message."
+  :group 'message-forwarding
+  :type '(choice (const :tag "None" nil)
+                regexp))
+
 (defcustom message-ignored-cited-headers "."
   "*Delete these headers from the messages you yank."
   :group 'message-insertion
 (defcustom message-ignored-cited-headers "."
   "*Delete these headers from the messages you yank."
   :group 'message-insertion
@@ -522,10 +533,9 @@ is never used."
                 (const :tag "always" use)
                 (const :tag "ask" ask)))
 
                 (const :tag "always" use)
                 (const :tag "ask" ask)))
 
-;; stuff relating to broken sendmail in MMDF
 (defcustom message-sendmail-f-is-evil nil
 (defcustom message-sendmail-f-is-evil nil
-  "*Non-nil means that \"-f username\" should not be added to the sendmail
-command line, because it is even more evil than leaving it out."
+  "*Non-nil means that \"-f username\" should not be added to the sendmail command line.
+Doing so would be even more evil than leaving it out."
   :group 'message-sending
   :type 'boolean)
 
   :group 'message-sending
   :type 'boolean)
 
@@ -545,6 +555,11 @@ might set this variable to '(\"-f\" \"you@some.where\")."
   :group 'message-sending
   :type '(repeat string))
 
   :group 'message-sending
   :type '(repeat string))
 
+(defvar message-cater-to-broken-inn t
+  "Non-nil means Gnus should not fold the `References' header.
+Folding `References' makes ancient versions of INN create incorrect
+NOV lines.")
+
 (defvar gnus-post-method)
 (defvar gnus-select-method)
 (defcustom message-post-method
 (defvar gnus-post-method)
 (defvar gnus-select-method)
 (defcustom message-post-method
@@ -604,7 +619,7 @@ The function `message-supersede' runs this hook."
   :group 'message-various
   :type 'hook)
 
   :group 'message-various
   :type 'hook)
 
-(defcustom message-header-hook '(eword-encode-header)
+(defcustom message-header-hook '((lambda () (eword-encode-header t)))
   "Hook run in a message mode buffer narrowed to the headers."
   :group 'message-various
   :type 'hook)
   "Hook run in a message mode buffer narrowed to the headers."
   :group 'message-various
   :type 'hook)
@@ -627,9 +642,21 @@ The function `message-supersede' runs this hook."
   :group 'message-insertion)
 
 (defcustom message-yank-add-new-references t
   :group 'message-insertion)
 
 (defcustom message-yank-add-new-references t
-  "*Non-nil means new IDs will be added to \"References\" field when an
-article is yanked by the command `message-yank-original' interactively."
-  :type 'boolean
+  "Non-nil means new IDs will be added to \"References\" field when an
+article is yanked by the command `message-yank-original' interactively.
+If it is a symbol `message-id-only', only an ID from \"Message-ID\" field
+is used, otherwise IDs extracted from \"References\", \"In-Reply-To\" and
+\"Message-ID\" fields are used."
+  :type '(radio (const :tag "Do not add anything" nil)
+               (const :tag "From Message-Id, References and In-Reply-To fields" t)
+               (const :tag "From only Message-Id field." message-id-only))
+  :group 'message-insertion)
+
+(defcustom message-list-references-add-position nil
+  "Integer value means position for adding to \"References\" field when
+an article is yanked by the command `message-yank-original' interactively."
+  :type '(radio (const :tag "Add to last" nil)
+               (integer :tag "Position from last ID"))
   :group 'message-insertion)
 
 (defcustom message-indentation-spaces 3
   :group 'message-insertion)
 
 (defcustom message-indentation-spaces 3
@@ -646,6 +673,7 @@ Predefined functions include `message-cite-original' and
 Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
   :type '(radio (function-item message-cite-original)
                (function-item message-cite-original-without-signature)
 Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
   :type '(radio (function-item message-cite-original)
                (function-item message-cite-original-without-signature)
+               (function-item mu-cite-original)
                (function-item sc-cite-original)
                (function :tag "Other"))
   :group 'message-insertion)
                (function-item sc-cite-original)
                (function :tag "Other"))
   :group 'message-insertion)
@@ -735,8 +763,7 @@ these lines."
   :type 'message-header-lines)
 
 (defcustom message-default-news-headers ""
   :type 'message-header-lines)
 
 (defcustom message-default-news-headers ""
-  "*A string of header lines to be inserted in outgoing news
-articles."
+  "*A string of header lines to be inserted in outgoing news articles."
   :group 'message-headers
   :group 'message-news
   :type 'message-header-lines)
   :group 'message-headers
   :group 'message-news
   :type 'message-header-lines)
@@ -821,6 +848,13 @@ Valid valued are `unique' and `unsent'."
   :group 'message
   :type 'symbol)
 
   :group 'message
   :type 'symbol)
 
+(defcustom message-dont-reply-to-names rmail-dont-reply-to-names
+  "*A regexp specifying names to prune when doing wide replies.
+A value of nil means exclude your own name only."
+  :group 'message
+  :type '(choice (const :tag "Yourself" nil)
+                regexp))
+
 ;;; Internal variables.
 ;;; Well, not really internal.
 
 ;;; Internal variables.
 ;;; Well, not really internal.
 
@@ -960,10 +994,152 @@ Defaults to `text-mode-abbrev-table'.")
   "Face used for displaying MML."
   :group 'message-faces)
 
   "Face used for displaying MML."
   :group 'message-faces)
 
-(defvar message-font-lock-keywords
-  (let* ((cite-prefix "A-Za-z")
-        (cite-suffix (concat cite-prefix "0-9_.@-"))
-        (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
+(defvar message-font-lock-fence-open-regexp "[+|]"
+  "*Regexp that matches fence open string.")
+
+(defvar message-font-lock-fence-close-regexp "|"
+  "*Regexp that matches fence close string.")
+
+(defvar message-font-lock-fence-open-position nil
+  "*Cons of SYMBOL of a function or a variable and a number of OFFSET that
+indicate the fence open position.  If it is non-nil,
+`message-font-lock-fence-open-regexp' is not used for searching for the
+fence open position.  If SYMBOL is a function, it is called with one argument
+last cursor position and should return the fence open position as a number
+or a marker.  If SYMBOL is a variable symbol, the value is examined with
+`symbol-value'.  OFFSET is added to the position to compensate the value.
+For example, the following combinations of variable symbol and offset value
+can be used:
+
+Egg v3: '(egg:*region-start* . -1)
+Canna:  '(canna:*region-start* . 0)
+")
+
+(defvar message-font-lock-fence-close-position nil
+  "*Cons of SYMBOL of a function or a variable and a number of OFFSET that
+indicate the fence close position.  If it is non-nil,
+`message-font-lock-fence-close-regexp' is not used for searching for the
+fence close position.  If SYMBOL is a function, it is called with one argument
+last cursor position and should return the fence close position as a number
+or a marker.  If SYMBOL is a variable symbol, the value is examined with
+`symbol-value'.  OFFSET is added to the position to compensate the value.
+For example, the following combinations of variable symbol and offset value
+can be used:
+
+Egg v3: '(egg:*region-end* . 0)
+Canna:  '(canna:*region-end* . 0)
+")
+
+(defvar message-font-lock-cited-text-regexp
+  "^[\t ]*\\([^\000- :>|}\177]*\\)[:>|}].*"
+  "*Regexp that matches cited text.  It should have a grouping for the
+citation prefix which is ended at the beginning of citation mark string.")
+
+(defvar message-font-lock-citation-name-max-column 10
+  "*Maximun number of column for citation name for fontifying.")
+
+(defvar message-font-lock-last-position nil
+  "Internal buffer local variable to save the last cursor position
+before fontifying.")
+
+(eval-after-load "font-lock"
+  '(defadvice font-lock-after-change-function
+     (before message-font-lock-save-last-position activate)
+     "Save last cursor position before fontifying."
+     (if (eq 'message-mode major-mode)
+        (setq message-font-lock-last-position (point)))))
+
+(defun message-font-lock-cited-text-matcher (limit)
+  "Search for a cited text containing `message-font-lock-cited-text-regexp'
+forward.  Argument LIMIT bounds the search.  If a cited text is found, it
+returns t and sets match data 1 and 2, otherwise it returns nil.  Normally,
+match data 2 has zero length, but if the FENCE (for input method) is detected
+in matched text, result is divided into match data 1 and 2 across the FENCE.
+See also the documentations for the following variables:
+ `message-font-lock-fence-open-regexp'
+ `message-font-lock-fence-close-regexp'
+ `message-font-lock-fence-open-position'
+ `message-font-lock-fence-close-position'
+"
+  (prog1
+      (when (re-search-forward message-font-lock-cited-text-regexp limit t)
+       (let* ((start0 (match-beginning 0))
+              (end0 (match-end 0))
+              (cite-mark (match-end 1))
+              (should-fontify
+               (progn
+                 (goto-char cite-mark)
+                 (<= (current-column)
+                     message-font-lock-citation-name-max-column)))
+              end1 start2)
+         (and
+          should-fontify
+          message-font-lock-last-position
+          (>= message-font-lock-last-position start0)
+          (<= message-font-lock-last-position end0)
+          (cond
+           (message-font-lock-fence-open-position
+            (let* ((symbol (car message-font-lock-fence-open-position))
+                   (open
+                    (cond ((functionp symbol)
+                           (funcall symbol message-font-lock-last-position))
+                          ((and (symbolp symbol)
+                                (boundp symbol))
+                           (symbol-value symbol)))))
+              (when (markerp open)
+                (setq open (marker-position open)))
+              (and (numberp open)
+                   (setq open
+                         (+ open
+                            (cdr message-font-lock-fence-open-position)))
+                   (>= message-font-lock-last-position open)
+                   (goto-char open)
+                   (or (not message-font-lock-fence-open-regexp)
+                       (looking-at message-font-lock-fence-open-regexp))
+                   (setq end1 open))))
+           (message-font-lock-fence-open-regexp
+            (goto-char message-font-lock-last-position)
+            (when (re-search-backward
+                   message-font-lock-fence-open-regexp start0 t)
+              (setq end1 (match-beginning 0)))))
+          (setq should-fontify
+                (and message-font-lock-fence-open-position
+                     (not (eq cite-mark end1))))
+          (cond
+           (message-font-lock-fence-close-position
+            (let* ((symbol (car message-font-lock-fence-close-position))
+                   (close
+                    (cond ((functionp symbol)
+                           (funcall symbol message-font-lock-last-position))
+                          ((and (symbolp symbol)
+                                (boundp symbol))
+                           (symbol-value symbol)))))
+              (when (markerp close)
+                (setq close (marker-position close)))
+              (and (numberp close)
+                   (setq close
+                         (+ close
+                            (cdr message-font-lock-fence-close-position)))
+                   (<= message-font-lock-last-position close)
+                   (setq start2 close))))
+           (message-font-lock-fence-close-regexp
+            (goto-char message-font-lock-last-position)
+            (when (looking-at message-font-lock-fence-close-regexp)
+              (setq start2 (match-end 0)))))
+          (setq should-fontify
+                (and (not (and (not message-font-lock-fence-open-position)
+                               (eq cite-mark end1)))
+                     (not (eq cite-mark start2)))))
+         (goto-char end0)
+         (when should-fontify
+           (if start2
+               (store-match-data (list start0 end0 start0 end1 start2 end0))
+             (store-match-data (list start0 end0 start0 end0 end0 end0)))
+           t)))
+    (setq message-font-lock-last-position nil)))
+
+(defvar message-font-lock-keywords-1
+  (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
     `((,(concat "^\\([Tt]o:\\)" content)
        (1 'message-header-name-face)
        (2 'message-header-to-face nil t))
     `((,(concat "^\\([Tt]o:\\)" content)
        (1 'message-header-name-face)
        (2 'message-header-to-face nil t))
@@ -989,18 +1165,27 @@ Defaults to `text-mode-abbrev-table'.")
                 (not (equal mail-header-separator "")))
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
               1 'message-separator-face))
                 (not (equal mail-header-separator "")))
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
               1 'message-separator-face))
-         nil)
-      (,(concat "^[ \t]*"
-               "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
-               "[:>|}].*")
-       (0 'message-cited-text-face))
-      ("<#/?\\(multipart\\|part\\|external\\).*>"
-       (0 'message-mml-face))))
+         nil))))
+
+(defvar message-font-lock-keywords-2
+  (append message-font-lock-keywords-1
+         '((message-font-lock-cited-text-matcher
+            (1 'message-cited-text-face)
+            (2 'message-cited-text-face))
+           ("<#/?\\(multipart\\|part\\|external\\).*>"
+            (0 'message-mml-face)))))
+
+(defvar message-font-lock-keywords message-font-lock-keywords-2
   "Additional expressions to highlight in Message mode.")
 
 ;; XEmacs does it like this.  For Emacs, we have to set the
 ;; `font-lock-defaults' buffer-local variable.
   "Additional expressions to highlight in Message mode.")
 
 ;; XEmacs does it like this.  For Emacs, we have to set the
 ;; `font-lock-defaults' buffer-local variable.
-(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
+(put 'message-mode 'font-lock-defaults
+     '((message-font-lock-keywords
+       message-font-lock-keywords-1
+       message-font-lock-keywords-2)
+       nil nil nil nil
+       (font-lock-mark-block-function . mark-paragraph)))
 
 (defvar message-face-alist
   '((bold . bold-region)
 
 (defvar message-face-alist
   '((bold . bold-region)
@@ -1046,8 +1231,11 @@ The cdr of ech entry is a function for applying the face to a region.")
 
 (defvar message-draft-coding-system
   (cond
 
 (defvar message-draft-coding-system
   (cond
+   ((boundp 'MULE) '*junet*)
    ((not (fboundp 'find-coding-system)) nil)
    ((not (fboundp 'find-coding-system)) nil)
-   ((find-coding-system 'emacs-mule) 'emacs-mule)
+   ((find-coding-system 'emacs-mule)
+    (if (memq system-type '(windows-nt ms-dos ms-windows))
+       'emacs-mule-dos 'emacs-mule))
    ((find-coding-system 'escape-quoted) 'escape-quoted)
    ((find-coding-system 'no-conversion) 'no-conversion)
    (t nil))
    ((find-coding-system 'escape-quoted) 'escape-quoted)
    ((find-coding-system 'no-conversion) 'no-conversion)
    (t nil))
@@ -1100,10 +1288,10 @@ The cdr of ech entry is a function for applying the face to a region.")
      "\\([^\0-\b\n-\r\^?].*\\)? "
 
      ;; The time the message was sent.
      "\\([^\0-\b\n-\r\^?].*\\)? "
 
      ;; The time the message was sent.
-     "\\([^\0-\r \^?]+\\) +"                           ; day of the week
-     "\\([^\0-\r \^?]+\\) +"                           ; month
-     "\\([0-3]?[0-9]\\) +"                             ; day of month
-     "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
+     "\\([^\0-\r \^?]+\\) +"           ; day of the week
+     "\\([^\0-\r \^?]+\\) +"           ; month
+     "\\([0-3]?[0-9]\\) +"             ; day of month
+     "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
 
      ;; Perhaps a time zone, specified by an abbreviation, or by a
      ;; numeric offset.
 
      ;; Perhaps a time zone, specified by an abbreviation, or by a
      ;; numeric offset.
@@ -1128,6 +1316,7 @@ The cdr of ech entry is a function for applying the face to a region.")
          "^ *---+ +Original message +---+ *$\\|"
          "^ *--+ +begin message +--+ *$\\|"
          "^ *---+ +Original message follows +---+ *$\\|"
          "^ *---+ +Original message +---+ *$\\|"
          "^ *--+ +begin message +--+ *$\\|"
          "^ *---+ +Original message follows +---+ *$\\|"
+         "^ *---+ +Undelivered message follows +---+ *$\\|"
          "^|? *---+ +Message text follows: +---+ *|?$")
   "A regexp that matches the separator before the text of a failed message.")
 
          "^|? *---+ +Message text follows: +---+ *|?$")
   "A regexp that matches the separator before the text of a failed message.")
 
@@ -1163,7 +1352,8 @@ The cdr of ech entry is a function for applying the face to a region.")
   (autoload 'gnus-request-post "gnus-int")
   (autoload 'gnus-copy-article-buffer "gnus-msg")
   (autoload 'gnus-alive-p "gnus-util")
   (autoload 'gnus-request-post "gnus-int")
   (autoload 'gnus-copy-article-buffer "gnus-msg")
   (autoload 'gnus-alive-p "gnus-util")
-  (autoload 'rmail-output "rmail"))
+  (autoload 'rmail-output "rmail")
+  (autoload 'mu-cite-original "mu-cite"))
 
 \f
 
 
 \f
 
@@ -1247,7 +1437,7 @@ The cdr of ech entry is a function for applying the face to a region.")
     (when value
       (while (string-match "\n[\t ]+" value)
        (setq value (replace-match " " t t value)))
     (when value
       (while (string-match "\n[\t ]+" value)
        (setq value (replace-match " " t t value)))
-      ;; We remove all text props.delete-region
+      ;; We remove all text props.
       (format "%s" value))))
 
 (defun message-narrow-to-field ()
       (format "%s" value))))
 
 (defun message-narrow-to-field ()
@@ -1271,12 +1461,13 @@ The cdr of ech entry is a function for applying the face to a region.")
       (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
        (error "Invalid header `%s'" (car headers)))
       (setq hclean (match-string 1 (car headers)))
       (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
        (error "Invalid header `%s'" (car headers)))
       (setq hclean (match-string 1 (car headers)))
-    (save-restriction
-      (message-narrow-to-headers)
-      (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
-       (insert (car headers) ?\n))))
+      (save-restriction
+       (message-narrow-to-headers)
+       (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
+         (insert (car headers) ?\n))))
     (setq headers (cdr headers))))
 
     (setq headers (cdr headers))))
 
+
 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (let ((buffer (message-eval-parameter message-reply-buffer)))
 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (let ((buffer (message-eval-parameter message-reply-buffer)))
@@ -1330,11 +1521,14 @@ Return the number of headers removed."
             ;; There might be a continuation header, so we have to search
             ;; until we find a new non-continuation line.
             (progn
             ;; There might be a continuation header, so we have to search
             ;; until we find a new non-continuation line.
             (progn
-              (while (and (zerop (forward-line 1))
-                          (memq (char-after) '(?\t ?\ ))))
-              (point))))
-       (while (and (zerop (forward-line 1))
-                   (memq (char-after) '(?\t ?\ ))))))
+              (forward-line 1)
+              (if (re-search-forward "^[^ \t]" nil t)
+                  (goto-char (match-beginning 0))
+                (point-max)))))
+       (forward-line 1)
+       (if (re-search-forward "^[^ \t]" nil t)
+           (goto-char (match-beginning 0))
+         (goto-char (point-max)))))
     number))
 
 (defun message-remove-first-header (header)
     number))
 
 (defun message-remove-first-header (header)
@@ -1409,9 +1603,11 @@ Point is left at the beginning of the narrowed-to region."
 
 (defun message-next-header ()
   "Go to the beginning of the next header."
 
 (defun message-next-header ()
   "Go to the beginning of the next header."
-  (while (and (zerop (forward-line 1))
-             (memq (char-after) '(?\t ?\ ))))
-  (not (eobp)))
+  (beginning-of-line)
+  (or (eobp) (forward-char 1))
+  (not (if (re-search-forward "^[^ \t]" nil t)
+          (beginning-of-line)
+        (goto-char (point-max)))))
 
 (defun message-sort-headers-1 ()
   "Sort the buffer as headers using `message-rank' text props."
 
 (defun message-sort-headers-1 ()
   "Sort the buffer as headers using `message-rank' text props."
@@ -1478,11 +1674,13 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
   (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
   (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
   (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
   (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
   (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
+  (define-key message-mode-map "\C-c\C-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-n" 'message-insert-newsgroups)
 
   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
 
   (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
 
   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
+  (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
   (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
   (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
@@ -1574,7 +1772,8 @@ C-c C-q  message-fill-yanked-message (fill what was yanked).
 C-c C-e  message-elide-region (elide the text between point and mark).
 C-c C-v  message-delete-not-region (remove the text outside the region).
 C-c C-z  message-kill-to-signature (kill the text up to the signature).
 C-c C-e  message-elide-region (elide the text between point and mark).
 C-c C-v  message-delete-not-region (remove the text outside the region).
 C-c C-z  message-kill-to-signature (kill the text up to the signature).
-C-c C-r  message-caesar-buffer-body (rot13 the message body)."
+C-c C-r  message-caesar-buffer-body (rot13 the message body).
+M-RET    message-newline-and-reformat (break the line and reformat)."
   (interactive)
   (kill-all-local-variables)
   (set (make-local-variable 'message-reply-buffer) nil)
   (interactive)
   (kill-all-local-variables)
   (set (make-local-variable 'message-reply-buffer) nil)
@@ -1637,15 +1836,21 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (message-set-auto-save-file-name)
   (unless (string-match "XEmacs" emacs-version)
     (set (make-local-variable 'font-lock-defaults)
   (message-set-auto-save-file-name)
   (unless (string-match "XEmacs" emacs-version)
     (set (make-local-variable 'font-lock-defaults)
-        '(message-font-lock-keywords t)))
+        '((message-font-lock-keywords
+           message-font-lock-keywords-1
+           message-font-lock-keywords-2)
+          nil nil nil nil
+          (font-lock-mark-block-function . mark-paragraph))))
+  (set (make-local-variable 'message-font-lock-last-position) nil)
   (make-local-variable 'adaptive-fill-regexp)
   (setq adaptive-fill-regexp
   (make-local-variable 'adaptive-fill-regexp)
   (setq adaptive-fill-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp))
+       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
+               adaptive-fill-regexp))
   (unless (boundp 'adaptive-fill-first-line-regexp)
     (setq adaptive-fill-first-line-regexp nil))
   (make-local-variable 'adaptive-fill-first-line-regexp)
   (setq adaptive-fill-first-line-regexp
   (unless (boundp 'adaptive-fill-first-line-regexp)
     (setq adaptive-fill-first-line-regexp nil))
   (make-local-variable 'adaptive-fill-first-line-regexp)
   (setq adaptive-fill-first-line-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|"
+       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
                adaptive-fill-first-line-regexp))
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
   (setq indent-tabs-mode nil)
                adaptive-fill-first-line-regexp))
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
   (setq indent-tabs-mode nil)
@@ -1695,14 +1900,29 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (message-position-on-field "Mail-Reply-To" "Subject"))
 
 (defun message-goto-mail-followup-to ()
   (message-position-on-field "Mail-Reply-To" "Subject"))
 
 (defun message-goto-mail-followup-to ()
-  "Move point to the Mail-Followup-To header."
+  "Move point to the Mail-Followup-To header.  If the header is newly created
+and To field contains only one address, the address is inserted in default."
   (interactive)
   (interactive)
-  (message-position-on-field "Mail-Followup-To" "Subject"))
+  (unless (message-position-on-field "Mail-Followup-To" "Subject")
+    (let ((start (point))
+         addresses)
+      (save-restriction
+       (message-narrow-to-headers)
+       (setq addresses (split-string (mail-strip-quoted-names
+                                      (or (std11-fetch-field "to") ""))
+                                     "[ \f\t\n\r\v,]+"))
+       (when (eq 1 (length addresses))
+         (goto-char start)
+         (insert (car addresses))
+         (goto-char start))))))
 
 (defun message-goto-mail-copies-to ()
 
 (defun message-goto-mail-copies-to ()
-  "Move point to the Mail-Copies-To header."
+  "Move point to the Mail-Copies-To header.  If the header is newly created,
+a string \"never\" is inserted in default."
   (interactive)
   (interactive)
-  (message-position-on-field "Mail-Copies-To" "Subject"))
+  (unless (message-position-on-field "Mail-Copies-To" "Subject")
+    (insert "never")
+    (backward-char 5)))
 
 (defun message-goto-newsgroups ()
   "Move point to the Newsgroups header."
 
 (defun message-goto-newsgroups ()
   "Move point to the Newsgroups header."
@@ -1741,7 +1961,7 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   "Move point to the end of the headers."
   (interactive)
   (message-goto-body)
   "Move point to the end of the headers."
   (interactive)
   (message-goto-body)
-  (forward-line -2))
+  (forward-line -1))
 
 (defun message-goto-signature ()
   "Move point to the beginning of the message signature.
 
 (defun message-goto-signature ()
   "Move point to the beginning of the message signature.
@@ -1819,17 +2039,24 @@ With the prefix argument FORCE, insert the header anyway."
 (defun message-newline-and-reformat ()
   "Insert four newlines, and then reformat if inside quoted text."
   (interactive)
 (defun message-newline-and-reformat ()
   "Insert four newlines, and then reformat if inside quoted text."
   (interactive)
-  (let ((point (point))
-       quoted)
-    (save-excursion
-      (beginning-of-line)
-      (setq quoted (looking-at (regexp-quote message-yank-prefix))))
-    (insert "\n\n\n\n")
+  (let ((prefix "[]>»|:}+ \t]*")
+       (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
+       quoted point)
+    (unless (bolp)
+      (save-excursion
+       (beginning-of-line)
+       (when (looking-at (concat prefix
+                                 supercite-thing))
+         (setq quoted (match-string 0))))
+      (insert "\n"))
+    (setq point (point))
+    (insert "\n\n\n")
+    (delete-region (point) (re-search-forward "[ \t]*"))
     (when quoted
     (when quoted
-      (insert message-yank-prefix))
+      (insert quoted))
     (fill-paragraph nil)
     (goto-char point)
     (fill-paragraph nil)
     (goto-char point)
-    (forward-line 2)))
+    (forward-line 1)))
 
 (defun message-insert-signature (&optional force)
   "Insert a signature.  See documentation for the `message-signature' variable."
 
 (defun message-insert-signature (&optional force)
   "Insert a signature.  See documentation for the `message-signature' variable."
@@ -1870,13 +2097,11 @@ With the prefix argument FORCE, insert the header anyway."
 
 (defun message-elide-region (b e)
   "Elide the text between point and mark.
 
 (defun message-elide-region (b e)
   "Elide the text between point and mark.
-An ellipsis (from `message-elide-elipsis') will be inserted where the
+An ellipsis (from `message-elide-ellipsis') will be inserted where the
 text was killed."
   (interactive "r")
   (kill-region b e)
 text was killed."
   (interactive "r")
   (kill-region b e)
-  (unless (bolp)
-    (insert "\n"))
-  (insert message-elide-elipsis))
+  (insert message-elide-ellipsis))
 
 (defvar message-caesar-translation-table nil)
 
 
 (defvar message-caesar-translation-table nil)
 
@@ -1895,8 +2120,8 @@ text was killed."
     ;; We build the table, if necessary.
     (when (or (not message-caesar-translation-table)
              (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
     ;; We build the table, if necessary.
     (when (or (not message-caesar-translation-table)
              (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
-       (setq message-caesar-translation-table
-             (message-make-caesar-translation-table n)))
+      (setq message-caesar-translation-table
+           (message-make-caesar-translation-table n)))
     ;; Then we translate the region.  Do it this way to retain
     ;; text properties.
     (while (< b e)
     ;; Then we translate the region.  Do it this way to retain
     ;; text properties.
     (while (< b e)
@@ -1943,9 +2168,9 @@ Mail and USENET news headers are not rotated."
         (narrow-to-region (point) (point-max)))
       (let ((body (buffer-substring (point-min) (point-max))))
         (unless (equal 0 (call-process-region
         (narrow-to-region (point) (point-max)))
       (let ((body (buffer-substring (point-min) (point-max))))
         (unless (equal 0 (call-process-region
-                           (point-min) (point-max) program t t))
-            (insert body)
-            (message "%s failed." program))))))
+                         (point-min) (point-max) program t t))
+         (insert body)
+         (message "%s failed" program))))))
 
 (defun message-rename-buffer (&optional enter-string)
   "Rename the *message* buffer to \"*message* RECIPIENT\".
 
 (defun message-rename-buffer (&optional enter-string)
   "Rename the *message* buffer to \"*message* RECIPIENT\".
@@ -1979,7 +2204,7 @@ Numeric argument means justify as well."
     (goto-char (point-min))
     (search-forward (concat "\n" mail-header-separator "\n") nil t)
     (let ((fill-prefix message-yank-prefix))
     (goto-char (point-min))
     (search-forward (concat "\n" mail-header-separator "\n") nil t)
     (let ((fill-prefix message-yank-prefix))
-      (fill-individual-paragraphs (point) (point-max) justifyp t))))
+      (fill-individual-paragraphs (point) (point-max) justifyp))))
 
 (defun message-indent-citation ()
   "Modify text just inserted from a message to be cited.
 
 (defun message-indent-citation ()
   "Modify text just inserted from a message to be cited.
@@ -2030,7 +2255,15 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
 (defun message-list-references (refs-list &rest refs-strs)
   "Add `Message-ID's which appear in REFS-STRS but not in REFS-LIST,
 to REFS-LIST."
 (defun message-list-references (refs-list &rest refs-strs)
   "Add `Message-ID's which appear in REFS-STRS but not in REFS-LIST,
 to REFS-LIST."
-  (let (refs ref id)
+  (let (refs ref id saved-id)
+    (when (and refs-list
+              (integerp message-list-references-add-position))
+      (let ((pos message-list-references-add-position))
+       (while (and refs-list
+                   (> pos 0))
+         (setq saved-id (cons (car refs-list) saved-id)
+               refs-list (cdr refs-list)
+               pos (1- pos)))))
     (while refs-strs
       (setq refs (car refs-strs)
            refs-strs (cdr refs-strs))
     (while refs-strs
       (setq refs (car refs-strs)
            refs-strs (cdr refs-strs))
@@ -2047,6 +2280,9 @@ to REFS-LIST."
                             ">"))
            (or (member id refs-list)
                (push id refs-list))))))
                             ">"))
            (or (member id refs-list)
                (push id refs-list))))))
+    (while saved-id
+      (setq refs-list (cons (car saved-id) refs-list)
+           saved-id (cdr saved-id)))
     refs-list))
 
 (defvar gnus-article-copy)
     refs-list))
 
 (defvar gnus-article-copy)
@@ -2063,7 +2299,8 @@ 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
 
 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."
+be added to \"References\" field.
+\(See also `message-yank-add-new-references'.)"
   (interactive "P")
   (let ((modified (buffer-modified-p))
        (buffer (message-eval-parameter message-reply-buffer))
   (interactive "P")
   (let ((modified (buffer-modified-p))
        (buffer (message-eval-parameter message-reply-buffer))
@@ -2088,8 +2325,10 @@ be added to \"References\" field."
            (std11-narrow-to-header)
            (when (setq refs (message-list-references
                              refs
            (std11-narrow-to-header)
            (when (setq refs (message-list-references
                              refs
-                             (or (message-fetch-field "References")
-                                 (message-fetch-field "In-Reply-To"))
+                             (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")))
              (widen)
              (message-narrow-to-headers)
                              (message-fetch-field "Message-ID")))
              (widen)
              (message-narrow-to-headers)
@@ -2112,6 +2351,24 @@ be added to \"References\" field."
       (unless modified
        (setq message-checksum (message-checksum))))))
 
       (unless modified
        (setq message-checksum (message-checksum))))))
 
+(defun message-yank-buffer (buffer)
+  "Insert BUFFER into the current buffer and quote it."
+  (interactive "bYank buffer: ")
+  (let ((message-reply-buffer buffer))
+    (save-window-excursion
+      (message-yank-original))))
+
+(defun message-buffers ()
+  "Return a list of active message buffers."
+  (let (buffers)
+    (save-excursion
+      (dolist (buffer (buffer-list t))
+       (set-buffer buffer)
+       (when (and (eq major-mode 'message-mode)
+                  (null message-sent-message-via))
+         (push (buffer-name buffer) buffers))))
+    (nreverse buffers)))
+
 (defun message-cite-original-without-signature ()
   "Cite function in the standard Message manner."
   (let ((start (point))
 (defun message-cite-original-without-signature ()
   "Cite function in the standard Message manner."
   (let ((start (point))
@@ -2285,9 +2542,9 @@ The text will also be indented the normal way."
 
 (defun message-delete-frame (frame org-frame)
   "Delete frame for editing message."
 
 (defun message-delete-frame (frame org-frame)
   "Delete frame for editing message."
-  (when (and (or (and (featurep 'xemacs)
-                     (not (eq 'tty (device-type))))
-                window-system
+  (when (and (or (static-if (featurep 'xemacs)
+                    (device-on-window-system-p)
+                  window-system)
                 (>= emacs-major-version 20))
             (or (and (eq message-delete-frame-on-exit t)
                      (select-frame frame)
                 (>= emacs-major-version 20))
             (or (and (eq message-delete-frame-on-exit t)
                      (select-frame frame)
@@ -2314,10 +2571,12 @@ The text will also be indented the normal way."
 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.
 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.
-If `message-interactive' is non-nil, wait for success indication
-or error messages, and inform user.
-Otherwise any failure is reported in a message back to
-the user from the mailer."
+If `message-interactive' is non-nil, wait for success indication or
+error messages, and inform user.
+Otherwise any failure is reported in a message back to the user from
+the mailer.
+The usage of ARG is defined by the instance that called Message.
+It should typically alter the sending method in some way or other."
   (interactive "P")
   ;; Disabled test.
   (when (or (buffer-modified-p)
   (interactive "P")
   ;; Disabled test.
   (when (or (buffer-modified-p)
@@ -2344,20 +2603,20 @@ the user from the mailer."
        (message-fix-before-sending)
        (while (and success
                    (setq elem (pop alist)))
        (message-fix-before-sending)
        (while (and success
                    (setq elem (pop alist)))
-         (when (and (or (not (funcall (cadr elem)))
-                        (and (or (not (memq (car elem)
-                                            message-sent-message-via))
-                                 (y-or-n-p
-                                  (format
-                                   "Already sent message via %s; resend? "
-                                   (car elem))))
-                             (setq success (funcall (caddr elem) arg)))))
+         (when (or (not (funcall (cadr elem)))
+                   (and (or (not (memq (car elem)
+                                       message-sent-message-via))
+                            (y-or-n-p
+                             (format
+                              "Already sent message via %s; resend? "
+                              (car elem))))
+                        (setq success (funcall (caddr elem) arg))))
            (setq sent t))))
            (setq sent t))))
+      (unless (or sent (not success))
+       (error "No methods specified to send by"))
       (prog1
          (when (and success sent)
            (message-do-fcc)
       (prog1
          (when (and success sent)
            (message-do-fcc)
-           ;;(when (fboundp 'mail-hist-put-headers-into-history)
-           ;; (mail-hist-put-headers-into-history))
            (save-excursion
              (run-hooks 'message-sent-hook))
            (message "Sending...done")
            (save-excursion
              (run-hooks 'message-sent-hook))
            (message "Sending...done")
@@ -2470,10 +2729,11 @@ This sub function is for exclusive use of `message-send-mail'."
 
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
 
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
-  (let ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
-       (case-fold-search nil)
-       (news (message-news-p))
-       failure)
+  (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
+        (case-fold-search nil)
+        (news (message-news-p))
+        (message-this-is-mail t)
+        failure)
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -2494,11 +2754,15 @@ This sub function is for exclusive use of `message-send-mail'."
            ;; Remove some headers.
            (save-restriction
              (message-narrow-to-headers)
            ;; Remove some headers.
            (save-restriction
              (message-narrow-to-headers)
+;; We Semi-gnus people have no use for it.
+;;           ;; We (re)generate the Lines header.
+;;           (when (memq 'Lines message-required-mail-headers)
+;;             (message-generate-headers '(Lines)))
              ;; Remove some headers.
              (message-remove-header message-ignored-mail-headers t))
            (goto-char (point-max))
            ;; require one newline at the end.
              ;; Remove some headers.
              (message-remove-header message-ignored-mail-headers t))
            (goto-char (point-max))
            ;; require one newline at the end.
-           (or (bolp)
+           (or (= (preceding-char) ?\n)
                (insert ?\n))
            (when (and news
                       (or (message-fetch-field "cc")
                (insert ?\n))
            (when (and news
                       (or (message-fetch-field "cc")
@@ -2516,7 +2780,7 @@ This sub function is for exclusive use of `message-send-mail'."
 (defun message-send-mail-with-sendmail ()
   "Send off the prepared buffer with sendmail."
   (let ((errbuf (if message-interactive
 (defun message-send-mail-with-sendmail ()
   "Send off the prepared buffer with sendmail."
   (let ((errbuf (if message-interactive
-                   (generate-new-buffer " sendmail errors")
+                   (message-generate-new-buffer-clone-locals " sendmail errors")
                  0))
        resend-to-addresses delimline)
     (let ((case-fold-search t))
                  0))
        resend-to-addresses delimline)
     (let ((case-fold-search t))
@@ -2528,7 +2792,7 @@ This sub function is for exclusive use of `message-send-mail'."
       (re-search-forward
        (concat "^" (regexp-quote mail-header-separator) "\n"))
       (replace-match "\n")
       (re-search-forward
        (concat "^" (regexp-quote mail-header-separator) "\n"))
       (replace-match "\n")
-      (forward-char -1)
+      (backward-char 1)
       (setq delimline (point-marker))
       (run-hooks 'message-send-mail-hook)
       ;; Insert an extra newline if we need it to work around
       (setq delimline (point-marker))
       (run-hooks 'message-send-mail-hook)
       ;; Insert an extra newline if we need it to work around
@@ -2553,7 +2817,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)
                      ;; But some systems are more broken with -f, so
                      ;; we'll let users override this.
                      (if (null message-sendmail-f-is-evil)
-                         (list "-f" (user-login-name)))
+                         (list "-f" (message-make-address)))
                      ;; 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"))
@@ -2586,7 +2850,7 @@ to find out how to use this."
   (re-search-forward
    (concat "^" (regexp-quote mail-header-separator) "\n"))
   (replace-match "\n")
   (re-search-forward
    (concat "^" (regexp-quote mail-header-separator) "\n"))
   (replace-match "\n")
-  (forward-char -1)
+  (backward-char 1)
   (run-hooks 'message-send-mail-hook)
   ;; send the message
   (case
   (run-hooks 'message-send-mail-hook)
   ;; send the message
   (case
@@ -2656,7 +2920,7 @@ to find out how to use this."
     (re-search-forward
      (concat "^" (regexp-quote mail-header-separator) "\n"))
     (replace-match "\n")
     (re-search-forward
      (concat "^" (regexp-quote mail-header-separator) "\n"))
     (replace-match "\n")
-    (forward-char -1)
+    (backward-char 1)
     (run-hooks 'message-send-mail-hook)
     (if recipients
        (let ((result (smtp-via-smtp user-mail-address
     (run-hooks 'message-send-mail-hook)
     (if recipients
        (let ((result (smtp-via-smtp user-mail-address
@@ -2699,17 +2963,18 @@ This sub function is for exclusive use of `message-send-news'."
      (not (funcall message-send-news-function method)))))
 
 (defun message-send-news (&optional arg)
      (not (funcall message-send-news-function method)))))
 
 (defun message-send-news (&optional arg)
-  (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
-       (case-fold-search nil)
-       (method (if (message-functionp message-post-method)
-                   (funcall message-post-method arg)
-                 message-post-method))
-       (message-syntax-checks
-        (if arg
-            (cons '(existing-newsgroups . disabled)
-                  message-syntax-checks)
-          message-syntax-checks))
-       result)
+  (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
+        (case-fold-search nil)
+        (method (if (message-functionp message-post-method)
+                    (funcall message-post-method arg)
+                  message-post-method))
+        (message-syntax-checks
+         (if arg
+             (cons '(existing-newsgroups . disabled)
+                   message-syntax-checks)
+           message-syntax-checks))
+        (message-this-is-news t)
+        result)
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -2728,11 +2993,15 @@ This sub function is for exclusive use of `message-send-news'."
            ;; Remove some headers.
            (save-restriction
              (message-narrow-to-headers)
            ;; Remove some headers.
            (save-restriction
              (message-narrow-to-headers)
+;; We Semi-gnus people have no use for it.
+;;           ;; We (re)generate the Lines header.
+;;           (when (memq 'Lines message-required-mail-headers)
+;;             (message-generate-headers '(Lines)))
              ;; Remove some headers.
              (message-remove-header message-ignored-news-headers t))
            (goto-char (point-max))
            ;; require one newline at the end.
              ;; Remove some headers.
              (message-remove-header message-ignored-news-headers t))
            (goto-char (point-max))
            ;; require one newline at the end.
-           (or (bolp)
+           (or (= (preceding-char) ?\n)
                (insert ?\n))
            (setq result (message-maybe-split-and-send-news method)))
        (kill-buffer tembuf))
                (insert ?\n))
            (setq result (message-maybe-split-and-send-news method)))
        (kill-buffer tembuf))
@@ -2752,7 +3021,7 @@ This sub function is for exclusive use of `message-send-news'."
     (re-search-forward
      (concat "^" (regexp-quote mail-header-separator) "\n"))
     (replace-match "\n")
     (re-search-forward
      (concat "^" (regexp-quote mail-header-separator) "\n"))
     (replace-match "\n")
-    (forward-char -1)
+    (backward-char 1)
     (run-hooks 'message-send-news-hook)
     (gnus-open-server method)
     (gnus-request-post method)
     (run-hooks 'message-send-news-hook)
     (gnus-open-server method)
     (gnus-request-post method)
@@ -2788,6 +3057,15 @@ This sub function is for exclusive use of `message-send-news'."
 
 (defun message-check-news-header-syntax ()
   (and
 
 (defun message-check-news-header-syntax ()
   (and
+   ;; Check Newsgroups header.
+   (message-check 'newsgroyps
+     (let ((group (message-fetch-field "newsgroups")))
+       (or
+       (and group
+            (not (string-match "\\`[ \t]*\\'" group)))
+       (ignore
+        (message
+         "The newsgroups field is empty or missing.  Posting is denied.")))))
    ;; Check the Subject header.
    (message-check 'subject
      (let* ((case-fold-search t)
    ;; Check the Subject header.
    (message-check 'subject
      (let* ((case-fold-search t)
@@ -2950,12 +3228,15 @@ This sub function is for exclusive use of `message-send-news'."
    (message-check 'from
      (let* ((case-fold-search t)
            (from (message-fetch-field "from"))
    (message-check 'from
      (let* ((case-fold-search t)
            (from (message-fetch-field "from"))
-           (ad (nth 1 (std11-extract-address-components from))))
+           ad)
        (cond
        ((not from)
         (message "There is no From line.  Posting is denied.")
         nil)
        (cond
        ((not from)
         (message "There is no From line.  Posting is denied.")
         nil)
-       ((or (not (string-match "@[^\\.]*\\." ad)) ;larsi@ifi
+       ((or (not (string-match
+                  "@[^\\.]*\\."
+                  (setq ad (nth 1 (mail-extract-address-components
+                                   from))))) ;larsi@ifi
             (string-match "\\.\\." ad) ;larsi@ifi..uio
             (string-match "@\\." ad)   ;larsi@.ifi.uio
             (string-match "\\.$" ad)   ;larsi@ifi.uio.
             (string-match "\\.\\." ad) ;larsi@ifi..uio
             (string-match "@\\." ad)   ;larsi@.ifi.uio
             (string-match "\\.$" ad)   ;larsi@ifi.uio.
@@ -3093,6 +3374,7 @@ This sub function is for exclusive use of `message-send-news'."
   "Process Fcc headers in the current buffer."
   (let ((case-fold-search t)
        (coding-system-for-write 'raw-text)
   "Process Fcc headers in the current buffer."
   (let ((case-fold-search t)
        (coding-system-for-write 'raw-text)
+       (output-coding-system 'raw-text)
        list file)
     (save-excursion
       (set-buffer (get-buffer-create " *message temp*"))
        list file)
     (save-excursion
       (set-buffer (get-buffer-create " *message temp*"))
@@ -3183,7 +3465,7 @@ If NOW, use that time instead."
                                      parse-time-months))))
      (format-time-string "%Y %H:%M:%S " now)
      ;; We do all of this because XEmacs doesn't have the %z spec.
                                      parse-time-months))))
      (format-time-string "%Y %H:%M:%S " now)
      ;; We do all of this because XEmacs doesn't have the %z spec.
-     (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600)))))
+     (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
 
 (defun message-make-followup-subject (subject)
   "Make a followup Subject."
 
 (defun message-make-followup-subject (subject)
   "Make a followup Subject."
@@ -3260,9 +3542,9 @@ If NOW, use that time instead."
   "Make an Organization header."
   (let* ((organization
          (when message-user-organization
   "Make an Organization header."
   (let* ((organization
          (when message-user-organization
-               (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)
       (cond ((stringp organization)
     (save-excursion
       (message-set-work-buffer)
       (cond ((stringp organization)
@@ -3275,7 +3557,7 @@ If NOW, use that time instead."
       (while (re-search-forward "[\t\n]+" nil t)
        (replace-match "" t t))
       (unless (zerop (buffer-size))
       (while (re-search-forward "[\t\n]+" nil t)
        (replace-match "" t t))
       (unless (zerop (buffer-size))
-       (buffer-substring (point-min) (point-max))))))
+       (buffer-string)))))
 
 (defun message-make-lines ()
   "Count the number of lines and return numeric string."
 
 (defun message-make-lines ()
   "Count the number of lines and return numeric string."
@@ -3388,7 +3670,7 @@ If NOW, use that time instead."
            (replace-match "\\1(\\3)" t)
            (goto-char fullname-start)))
        (insert ")")))
            (replace-match "\\1(\\3)" t)
            (goto-char fullname-start)))
        (insert ")")))
-      (buffer-substring (point-min) (point-max)))))
+      (buffer-string))))
 
 (defun message-make-sender ()
   "Return the \"real\" user address.
 
 (defun message-make-sender ()
   "Return the \"real\" user address.
@@ -3559,12 +3841,16 @@ Headers already prepared in the buffer are not modified."
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))
                    (insert (if (stringp header) header (symbol-name header))
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))
                    (insert (if (stringp header) header (symbol-name header))
-                           ": " value "\n")
+                           ": " value)
+                   (unless (bolp)
+                     (insert "\n"))
                    (forward-line -1))
                ;; The value of this header was empty, so we clear
                ;; totally and insert the new value.
                (delete-region (point) (gnus-point-at-eol))
                    (forward-line -1))
                ;; The value of this header was empty, so we clear
                ;; totally and insert the new value.
                (delete-region (point) (gnus-point-at-eol))
-               (insert value))
+               (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 "[^:]+: "))
              ;; Add the deletable property to the headers that require it.
              (and (memq header message-deletable-headers)
                   (progn (beginning-of-line) (looking-at "[^:]+: "))
@@ -3675,23 +3961,60 @@ Headers already prepared in the buffer are not modified."
        (replace-match " " t t))
       (goto-char (point-max)))))
 
        (replace-match " " t t))
       (goto-char (point-max)))))
 
+(defun message-shorten-1 (list cut surplus)
+  ;; Cut SURPLUS elements out of LIST, beginning with CUTth one.
+  (setcdr (nthcdr (- cut 2) list)
+         (nthcdr (+ (- cut 2) surplus 1) list)))
+
 (defun message-shorten-references (header references)
 (defun message-shorten-references (header references)
-  "Limit REFERENCES to be shorter than 988 characters."
-  (let ((max 988)
-       (cut 4)
+  "Trim REFERENCES to be less than 31 Message-ID long, and fold them.
+If folding is disallowed, also check that the REFERENCES are less
+than 988 characters long, and if they are not, trim them until they are."
+  (let ((maxcount 31)
+       (count 0)
+       (cut 6)
        refs)
     (with-temp-buffer
       (insert references)
       (goto-char (point-min))
        refs)
     (with-temp-buffer
       (insert references)
       (goto-char (point-min))
+      ;; Cons a list of valid references.
       (while (re-search-forward "<[^>]+>" nil t)
        (push (match-string 0) refs))
       (while (re-search-forward "<[^>]+>" nil t)
        (push (match-string 0) refs))
-      (setq refs (nreverse refs))
-      (while (> (length (mapconcat 'identity refs " ")) max)
-       (when (< (length refs) (1+ cut))
-         (decf cut))
-       (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs)))))
-    (insert (capitalize (symbol-name header)) ": "
-           (mapconcat 'identity refs " ") "\n")))
+      (setq refs (nreverse refs)
+           count (length refs)))
+
+    ;; If the list has more than MAXCOUNT elements, trim it by
+    ;; removing the CUTth element and the required number of
+    ;; elements that follow.
+    (when (> count maxcount)
+      (let ((surplus (- count maxcount)))
+       (message-shorten-1 refs cut surplus)
+       (decf count surplus)))
+
+    ;; If folding is disallowed, make sure the total length (including
+    ;; the spaces between) will be less than MAXSIZE characters.
+    (when message-cater-to-broken-inn
+      (let ((maxsize 988)
+           (totalsize (+ (apply #'+ (mapcar #'length refs))
+                         (1- count)))
+           (surplus 0)
+           (ptr (nthcdr (1- cut) refs)))
+       ;; Decide how many elements to cut off...
+       (while (> totalsize maxsize)
+         (decf totalsize (1+ (length (car ptr))))
+         (incf surplus)
+         (setq ptr (cdr ptr)))
+       ;; ...and do it.
+       (when (> surplus 0)
+         (message-shorten-1 refs cut surplus))))
+
+    ;; Finally, collect the references back into a string and insert
+    ;; it into the buffer.
+    (let ((refstring (mapconcat #'identity refs " ")))
+      (if message-cater-to-broken-inn
+         (insert (capitalize (symbol-name header)) ": "
+                 refstring "\n")
+       (message-fill-header header refstring)))))
 
 (defun message-position-point ()
   "Move point to where the user probably wants to find it."
 
 (defun message-position-point ()
   "Move point to where the user probably wants to find it."
@@ -3744,40 +4067,36 @@ Headers already prepared in the buffer are not modified."
    (t
     (format "*%s message*" type))))
 
    (t
     (format "*%s message*" type))))
 
+(defmacro message-pop-to-buffer-1 (buffer)
+  `(if pop-up-frames
+       (let (special-display-buffer-names
+            special-display-regexps
+            same-window-buffer-names
+            same-window-regexps)
+        (pop-to-buffer ,buffer))
+     (pop-to-buffer ,buffer)))
+
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."
-  (let ((pop-up-frames pop-up-frames)
-       (special-display-buffer-names special-display-buffer-names)
-       (special-display-regexps special-display-regexps)
-       (same-window-buffer-names same-window-buffer-names)
-       (same-window-regexps same-window-regexps)
-       (buffer (get-buffer name))
-       (cur (current-buffer)))
-    (if (or (and (featurep 'xemacs)
-                (not (eq 'tty (device-type))))
-           window-system
-           (>= emacs-major-version 20))
-       (when message-use-multi-frames
-         (setq pop-up-frames t
-               special-display-buffer-names nil
-               special-display-regexps nil
-               same-window-buffer-names nil
-               same-window-regexps nil))
-      (setq pop-up-frames nil))
+  (let ((buffer (get-buffer name))
+       (pop-up-frames (and (or (static-if (featurep 'xemacs)
+                                   (device-on-window-system-p)
+                                 window-system)
+                               (>= emacs-major-version 20))
+                           message-use-multi-frames)))
     (if (and buffer
             (buffer-name buffer))
        (progn
     (if (and buffer
             (buffer-name buffer))
        (progn
-         (set-buffer (pop-to-buffer buffer))
+         (message-pop-to-buffer-1 buffer)
          (when (and (buffer-modified-p)
                     (not (y-or-n-p
                           "Message already being composed; erase? ")))
            (error "Message being composed")))
          (when (and (buffer-modified-p)
                     (not (y-or-n-p
                           "Message already being composed; erase? ")))
            (error "Message being composed")))
-      (set-buffer (pop-to-buffer name)))
+      (message-pop-to-buffer-1 name))
     (erase-buffer)
     (message-mode)
     (when pop-up-frames
     (erase-buffer)
     (message-mode)
     (when pop-up-frames
-      (make-local-variable 'message-original-frame)
-      (setq message-original-frame (selected-frame)))))
+      (set (make-local-variable 'message-original-frame) (selected-frame)))))
 
 (defun message-do-send-housekeeping ()
   "Kill old message buffers."
 
 (defun message-do-send-housekeeping ()
   "Kill old message buffers."
@@ -3876,7 +4195,9 @@ Headers already prepared in the buffer are not modified."
                                               message-auto-save-directory))
       (setq buffer-auto-save-file-name (make-auto-save-file-name)))
     (clear-visited-file-modtime)
                                               message-auto-save-directory))
       (setq buffer-auto-save-file-name (make-auto-save-file-name)))
     (clear-visited-file-modtime)
-    (setq buffer-file-coding-system message-draft-coding-system)))
+    (static-if (boundp 'MULE)
+       (set-file-coding-system message-draft-coding-system)
+      (setq buffer-file-coding-system message-draft-coding-system))))
 
 (defun message-disassociate-draft ()
   "Disassociate the message buffer from the drafts directory."
 
 (defun message-disassociate-draft ()
   "Disassociate the message buffer from the drafts directory."
@@ -3938,6 +4259,7 @@ OTHER-HEADERS is an alist of header/value pairs."
        from subject date to cc
        references message-id follow-to
        (inhibit-point-motion-hooks t)
        from subject date to cc
        references message-id follow-to
        (inhibit-point-motion-hooks t)
+       (message-this-is-mail t)
        mct never-mct mft mrt gnus-warning in-reply-to)
     (save-restriction
       (message-narrow-to-head)
        mct never-mct mft mrt gnus-warning in-reply-to)
     (save-restriction
       (message-narrow-to-head)
@@ -4035,9 +4357,9 @@ directs your response to " (if (string-match "," mft)
 
 A typical situation where Mail-Followup-To is used is when the author thinks
 that further discussion should take place only in "
 
 A typical situation where Mail-Followup-To is used is when the author thinks
 that further discussion should take place only in "
-                 (if (string-match "," mft)
-                     "the specified mailing lists"
-                   "that mailing list") ".")))
+                            (if (string-match "," mft)
+                                "the specified mailing lists"
+                              "that mailing list") ".")))
        (setq follow-to (list (cons 'To mft)))
        (when mct
          (push (cons 'Cc mct) follow-to)))
        (setq follow-to (list (cons 'To mft)))
        (when mct
          (push (cons 'Cc mct) follow-to)))
@@ -4054,9 +4376,9 @@ that further discussion should take place only in "
            (while (re-search-forward "[ \t]+" nil t)
              (replace-match " " t t))
            ;; Remove addresses that match `rmail-dont-reply-to-names'.
            (while (re-search-forward "[ \t]+" nil t)
              (replace-match " " t t))
            ;; Remove addresses that match `rmail-dont-reply-to-names'.
-           (insert (prog1 (rmail-dont-reply-to (buffer-substring
-                                                (point-min) (point-max)))
-                     (erase-buffer)))
+           (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+             (insert (prog1 (rmail-dont-reply-to (buffer-string))
+                       (erase-buffer))))
            (goto-char (point-min))
            ;; Perhaps Mail-Copies-To: never removed the only address?
            (when (eobp)
            (goto-char (point-min))
            ;; Perhaps Mail-Copies-To: never removed the only address?
            (when (eobp)
@@ -4065,8 +4387,7 @@ that further discussion should take place only in "
                  (mapcar
                   (lambda (addr)
                     (cons (mail-strip-quoted-names addr) addr))
                  (mapcar
                   (lambda (addr)
                     (cons (mail-strip-quoted-names addr) addr))
-                  (message-tokenize-header (buffer-substring
-                                            (point-min) (point-max)))))
+                  (message-tokenize-header (buffer-string))))
            (let ((s ccalist))
              (while s
                (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
            (let ((s ccalist))
              (while s
                (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
@@ -4272,7 +4593,7 @@ that further discussion should take place only in "
   (when (yes-or-no-p "Do you really want to cancel this article? ")
     (let (from newsgroups message-id distribution buf sender)
       (save-excursion
   (when (yes-or-no-p "Do you really want to cancel this article? ")
     (let (from newsgroups message-id distribution buf sender)
       (save-excursion
-       ;; Get header info. from original article.
+       ;; Get header info from original article.
        (save-restriction
          (message-narrow-to-head)
          (setq from (message-fetch-field "from")
        (save-restriction
          (message-narrow-to-head)
          (setq from (message-fetch-field "from")
@@ -4404,7 +4725,7 @@ header line with the old Message-ID."
     (while (re-search-backward "[ \t]+$" nil t)
       (replace-match ""))
 
     (while (re-search-backward "[ \t]+$" nil t)
       (replace-match ""))
 
-    (buffer-substring (point-min) (point-max))))
+    (buffer-string)))
 
 ;;; Forwarding messages.
 
 
 ;;; Forwarding messages.
 
@@ -4493,7 +4814,8 @@ Optional NEWS will use news to forward instead of mail."
 ;;;###autoload
 (defun message-resend (address)
   "Resend the current article to ADDRESS."
 ;;;###autoload
 (defun message-resend (address)
   "Resend the current article to ADDRESS."
-  (interactive "sResend message to: ")
+  (interactive
+   (list (message-read-from-minibuffer "Resend message to: ")))
   (message "Resending message to %s..." address)
   (save-excursion
     (let ((cur (current-buffer))
   (message "Resending message to %s..." address)
   (save-excursion
     (let ((cur (current-buffer))
@@ -4781,10 +5103,10 @@ regexp varstr."
   (let ((oldbuf (current-buffer)))
     (save-excursion
       (set-buffer (generate-new-buffer name))
   (let ((oldbuf (current-buffer)))
     (save-excursion
       (set-buffer (generate-new-buffer name))
-      (message-clone-locals oldbuf)
+      (message-clone-locals oldbuf varstr)
       (current-buffer))))
 
       (current-buffer))))
 
-(defun message-clone-locals (buffer)
+(defun message-clone-locals (buffer &optional varstr)
   "Clone the local variables from BUFFER to the current buffer."
   (let ((locals (save-excursion
                  (set-buffer buffer)
   "Clone the local variables from BUFFER to the current buffer."
   (let ((locals (save-excursion
                  (set-buffer buffer)
@@ -4795,7 +5117,9 @@ regexp varstr."
      (lambda (local)
        (when (and (consp local)
                  (car local)
      (lambda (local)
        (when (and (consp local)
                  (car local)
-                 (string-match regexp (symbol-name (car local))))
+                 (string-match regexp (symbol-name (car local)))
+                 (or (null varstr)
+                     (string-match varstr (symbol-name (car local)))))
         (ignore-errors
           (set (make-local-variable (car local))
                (cdr local)))))
         (ignore-errors
           (set (make-local-variable (car local))
                (cdr local)))))
@@ -4868,8 +5192,7 @@ regexp varstr."
 (defun message-encode-message-body ()
   (unless message-inhibit-body-encoding
     (let ((mail-parse-charset (or mail-parse-charset
 (defun message-encode-message-body ()
   (unless message-inhibit-body-encoding
     (let ((mail-parse-charset (or mail-parse-charset
-                                 message-default-charset
-                                 message-posting-charset))
+                                 message-default-charset))
          (case-fold-search t)
          lines content-type-p)
       (message-goto-body)
          (case-fold-search t)
          lines content-type-p)
       (message-goto-body)
@@ -4884,7 +5207,7 @@ regexp varstr."
                (delete-char 1)
              (search-forward "\n\n")
              (setq lines (buffer-substring (point-min) (1- (point))))
                (delete-char 1)
              (search-forward "\n\n")
              (setq lines (buffer-substring (point-min) (1- (point))))
-             (delete-region (point-min)  (point))))))
+             (delete-region (point-min) (point))))))
       (save-restriction
        (message-narrow-to-headers-or-head)
        (message-remove-header "Mime-Version")
       (save-restriction
        (message-narrow-to-headers-or-head)
        (message-remove-header "Mime-Version")
@@ -4909,16 +5232,28 @@ regexp varstr."
        (forward-line 1)
        (insert "Content-Type: text/plain; charset=us-ascii\n")))))
 
        (forward-line 1)
        (insert "Content-Type: text/plain; charset=us-ascii\n")))))
 
+(defun message-read-from-minibuffer (prompt)
+  "Read from the minibuffer while providing abbrev expansion."
+  (if (fboundp 'mail-abbrevs-setup)
+      (let ((mail-abbrev-mode-regexp "")
+           (minibuffer-setup-hook 'mail-abbrevs-setup))
+       (read-from-minibuffer prompt)))
+  (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
+    (read-string prompt)))
+
 (defvar message-save-buffer " *encoding")
 (defun message-save-drafts ()
   (interactive)
   (if (not (get-buffer message-save-buffer))
       (get-buffer-create message-save-buffer))
   (let ((filename buffer-file-name)
 (defvar message-save-buffer " *encoding")
 (defun message-save-drafts ()
   (interactive)
   (if (not (get-buffer message-save-buffer))
       (get-buffer-create message-save-buffer))
   (let ((filename buffer-file-name)
-       (buffer (current-buffer)))
+       (buffer (current-buffer))
+       (reply-headers message-reply-headers))
     (set-buffer message-save-buffer)
     (erase-buffer)
     (insert-buffer buffer)
     (set-buffer message-save-buffer)
     (erase-buffer)
     (insert-buffer buffer)
+    (setq message-reply-headers reply-headers)
+    (message-generate-headers  '((optional . In-Reply-To)))
     (mime-edit-translate-buffer)
     (write-region (point-min) (point-max) filename)
     (set-buffer buffer)
     (mime-edit-translate-buffer)
     (write-region (point-min) (point-max) filename)
     (set-buffer buffer)
@@ -4928,4 +5263,8 @@ regexp varstr."
 
 (run-hooks 'message-load-hook)
 
 
 (run-hooks 'message-load-hook)
 
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
 ;;; message.el ends here
 ;;; message.el ends here