Merge qgnus-0.23.
[elisp/gnus.git-] / lisp / message.el
index 591b827..09fb030 100644 (file)
@@ -2,7 +2,8 @@
 ;; Copyright (C) 1996,97 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: mail, news
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
 
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  (require 'smtp)
+  )
 
 (require 'mailheader)
-(condition-case nil
-    (require 'rmail)
-  (t (message "Ignore any errors about rmail from this file")))
 (require 'nnheader)
 (require 'timezone)
 (require 'easymenu)
@@ -42,6 +43,7 @@
 (if (string-match "XEmacs\\|Lucid" emacs-version)
     (require 'mail-abbrevs)
   (require 'mailabbrev))
+(require 'mime-edit)
 
 (defgroup message '((user-mail-address custom-variable)
                    (user-full-name custom-variable))
@@ -125,6 +127,11 @@ mailbox format."
                (function :tag "Other"))
   :group 'message-sending)
 
+(defcustom message-encode-function 'message-maybe-encode
+  "*A function called to encode messages."
+  :group 'message-sending
+  :type 'function)
+
 (defcustom message-courtesy-message
   "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
   "*This is inserted at the start of a mailed copy of a posted message.
@@ -158,6 +165,17 @@ Otherwise, most addresses look like `angles', but they look like
                 (const default))
   :group 'message-headers)
 
+(defcustom message-references-generator
+  (if (fboundp 'std11-fill-msg-id-list-string)
+      (function message-generate-filled-references)
+    (function message-generate-folded-references))
+  "*Function to generate \"References\" field."
+  :type '(radio (function-item message-generate-filled-references)
+               (function-item message-generate-folded-references)
+               (function-item message-generate-unfolded-references)
+               (function :tag "Other"))
+  :group 'message-headers)
+
 (defcustom message-syntax-checks nil
   ;; Guess this one shouldn't be easy to customize...
   "Controls what syntax checks should not be performed on outgoing posts.
@@ -278,13 +296,13 @@ If nil, Message won't autosave."
   :type 'directory)
 
 (defcustom message-forward-start-separator
-  "------- Start of forwarded message -------\n"
+  (concat (mime-make-tag "message" "rfc822") "\n")
   "*Delimiter inserted before forwarded messages."
   :group 'message-forwarding
   :type 'string)
 
 (defcustom message-forward-end-separator
-  "------- End of forwarded message -------\n"
+  ""
   "*Delimiter inserted after forwarded messages."
   :group 'message-forwarding
   :type 'string)
@@ -327,6 +345,7 @@ Legal values include `message-send-mail-with-sendmail' (the default),
   :type '(radio (function-item message-send-mail-with-sendmail)
                (function-item message-send-mail-with-mh)
                (function-item message-send-mail-with-qmail)
+               (function-item message-send-mail-with-smtp)
                (function :tag "Other"))
   :group 'message-sending
   :group 'message-mail)
@@ -416,7 +435,8 @@ might set this variable to '(\"-f\" \"you@some.where\")."
   :group 'message-headers
   :type 'boolean)
 
-(defcustom message-setup-hook nil
+(defcustom message-setup-hook
+  '(message-maybe-setup-default-charset turn-on-mime-edit)
   "Normal hook, run each time a new outgoing message is initialized.
 The function `message-setup' runs this hook."
   :group 'message-various
@@ -434,7 +454,7 @@ the signature is inserted."
   :group 'message-various
   :type 'hook)
 
-(defcustom message-header-hook nil
+(defcustom message-header-hook '(eword-encode-header)
   "Hook run in a message mode buffer narrowed to the headers."
   :group 'message-various
   :type 'hook)
@@ -470,8 +490,11 @@ Used by `message-yank-original' via `message-yank-cite'."
           mail-citation-hook)
       mail-citation-hook
     'message-cite-original)
-  "*Function for citing an original message."
+  "*Function for citing an original message.
+Pre-defined functions include `message-cite-original' and
+`message-cite-original-without-signature'."
   :type '(radio (function-item message-cite-original)
+               (function-item message-cite-original-without-signature)
                (function-item sc-cite-original)
                (function :tag "Other"))
   :group 'message-insertion)
@@ -778,6 +801,10 @@ Defaults to `text-mode-abbrev-table'.")
        (0 'message-cited-text-face))))
   "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))
+
 (defvar message-face-alist
   '((bold . bold-region)
     (underline . underline-region)
@@ -898,7 +925,7 @@ The cdr of ech entry is a function for applying the face to a region.")
     (Lines)
     (Expires)
     (Message-ID)
-    (References)
+    (References . message-fill-header)
     (X-Mailer)
     (X-Newsreader))
   "Alist used for formatting headers.")
@@ -1183,6 +1210,7 @@ Return the number of headers removed."
 
   (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
   (define-key message-mode-map "\C-c\C-v" 'message-delete-not-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 "\t" 'message-tab))
@@ -1198,6 +1226,7 @@ Return the number of headers removed."
    ["Caesar (rot13) Region" message-caesar-region (mark t)]
    ["Elide Region" message-elide-region (mark t)]
    ["Delete Outside Region" message-delete-not-region (mark t)]
+   ["Kill To Signature" message-kill-to-signature t]
    ["Newline and Reformat" message-newline-and-reformat t]
    ["Rename buffer" message-rename-buffer t]
    ["Spellcheck" ispell-message t]
@@ -1263,8 +1292,6 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (setq major-mode 'message-mode)
   (setq mode-name "Message")
   (setq buffer-offer-save t)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(message-font-lock-keywords t))
   (make-local-variable 'facemenu-add-face-function)
   (make-local-variable 'facemenu-remove-face-function)
   (setq facemenu-add-face-function
@@ -1311,7 +1338,10 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
        (mail-abbrevs-setup)
       (funcall (intern "mail-aliases-setup"))))
   (message-set-auto-save-file-name)
-  (run-hooks 'text-mode-hook 'message-mode-hook))
+  (run-hooks 'text-mode-hook 'message-mode-hook)
+  (unless (string-match "XEmacs" emacs-version)
+    (set (make-local-variable 'font-lock-defaults)
+        '(message-font-lock-keywords t))))
 
 \f
 
@@ -1440,6 +1470,16 @@ With the prefix argument FORCE, insert the header anyway."
   (message-goto-signature)
   (forward-line -2))
 
+(defun message-kill-to-signature ()
+  "Deletes all text up to the signature."
+  (interactive)
+  (let ((point (point)))
+    (message-goto-signature)
+    (forward-line -2)
+    (kill-region point (point))
+    (unless (bolp)
+      (insert "\n"))))
+
 (defun message-newline-and-reformat ()
   "Insert four newlines, and then reformat if inside quoted text."
   (interactive)
@@ -1593,7 +1633,9 @@ name, rather than giving an automatic name."
                       (read-string "New buffer name: " name-default)
                     name-default))
             (default-directory
-              (file-name-as-directory message-autosave-directory)))
+              (if message-autosave-directory
+                  (file-name-as-directory message-autosave-directory)
+                default-directory)))
        (rename-buffer name t)))))
 
 (defun message-fill-yanked-message (&optional justifyp)
@@ -1675,6 +1717,26 @@ prefix, and don't delete any headers."
       (unless modified
        (setq message-checksum (cons (message-checksum) (buffer-size)))))))
 
+(defun message-cite-original-without-signature ()
+  "Cite function in the standard Message manner."
+  (let ((start (point))
+       (end (mark t))
+       (functions
+        (when message-indent-citation-function
+          (if (listp message-indent-citation-function)
+              message-indent-citation-function
+            (list message-indent-citation-function)))))
+    (goto-char end)
+    (when (re-search-backward "^-- $" start t)
+      (delete-region (point) end))
+    (goto-char start)
+    (while functions
+      (funcall (pop functions)))
+    (when message-citation-line-function
+      (unless (bolp)
+       (insert "\n"))
+      (funcall message-citation-line-function))))
+
 (defun message-cite-original ()
   "Cite function in the standard Message manner."
   (let ((start (point))
@@ -1817,20 +1879,29 @@ the user from the mailer."
     (message-fix-before-sending)
     (run-hooks 'message-send-hook)
     (message "Sending...")
-    (let ((alist message-send-method-alist)
+    (let ((message-encoding-buffer
+          (message-generate-new-buffer-clone-locals " message encoding"))
+         (message-edit-buffer (current-buffer))
+         (message-mime-mode mime-edit-mode-flag)
+         (alist message-send-method-alist)
          (success t)
          elem sent)
-      (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)))))
-         (setq sent t)))
+      (save-excursion
+       (set-buffer message-encoding-buffer)
+       (erase-buffer)
+       (insert-buffer message-edit-buffer)
+       (funcall message-encode-function)
+       (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)))))
+           (setq sent t))))
       (when (and success sent)
        (message-do-fcc)
        ;;(when (fboundp 'mail-hist-put-headers-into-history)
@@ -1887,8 +1958,7 @@ the user from the mailer."
   (require 'mail-utils)
   (let ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
        (case-fold-search nil)
-       (news (message-news-p))
-       (message-buffer (current-buffer)))
+       (news (message-news-p)))
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -1901,14 +1971,7 @@ the user from the mailer."
        (save-excursion
          (set-buffer tembuf)
          (erase-buffer)
-         ;; Avoid copying text props.
-          ;; (insert (format
-          ;;          "%s" (save-excursion
-          ;;                 (set-buffer message-buffer)
-          ;;                 (buffer-string))))
-         ;; 1997-09-29 by MORIOKA Tomohiko
-         ;;    Don't avoid text properties.
-         (insert-buffer message-buffer)
+         (insert-buffer message-encoding-buffer)
          ;; Remove some headers.
          (save-restriction
            (message-narrow-to-headers)
@@ -1922,11 +1985,15 @@ the user from the mailer."
                     (or (message-fetch-field "cc")
                         (message-fetch-field "to")))
            (message-insert-courtesy-copy))
-         ;; 1997-09-29 by MORIOKA Tomohiko
-         (run-hooks 'message-encode-mail-hook)
+         (mime-edit-maybe-split-and-send
+          (function
+           (lambda ()
+             (interactive)
+             (funcall message-send-mail-function)
+             )))
          (funcall message-send-mail-function))
       (kill-buffer tembuf))
-    (set-buffer message-buffer)
+    (set-buffer message-edit-buffer)
     (push 'mail message-sent-message-via)))
 
 (defun message-send-mail-with-sendmail ()
@@ -1956,7 +2023,8 @@ the user from the mailer."
        (save-excursion
          (set-buffer errbuf)
          (erase-buffer))))
-    (let ((default-directory "/"))
+    (let ((default-directory "/")
+         (coding-system-for-write 'binary))
       (apply 'call-process-region
             (append (list (point-min) (point-max)
                           (if (boundp 'sendmail-program)
@@ -2004,27 +2072,28 @@ to find out how to use this."
   (run-hooks 'message-send-mail-hook)
   ;; send the message
   (case
-      (apply
-       'call-process-region 1 (point-max) message-qmail-inject-program
-       nil nil nil
-       ;; qmail-inject's default behaviour is to look for addresses on the
-       ;; command line; if there're none, it scans the headers.
-       ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
-       ;;
-       ;; in general, ALL of qmail-inject's defaults are perfect for simply
-       ;; reading a formatted (i. e., at least a To: or Resent-To header)
-       ;; message from stdin.
-       ;;
-       ;; qmail also has the advantage of not having been raped by
-       ;; various vendors, so we don't have to allow for that, either --
-       ;; compare this with message-send-mail-with-sendmail and weep
-       ;; for sendmail's lost innocence.
-       ;;
-       ;; all this is way cool coz it lets us keep the arguments entirely
-       ;; free for -inject-arguments -- a big win for the user and for us
-       ;; since we don't have to play that double-guessing game and the user
-       ;; gets full control (no gestapo'ish -f's, for instance).  --sj
-       message-qmail-inject-args)
+      (let ((coding-system-for-write 'binary))
+       (apply
+        'call-process-region 1 (point-max) message-qmail-inject-program
+        nil nil nil
+        ;; qmail-inject's default behaviour is to look for addresses on the
+        ;; command line; if there're none, it scans the headers.
+        ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
+        ;;
+        ;; in general, ALL of qmail-inject's defaults are perfect for simply
+        ;; reading a formatted (i. e., at least a To: or Resent-To header)
+        ;; message from stdin.
+        ;;
+        ;; qmail also has the advantage of not having been raped by
+        ;; various vendors, so we don't have to allow for that, either --
+        ;; compare this with message-send-mail-with-sendmail and weep
+        ;; for sendmail's lost innocence.
+        ;;
+        ;; all this is way cool coz it lets us keep the arguments entirely
+        ;; free for -inject-arguments -- a big win for the user and for us
+        ;; since we don't have to play that double-guessing game and the user
+        ;; gets full control (no gestapo'ish -f's, for instance).  --sj
+        message-qmail-inject-args))
     ;; qmail-inject doesn't say anything on it's stdout/stderr,
     ;; we have to look at the retval instead
     (0 nil)
@@ -2051,13 +2120,151 @@ to find out how to use this."
     ;; Pass it on to mh.
     (mh-send-letter)))
 
+(defun message-send-mail-with-smtp ()
+  "Send the prepared message buffer with SMTP."
+  (require 'smtp)
+  (let ((errbuf (if mail-interactive
+                   (generate-new-buffer " smtp errors")
+                 0))
+       (case-fold-search nil)
+       resend-to-addresses
+       delimline)
+    (unwind-protect
+       (save-excursion
+         (goto-char (point-max))
+         ;; require one newline at the end.
+         (or (= (preceding-char) ?\n)
+             (insert ?\n))
+         ;; Change header-delimiter to be what sendmail expects.
+         (goto-char (point-min))
+         (re-search-forward
+          (concat "^" (regexp-quote mail-header-separator) "\n"))
+         (replace-match "\n")
+         (backward-char 1)
+         (setq delimline (point-marker))
+         (run-hooks 'message-send-mail-hook)
+         ;; (sendmail-synch-aliases)
+          ;; (if mail-aliases
+          ;;     (expand-mail-aliases (point-min) delimline))
+         (goto-char (point-min))
+         ;; ignore any blank lines in the header
+         (while (and (re-search-forward "\n\n\n*" delimline t)
+                     (< (point) delimline))
+           (replace-match "\n"))
+         (let ((case-fold-search t))
+           (goto-char (point-min))
+           (goto-char (point-min))
+           (while (re-search-forward "^Resent-to:" delimline t)
+             (setq resend-to-addresses
+                   (save-restriction
+                     (narrow-to-region (point)
+                                       (save-excursion
+                                         (end-of-line)
+                                         (point)))
+                     (append (mail-parse-comma-list)
+                             resend-to-addresses))))
+;;; Apparently this causes a duplicate Sender.
+;;;        ;; If the From is different than current user, insert Sender.
+;;;        (goto-char (point-min))
+;;;        (and (re-search-forward "^From:"  delimline t)
+;;;             (progn
+;;;               (require 'mail-utils)
+;;;               (not (string-equal
+;;;                     (mail-strip-quoted-names
+;;;                      (save-restriction
+;;;                        (narrow-to-region (point-min) delimline)
+;;;                        (mail-fetch-field "From")))
+;;;                     (user-login-name))))
+;;;             (progn
+;;;               (forward-line 1)
+;;;               (insert "Sender: " (user-login-name) "\n")))
+           ;; Don't send out a blank subject line
+           (goto-char (point-min))
+           (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
+               (replace-match ""))
+           ;; Put the "From:" field in unless for some odd reason
+           ;; they put one in themselves.
+           (goto-char (point-min))
+           (if (not (re-search-forward "^From:" delimline t))
+               (let* ((login user-mail-address)
+                      (fullname (user-full-name)))
+                 (cond ((eq mail-from-style 'angles)
+                        (insert "From: " fullname)
+                        (let ((fullname-start (+ (point-min) 6))
+                              (fullname-end (point-marker)))
+                          (goto-char fullname-start)
+                          ;; Look for a character that cannot appear unquoted
+                          ;; according to RFC 822.
+                          (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
+                                                 fullname-end 1)
+                              (progn
+                                ;; Quote fullname, escaping specials.
+                                (goto-char fullname-start)
+                                (insert "\"")
+                                (while (re-search-forward "[\"\\]"
+                                                          fullname-end 1)
+                                  (replace-match "\\\\\\&" t))
+                                (insert "\""))))
+                        (insert " <" login ">\n"))
+                       ((eq mail-from-style 'parens)
+                        (insert "From: " login " (")
+                        (let ((fullname-start (point)))
+                          (insert fullname)
+                          (let ((fullname-end (point-marker)))
+                            (goto-char fullname-start)
+                            ;; RFC 822 says \ and nonmatching parentheses
+                            ;; must be escaped in comments.
+                            ;; Escape every instance of ()\ ...
+                            (while (re-search-forward "[()\\]" fullname-end 1)
+                              (replace-match "\\\\\\&" t))
+                            ;; ... then undo escaping of matching parentheses,
+                            ;; including matching nested parentheses.
+                            (goto-char fullname-start)
+                            (while (re-search-forward 
+                                    "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
+                                    fullname-end 1)
+                              (replace-match "\\1(\\3)" t)
+                              (goto-char fullname-start))))
+                        (insert ")\n"))
+                       ((null mail-from-style)
+                        (insert "From: " login "\n")))))
+           ;; Insert an extra newline if we need it to work around
+           ;; Sun's bug that swallows newlines.
+           (goto-char (1+ delimline))
+           (if (eval mail-mailer-swallows-blank-line)
+               (newline))
+           ;; Find and handle any FCC fields.
+           (goto-char (point-min))
+           (if (re-search-forward "^FCC:" delimline t)
+               (mail-do-fcc delimline))
+           (if mail-interactive
+               (save-excursion
+                 (set-buffer errbuf)
+                 (erase-buffer))))
+         ;;
+         ;;
+         ;;
+         (let ((recipient-address-list
+                (or resend-to-addresses
+                    (smtp-deduce-address-list (current-buffer)
+                                              (point-min) delimline))))
+           (smtp-do-bcc delimline)
+           
+           (if recipient-address-list
+               (if (not (smtp-via-smtp recipient-address-list
+                                       (current-buffer)))
+                   (error "Sending failed; SMTP protocol error"))
+             (error "Sending failed; no recipients"))
+           ))
+      (if (bufferp errbuf)
+         (kill-buffer errbuf)))))
+
 (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-buffer (current-buffer))
        (message-syntax-checks
         (if arg
             (cons '(existing-newsgroups . disabled)
@@ -2080,14 +2287,7 @@ to find out how to use this."
            (set-buffer tembuf)
            (buffer-disable-undo (current-buffer))
            (erase-buffer)
-           ;; Avoid copying text props.
-            ;; (insert (format
-            ;;          "%s" (save-excursion
-            ;;                 (set-buffer message-buffer)
-            ;;                 (buffer-string))))
-           ;; 1997-09-29 by MORIOKA Tomohiko
-           ;;  Don't avoid text properties.
-           (insert-buffer message-buffer)
+           (insert-buffer message-encoding-buffer)
            ;; Remove some headers.
            (save-restriction
              (message-narrow-to-headers)
@@ -2097,11 +2297,22 @@ to find out how to use this."
            ;; require one newline at the end.
            (or (= (preceding-char) ?\n)
                (insert ?\n))
-           ;; 1997-09-29 by MORIOKA Tomohiko
-           (run-hooks 'message-encode-news-hook)
+           (mime-edit-maybe-split-and-send
+            (function
+             (lambda ()
+               (interactive)
+               (save-restriction
+                 (std11-narrow-to-header mail-header-separator)
+                 (goto-char (point-min))
+                 (when (re-search-forward "^Message-Id:" nil t)
+                   (delete-region (match-end 0)(std11-field-end))
+                   (insert (concat " " (message-make-message-id)))
+                   ))
+               (funcall message-send-news-function method)
+               )))
            (setq result (funcall message-send-news-function method)))
        (kill-buffer tembuf))
-      (set-buffer message-buffer)
+      (set-buffer message-edit-buffer)
       (if result
          (push 'news message-sent-message-via)
        (message "Couldn't send message via news: %s"
@@ -2161,7 +2372,9 @@ to find out how to use this."
           (message-narrow-to-headers)
           (message-check-news-header-syntax)))
        ;; Check the body.
-       (message-check-news-body-syntax)))))
+       (save-excursion
+        (set-buffer message-edit-buffer)
+        (message-check-news-body-syntax))))))
 
 (defun message-check-news-header-syntax ()
   (and
@@ -2418,19 +2631,19 @@ to find out how to use this."
 (defun message-do-fcc ()
   "Process Fcc headers in the current buffer."
   (let ((case-fold-search t)
-       (buf (current-buffer))
        (coding-system-for-write 'raw-text)
        list file)
     (save-excursion
       (set-buffer (get-buffer-create " *message temp*"))
       (buffer-disable-undo (current-buffer))
       (erase-buffer)
-      (insert-buffer-substring buf)
+      (insert-buffer-substring message-encoding-buffer)
       (save-restriction
        (message-narrow-to-headers)
        (while (setq file (message-fetch-field "fcc"))
          (push file list)
          (message-remove-header "fcc" nil t)))
+      (run-hooks 'message-header-hook)
       (run-hooks 'message-before-do-fcc-hook)
       (goto-char (point-min))
       (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
@@ -2747,6 +2960,44 @@ give as trustworthy answer as possible."
   (or mail-host-address
       (message-make-fqdn)))
 
+(defun message-generate-filled-references (references message-id)
+  "Return filled References field from REFERENCES and MESSAGE-ID."
+  (std11-fill-msg-id-list-string (concat references message-id)))
+
+(defun message-generate-folded-references (references message-id)
+  "Return folded References field from REFERENCES and MESSAGE-ID."
+  (if references
+      (let (quote)
+       (setq references
+             (mapconcat (function
+                         (lambda (char)
+                           (cond ((eq char ?\\)
+                                  (setq quote t)
+                                  "\\")
+                                 ((memq char '(?\  ?\t))
+                                  (prog1
+                                      (if quote
+                                          (char-to-string char)
+                                        (concat "\n" (char-to-string char)))
+                                    (setq quote nil)))
+                                 (t
+                                  (setq quote nil)
+                                  (char-to-string char)
+                                  ))))
+                        references ""))
+       (if message-id
+           (concat references "\n " message-id)
+         references))
+    message-id))
+
+(defun message-generate-unfolded-references (references message-id)
+  "Return folded References field from REFERENCES and MESSAGE-ID."
+  (if references
+      (if message-id
+         (concat references " " message-id)
+       references)
+    message-id))
+
 (defun message-generate-headers (headers)
   "Prepare article HEADERS.
 Headers already prepared in the buffer are not modified."
@@ -3228,9 +3479,9 @@ Headers already prepared in the buffer are not modified."
      `((Subject . ,subject)
        ,@follow-to
        ,@(if (or references message-id)
-            `((References . ,(concat (or references "") (and references " ")
-                                     (or message-id ""))))
-          nil))
+            `((References . ,(funcall message-references-generator
+                                      references message-id))))
+       )
      cur)))
 
 ;;;###autoload
@@ -3336,8 +3587,8 @@ responses here are directed to other newsgroups."))
           `((Newsgroups . ,newsgroups))))
        ,@(and distribution (list (cons 'Distribution distribution)))
        ,@(if (or references message-id)
-            `((References . ,(concat (or references "") (and references " ")
-                                     (or message-id "")))))
+            `((References . ,(funcall message-references-generator
+                                      references message-id))))
        ,@(when (and mct
                    (not (equal (downcase mct) "never")))
           (list (cons 'Cc (if (equal (downcase mct) "always")
@@ -3368,7 +3619,7 @@ responses here are directed to other newsgroups."))
                distribution (message-fetch-field "distribution")))
        ;; Make sure that this article was written by the user.
        (unless (string-equal
-                (downcase (cadr (mail-extract-address-components from)))
+                (downcase (cadr (std11-extract-address-components from)))
                 (downcase (message-make-address)))
          (error "This article is not yours"))
        ;; Make control message.
@@ -3386,7 +3637,9 @@ responses here are directed to other newsgroups."))
                message-cancel-message)
        (message "Canceling your article...")
        (if (let ((message-syntax-checks
-                  'dont-check-for-anything-just-trust-me))
+                  'dont-check-for-anything-just-trust-me)
+                 (message-encoding-buffer (current-buffer))
+                 (message-edit-buffer (current-buffer)))
              (message-send-news))
            (message "Canceling your article...done"))
        (kill-buffer buf)))))
@@ -3499,7 +3752,10 @@ Optional NEWS will use news to forward instead of mail."
       (set-buffer (get-buffer-create " *message resend*"))
       (buffer-disable-undo (current-buffer))
       (erase-buffer)
-      (message-setup `((To . ,address)))
+      ;; avoid to turn-on-mime-edit
+      (let (message-setup-hook)
+       (message-setup `((To . ,address)))
+       )
       ;; Insert our usual headers.
       (message-generate-headers '(From Date To))
       (message-narrow-to-headers)
@@ -3530,7 +3786,9 @@ Optional NEWS will use news to forward instead of mail."
       (when (looking-at "From ")
        (replace-match "X-From-Line: "))
       ;; Send it.
-      (message-send-mail)
+      (let ((message-encoding-buffer (current-buffer))
+           (message-edit-buffer (current-buffer)))
+       (message-send-mail))
       (kill-buffer (current-buffer)))
     (message "Resending message to %s...done" address)))
 
@@ -3686,6 +3944,7 @@ Do a `tab-to-tab-stop' if not in those headers."
 
 (defvar gnus-active-hashtb)
 (defun message-expand-group ()
+  "Expand the group name under point."
   (let* ((b (save-excursion
              (save-restriction
                (narrow-to-region
@@ -3780,6 +4039,47 @@ regexp varstr."
                (cdr local)))))
      locals)))
 
+
+;;; @ for MIME Edit mode
+;;;
+
+(defun message-maybe-setup-default-charset ()
+  (let ((charset
+        (and (boundp 'gnus-summary-buffer)
+              (buffer-live-p gnus-summary-buffer)
+             (save-excursion
+               (set-buffer gnus-summary-buffer)
+               default-mime-charset))))
+    (if charset
+       (progn
+         (make-local-variable 'default-mime-charset)
+         (setq default-mime-charset charset)
+         ))))
+
+(defun message-maybe-encode ()
+  (when message-mime-mode
+    (run-hooks 'mime-edit-translate-hook)
+    (if (catch 'mime-edit-error
+         (save-excursion
+           (mime-edit-translate-body)
+           ))
+       (error "Translation error!")
+      )
+    (end-of-invisible)
+    (run-hooks 'mime-edit-exit-hook)
+    ))
+
+(defun message-mime-insert-article (&optional message)
+  (interactive)
+  (let ((message-cite-function 'mime-edit-inserted-message-filter)
+        (message-reply-buffer gnus-original-article-buffer)
+       )
+    (message-yank-original nil)
+    ))
+
+(set-alist 'mime-edit-message-inserter-alist
+          'message-mode (function message-mime-insert-article))
+
 ;;; Miscellaneous functions
 
 ;; stolen (and renamed) from nnheader.el