2000-12-20 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 4c60687..71dba43 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,4 +1,4 @@
-;;; message.el --- composing mail and news messages
+;;; message.el --- composing mail and news messages  -*- coding: iso-latin-1 -*-

 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000
 ;;        Free Software Foundation, Inc.
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000
 ;;        Free Software Foundation, Inc.
 


@@ -35,6 +35,9 @@
   (defvar gnus-list-identifiers))      ; gnus-sum is required where necessary
 (require 'mailheader)
 (require 'nnheader)
   (defvar gnus-list-identifiers))      ; gnus-sum is required where necessary
 (require 'mailheader)
 (require 'nnheader)

+;; This is apparently necessary even though things are autoloaded:
+(if (featurep 'xemacs)
+    (require 'mail-abbrevs))

 (require 'mail-parse)
 (require 'mml)
 
 (require 'mail-parse)
 (require 'mml)
 


@@ -256,7 +259,8 @@ should return the new buffer name."
   :group 'message-buffers
   :type 'boolean)
 
   :group 'message-buffers
   :type 'boolean)
 

-(defvar gnus-local-organization)
+(eval-when-compile
+  (defvar gnus-local-organization))

 (defcustom message-user-organization
   (or (and (boundp 'gnus-local-organization)
           (stringp gnus-local-organization)
 (defcustom message-user-organization
   (or (and (boundp 'gnus-local-organization)
           (stringp gnus-local-organization)


@@ -293,6 +297,7 @@ The provided functions are:
 
 (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."
 
 (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."

+  :version "21.1"

   :group 'message-forwarding
   :type 'boolean)
 
   :group 'message-forwarding
   :type 'boolean)
 


@@ -318,6 +323,7 @@ The provided functions are:
 
 (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
   "*All headers that match this regexp will be deleted when forwarding a message."
 
 (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
   "*All headers that match this regexp will be deleted when forwarding a message."

+  :version "21.1"

   :group 'message-forwarding
   :type '(choice (const :tag "None" nil)
                 regexp))
   :group 'message-forwarding
   :type '(choice (const :tag "None" nil)
                 regexp))


@@ -327,6 +333,13 @@ The provided functions are:
   :group 'message-insertion
   :type 'regexp)
 
   :group 'message-insertion
   :type 'regexp)
 

+(defcustom message-cite-prefix-regexp
+  ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
+  "\\([ \t]*\\(\\w\\|[-_.]\\)+>+\\|[ \t]*[]>»|:}+]\\)+"
+  "*Regexp matching the longest possible citation prefix on a line."
+  :group 'message-insertion
+  :type 'regexp)
+

 (defcustom message-cancel-message "I am canceling my own article.\n"
   "Message to be inserted in the cancel message."
   :group 'message-interface
 (defcustom message-cancel-message "I am canceling my own article.\n"
   "Message to be inserted in the cancel message."
   :group 'message-interface


@@ -417,8 +430,9 @@ might set this variable to '(\"-f\" \"you@some.where\")."
 Folding `References' makes ancient versions of INN create incorrect
 NOV lines.")
 
 Folding `References' makes ancient versions of INN create incorrect
 NOV lines.")
 

-(defvar gnus-post-method)
-(defvar gnus-select-method)
+(eval-when-compile
+  (defvar gnus-post-method)
+  (defvar gnus-select-method))

 (defcustom message-post-method
   (cond ((and (boundp 'gnus-post-method)
              (listp gnus-post-method)
 (defcustom message-post-method
   (cond ((and (boundp 'gnus-post-method)
              (listp gnus-post-method)


@@ -482,7 +496,8 @@ the signature is inserted."
 
 ;;;###autoload
 (defcustom message-yank-prefix "> "
 
 ;;;###autoload
 (defcustom message-yank-prefix "> "

-  "*Prefix inserted on the lines of yanked messages."
+  "*Prefix inserted on the lines of yanked messages.
+Fix `message-cite-prefix-regexp' if it is set to an abnormal value."

   :type 'string
   :group 'message-insertion)
 
   :type 'string
   :group 'message-insertion)
 


@@ -570,7 +585,7 @@ If stringp, use this; if non-nil, use no host name (user name only)."
 
 (define-widget 'message-header-lines 'text
   "All header lines must be LFD terminated."
 
 (define-widget 'message-header-lines 'text
   "All header lines must be LFD terminated."

-  :format "%t:%n%v"
+  :format "%{%t%}:%n%v"

   :valid-regexp "^\\'"
   :error "All header lines must be newline terminated")
 
   :valid-regexp "^\\'"
   :error "All header lines must be newline terminated")
 


@@ -620,13 +635,10 @@ actually occur."
   :group 'message-sending
   :type 'sexp)
 
   :group 'message-sending
   :type 'sexp)
 

-;; Ignore errors in case this is used in Emacs 19.
-;; Don't use ignore-errors because this is copied into loaddefs.el.

 ;;;###autoload
 ;;;###autoload

-(ignore-errors
-  (define-mail-user-agent 'message-user-agent
-    'message-mail 'message-send-and-exit
-    'message-kill-buffer 'message-send-hook))
+(define-mail-user-agent 'message-user-agent
+  'message-mail 'message-send-and-exit
+  'message-kill-buffer 'message-send-hook)

 
 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
   "If non-nil, delete the deletable headers before feeding to mh.")
 
 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
   "If non-nil, delete the deletable headers before feeding to mh.")


@@ -645,13 +657,17 @@ a message of type TYPE; and FUNCTION is a function to be called if
 PREDICATE returns non-nil.  FUNCTION is called with one parameter --
 the prefix.")
 
 PREDICATE returns non-nil.  FUNCTION is called with one parameter --
 the prefix.")
 

-(defvar message-mail-alias-type 'abbrev
+(defcustom message-mail-alias-type 'abbrev

   "*What alias expansion type to use in Message buffers.
 The default is `abbrev', which uses mailabbrev.  nil switches
   "*What alias expansion type to use in Message buffers.
 The default is `abbrev', which uses mailabbrev.  nil switches

-mail aliases off.")
+mail aliases off."
+  :group 'message
+  :link '(custom-manual "(message)Mail Aliases")
+  :type '(choice (const :tag "Use Mailabbrev" abbrev)
+                (const :tag "No expansion" nil)))

 
 (defcustom message-auto-save-directory
 
 (defcustom message-auto-save-directory

-  (nnheader-concat message-directory "drafts/")
+  (file-name-as-directory (nnheader-concat message-directory "drafts"))

   "*Directory where Message auto-saves buffers if Gnus isn't running.
 If nil, Message won't auto-save."
   :group 'message-buffers
   "*Directory where Message auto-saves buffers if Gnus isn't running.
 If nil, Message won't auto-save."
   :group 'message-buffers


@@ -660,12 +676,16 @@ If nil, Message won't auto-save."
 (defcustom message-buffer-naming-style 'unique
   "*The way new message buffers are named.
 Valid valued are `unique' and `unsent'."
 (defcustom message-buffer-naming-style 'unique
   "*The way new message buffers are named.
 Valid valued are `unique' and `unsent'."

+  :version "21.1"

   :group 'message-buffers
   :type '(choice (const :tag "unique" unique)
                 (const :tag "unsent" unsent)))
 
   :group 'message-buffers
   :type '(choice (const :tag "unique" unique)
                 (const :tag "unsent" unsent)))
 

-(defcustom message-default-charset nil
-  "Default charset used in non-MULE XEmacsen."
+(defcustom message-default-charset 
+  (and (not (mm-multibyte-p)) 'iso-8859-1)
+  "Default charset used in non-MULE Emacsen.
+If nil, you might be asked to input the charset."
+  :version "21.1"

   :group 'message
   :type 'symbol)
 
   :group 'message
   :type 'symbol)
 


@@ -673,10 +693,25 @@ Valid valued are `unique' and `unsent'."
   (and (boundp 'rmail-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."
   (and (boundp 'rmail-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."

+  :version "21.1"

   :group 'message
   :type '(choice (const :tag "Yourself" nil)
                 regexp))
 
   :group 'message
   :type '(choice (const :tag "Yourself" nil)
                 regexp))
 

+(defvar message-shoot-gnksa-feet nil
+  "*A list of GNKSA feet you are allowed to shoot.  
+Gnus gives you all the opportunity you could possibly want for
+shooting yourself in the foot.  Also, Gnus allows you to shoot the
+feet of Good Net-Keeping Seal of Approval. The following are foot
+candidates:
+`empty-article'     Allow you to post an empty article;
+`quoted-text-only'  Allow you to post quoted text only;
+`multiple-copies'   Allow you to post multiple copies.")
+
+(defsubst message-gnksa-enable-p (feature)
+  (or (not (listp message-shoot-gnksa-feet))
+      (memq feature message-shoot-gnksa-feet)))
+

 ;;; Internal variables.
 ;;; Well, not really internal.
 
 ;;; Internal variables.
 ;;; Well, not really internal.
 


@@ -691,10 +726,6 @@ A value of nil means exclude your own name only."
 (defvar message-mode-abbrev-table text-mode-abbrev-table
   "Abbrev table used in Message mode buffers.
 Defaults to `text-mode-abbrev-table'.")
 (defvar message-mode-abbrev-table text-mode-abbrev-table
   "Abbrev table used in Message mode buffers.
 Defaults to `text-mode-abbrev-table'.")

-(defgroup message-headers nil
-  "Message headers."
-  :link '(custom-manual "(message)Variables")
-  :group 'message)

 
 (defface message-header-to-face
   '((((class color)
 
 (defface message-header-to-face
   '((((class color)


@@ -817,9 +848,7 @@ Defaults to `text-mode-abbrev-table'.")
   :group 'message-faces)
 
 (defvar message-font-lock-keywords
   :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].*\\)*\\)"))
+  (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))

     `((,(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))


@@ -843,9 +872,7 @@ Defaults to `text-mode-abbrev-table'.")
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
               1 'message-separator-face))
          nil)
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
               1 'message-separator-face))
          nil)

-      (,(concat "^[ \t]*"
-               "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
-               "[:>|}].*")
+      (,(concat "^\\(" message-cite-prefix-regexp "\\).*")

        (0 'message-cited-text-face))
       ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
        (0 'message-mml-face))))
        (0 'message-cited-text-face))
       ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
        (0 'message-mml-face))))


@@ -896,12 +923,21 @@ The cdr of ech entry is a function for applying the face to a region.")
   "The limitation of messages sent as message/partial.
 The lower bound of message size in characters, beyond which the message 
 should be sent in several parts. If it is nil, the size is unlimited."
   "The limitation of messages sent as message/partial.
 The lower bound of message size in characters, beyond which the message 
 should be sent in several parts. If it is nil, the size is unlimited."

+  :version "21.1"

   :group 'message-buffers
   :type '(choice (const :tag "unlimited" nil)
                 (integer 1000000)))
 
   :group 'message-buffers
   :type '(choice (const :tag "unlimited" nil)
                 (integer 1000000)))
 

+(defcustom message-alternative-emails nil
+  "A regexp to match the alternative email addresses.
+The first matched address (not primary one) is used in the From field."
+  :group 'message-headers
+  :type '(choice (const :tag "Always use primary" nil)
+                regexp))
+

 ;;; Internal variables.
 
 ;;; Internal variables.
 

+(defvar message-sending-message "Sending...")

 (defvar message-buffer-list nil)
 (defvar message-this-is-news nil)
 (defvar message-this-is-mail nil)
 (defvar message-buffer-list nil)
 (defvar message-this-is-news nil)
 (defvar message-this-is-mail nil)


@@ -910,8 +946,9 @@ should be sent in several parts. If it is nil, the size is unlimited."
 (defvar message-posting-charset nil)
 
 ;; Byte-compiler warning
 (defvar message-posting-charset nil)
 
 ;; Byte-compiler warning

-(defvar gnus-active-hashtb)
-(defvar gnus-read-active-file)
+(eval-when-compile
+  (defvar gnus-active-hashtb)
+  (defvar gnus-read-active-file))

 
 ;;; Regexp matching the delimiter of messages in UNIX mail format
 ;;; (UNIX From lines), minus the initial ^.  It should be a copy
 
 ;;; Regexp matching the delimiter of messages in UNIX mail format
 ;;; (UNIX From lines), minus the initial ^.  It should be a copy


@@ -997,6 +1034,9 @@ should be sent in several parts. If it is nil, the size is unlimited."
     (User-Agent))
   "Alist used for formatting headers.")
 
     (User-Agent))
   "Alist used for formatting headers.")
 

+(defvar        message-options nil
+  "Some saved answers when sending message.")
+

 (eval-and-compile
   (autoload 'message-setup-toolbar "messagexmas")
   (autoload 'mh-new-draft-name "mh-comp")
 (eval-and-compile
   (autoload 'message-setup-toolbar "messagexmas")
   (autoload 'mh-new-draft-name "mh-comp")


@@ -1363,6 +1403,7 @@ Point is left at the beginning of the narrowed-to 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 "\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 "\M-q" 'message-fill-paragraph)

 
   (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
 
 
   (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
 


@@ -1370,7 +1411,7 @@ Point is left at the beginning of the narrowed-to region."
 
 (easy-menu-define
  message-mode-menu message-mode-map "Message Menu."
 
 (easy-menu-define
  message-mode-menu message-mode-map "Message Menu."

- '("Message"
+ `("Message"

    ["Sort Headers" message-sort-headers t]
    ["Yank Original" message-yank-original t]
    ["Fill Yanked Message" message-fill-yanked-message t]
    ["Sort Headers" message-sort-headers t]
    ["Yank Original" message-yank-original t]
    ["Fill Yanked Message" message-fill-yanked-message t]


@@ -1382,12 +1423,22 @@ Point is left at the beginning of the narrowed-to region."
    ["Kill To Signature" message-kill-to-signature t]
    ["Newline and Reformat" message-newline-and-reformat t]
    ["Rename buffer" message-rename-buffer 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]
-   ["Attach file as MIME" mml-attach-file t]
+   ["Spellcheck" ispell-message
+    ,@(if (featurep 'xemacs) nil
+       '(:help "Spellcheck this message"))]
+   ["Attach file as MIME" mml-attach-file
+    ,@(if (featurep 'xemacs) nil
+       '(:help "Attach a file at point"))]

    "----"
    "----"

-   ["Send Message" message-send-and-exit t]
-   ["Abort Message" message-dont-send t]
-   ["Kill Message" message-kill-buffer t]))
+   ["Send Message" message-send-and-exit
+    ,@(if (featurep 'xemacs) nil
+       '(:help "Send this message"))]
+   ["Abort Message" message-dont-send
+    ,@(if (featurep 'xemacs) nil
+       '(:help "File this draft message and exit"))]
+   ["Kill Message" message-kill-buffer
+    ,@(if (featurep 'xemacs) nil
+       '(:help "Delete this message without sending"))]))

 
 (easy-menu-define
  message-mode-field-menu message-mode-map ""
 
 (easy-menu-define
  message-mode-field-menu message-mode-map ""


@@ -1407,15 +1458,17 @@ Point is left at the beginning of the narrowed-to region."
    ["Body" message-goto-body t]
    ["Signature" message-goto-signature t]))
 
    ["Body" message-goto-body t]
    ["Signature" message-goto-signature t]))
 

-(defvar facemenu-add-face-function)
-(defvar facemenu-remove-face-function)
+(eval-when-compile
+  (defvar facemenu-add-face-function)
+  (defvar facemenu-remove-face-function)
+  (defvar message-tool-bar-map))

 
 ;;;###autoload
 (defun message-mode ()
   "Major mode for editing mail and news to be sent.
 Like Text Mode but with these additional commands:
 C-c C-s  message-send (send the message)    C-c C-c  message-send-and-exit
 
 ;;;###autoload
 (defun message-mode ()
   "Major mode for editing mail and news to be sent.
 Like Text Mode but with these additional commands:
 C-c C-s  message-send (send the message)    C-c C-c  message-send-and-exit

-C-c C-d  Pospone sending the message        C-c C-k  Kill the message
+C-c C-d  Postpone sending the message        C-c C-k  Kill the message

 C-c C-f  move to a header field (and create it if there isn't):
         C-c C-f C-t  move to To        C-c C-f C-s  move to Subject
         C-c C-f C-c  move to Cc        C-c C-f C-b  move to Bcc
 C-c C-f  move to a header field (and create it if there isn't):
         C-c C-f C-t  move to To        C-c C-f C-s  move to Subject
         C-c C-f C-c  move to Cc        C-c C-f C-b  move to Bcc


@@ -1463,20 +1516,6 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
              (error "Face %s not configured for %s mode" face mode-name)))
          "")
        facemenu-remove-face-function t)
              (error "Face %s not configured for %s mode" face mode-name)))
          "")
        facemenu-remove-face-function t)

-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  ;; `-- ' precedes the signature.  `-----' appears at the start of the
-  ;; lines that delimit forwarded messages.
-  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
-  ;; are also sometimes used and should be separators.
-  (setq paragraph-start
-       (concat (regexp-quote mail-header-separator)
-               "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
-               "-- $\\|---+$\\|"
-               page-delimiter
-               ;;!!! Uhm... shurely this can't be right?
-               "[> " (regexp-quote message-yank-prefix) "]+$"))
-  (setq paragraph-separate paragraph-start)

   (make-local-variable 'message-reply-headers)
   (setq message-reply-headers nil)
   (make-local-variable 'message-newsreader)
   (make-local-variable 'message-reply-headers)
   (setq message-reply-headers nil)
   (make-local-variable 'message-newsreader)


@@ -1485,12 +1524,15 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
   (set (make-local-variable 'message-sent-message-via) nil)
   (set (make-local-variable 'message-checksum) nil)
   (set (make-local-variable 'message-mime-part) 0)
   (set (make-local-variable 'message-sent-message-via) nil)
   (set (make-local-variable 'message-checksum) nil)
   (set (make-local-variable 'message-mime-part) 0)

+  (message-setup-fill-variables)

   ;;(when (fboundp 'mail-hist-define-keys)
   ;;  (mail-hist-define-keys))
   (if (featurep 'xemacs)
       (message-setup-toolbar)
     (set (make-local-variable 'font-lock-defaults)
   ;;(when (fboundp 'mail-hist-define-keys)
   ;;  (mail-hist-define-keys))
   (if (featurep 'xemacs)
       (message-setup-toolbar)
     (set (make-local-variable 'font-lock-defaults)

-        '(message-font-lock-keywords t)))
+        '(message-font-lock-keywords t))
+    (if (boundp 'tool-bar-map)
+       (set (make-local-variable 'tool-bar-map) message-tool-bar-map)))

   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
   ;; Allow mail alias things.
   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
   ;; Allow mail alias things.


@@ -1499,23 +1541,42 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
        (mail-abbrevs-setup)
       (mail-aliases-setup)))
   (message-set-auto-save-file-name)
        (mail-abbrevs-setup)
       (mail-aliases-setup)))
   (message-set-auto-save-file-name)

-  (make-local-variable 'adaptive-fill-regexp)
-  (setq 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
-       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
-               adaptive-fill-first-line-regexp))
-  (make-local-variable 'auto-fill-inhibit-regexp)
-  (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")

   (mm-enable-multibyte)
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
   (setq indent-tabs-mode nil)
   (mml-mode)
   (run-hooks 'text-mode-hook 'message-mode-hook))
 
   (mm-enable-multibyte)
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
   (setq indent-tabs-mode nil)
   (mml-mode)
   (run-hooks 'text-mode-hook 'message-mode-hook))
 

+(defun message-setup-fill-variables ()
+  "Setup message fill variables."
+  (make-local-variable 'paragraph-separate)
+  (make-local-variable 'paragraph-start)
+  (make-local-variable '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)
+  (make-local-variable 'auto-fill-inhibit-regexp)
+  (let ((quote-prefix-regexp
+        ;; User should change message-cite-prefix-regexp if
+        ;; message-yank-prefix is set to an abnormal value.
+         (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*")))      
+    (setq paragraph-start
+          (concat
+           (regexp-quote mail-header-separator) "$\\|"
+           "[ \t]*$\\|"                 ; blank lines
+           "-- $\\|"                    ; signature delimiter
+           "---+$\\|"                   ; delimiters for forwarded messages
+           page-delimiter "$\\|"        ; spoiler warnings
+           ".*wrote:$\\|"               ; attribution lines
+           quote-prefix-regexp "$"))    ; empty lines in quoted text
+    (setq paragraph-separate paragraph-start)
+    (setq adaptive-fill-regexp
+          (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+    (setq adaptive-fill-first-line-regexp
+          (concat quote-prefix-regexp "\\|"
+                  adaptive-fill-first-line-regexp))
+    (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")))
+

 \f
 
 ;;;
 \f
 
 ;;;


@@ -1622,7 +1683,8 @@ With the prefix argument FORCE, insert the header anyway."
             (mail-fetch-field "to")
             (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
     (insert ", "))
             (mail-fetch-field "to")
             (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
     (insert ", "))

-  (insert (or (message-fetch-reply-field "reply-to")
+  (insert (or (message-fetch-reply-field "mail-reply-to")
+             (message-fetch-reply-field "reply-to")

              (message-fetch-reply-field "from") "")))
 
 (defun message-widen-reply ()
              (message-fetch-reply-field "from") "")))
 
 (defun message-widen-reply ()


@@ -1684,27 +1746,88 @@ With the prefix argument FORCE, insert the header anyway."
     (unless (bolp)
       (insert "\n"))))
 
     (unless (bolp)
       (insert "\n"))))
 

-(defun message-newline-and-reformat ()
+(defun message-newline-and-reformat (&optional not-break)

   "Insert four newlines, and then reformat if inside quoted text."
   (interactive)
   "Insert four newlines, and then reformat if inside quoted text."
   (interactive)

-  (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"))
+  (let (quoted point beg end leading-space)

     (setq point (point))
     (setq point (point))

-    (insert "\n\n\n")
-    (delete-region (point) (re-search-forward "[ \t]*"))
-    (when quoted
-      (insert quoted))
-    (fill-paragraph nil)
+    (beginning-of-line)
+    (setq beg (point))
+    ;; Find first line of the paragraph.
+    (if not-break
+       (while (and (not (eobp)) 
+                   (not (looking-at message-cite-prefix-regexp))
+               (looking-at paragraph-start))
+         (forward-line 1)))
+    ;; Find the prefix
+    (when (looking-at message-cite-prefix-regexp)
+      (setq quoted (match-string 0))
+      (goto-char (match-end 0))
+      (looking-at "[ \t]*")
+      (setq leading-space (match-string 0)))
+    (if (and quoted
+            (not not-break)
+            (< (- point beg) (length quoted)))
+       ;; break in the cite prefix.
+       (setq quoted nil
+             end nil))
+    (if quoted
+       (progn
+         (forward-line 1)
+         (while (and (not (eobp))
+                     (not (looking-at paragraph-separate))
+                     (looking-at message-cite-prefix-regexp)
+                     (equal quoted (match-string 0)))
+           (goto-char (match-end 0))
+           (looking-at "[ \t]*")
+           (if (> (length leading-space) (length (match-string 0)))
+               (setq leading-space (match-string 0)))
+           (forward-line 1))
+         (setq end (point))
+         (goto-char beg)
+         (while (and (if (bobp) nil (forward-line -1) t)
+                     (not (looking-at paragraph-start))
+                     (looking-at message-cite-prefix-regexp)
+                     (equal quoted (match-string 0)))
+           (setq beg (point))
+           (goto-char (match-end 0))
+           (looking-at "[ \t]*")
+           (if (> (length leading-space) (length (match-string 0)))
+               (setq leading-space (match-string 0)))))
+      (while (and (not (eobp))
+                 (not (looking-at paragraph-separate))
+                 (not (looking-at message-cite-prefix-regexp)))
+       (forward-line 1))
+      (setq end (point))
+      (goto-char beg)
+      (while (and (if (bobp) nil (forward-line -1) t)
+                 (not (looking-at paragraph-start))
+                 (not (looking-at message-cite-prefix-regexp)))
+       (setq beg (point))))

     (goto-char point)
     (goto-char point)

-    (forward-line 1)))
+    (save-restriction
+      (narrow-to-region beg end)
+      (if not-break
+         (setq point nil)
+       (insert "\n\n")
+       (setq point (point))
+       (insert "\n\n")
+       (delete-region (point) (re-search-forward "[ \t]*"))
+       (when quoted
+         (insert quoted leading-space)))
+      (if quoted
+         (let* ((adaptive-fill-regexp 
+                (regexp-quote (concat quoted leading-space)))
+                (adaptive-fill-first-line-regexp 
+                 adaptive-fill-regexp ))
+           (fill-paragraph nil))
+       (fill-paragraph nil))
+      (if point (goto-char point)))))
+
+(defun message-fill-paragraph ()
+  "Like `fill-paragraph'."
+  (interactive)
+  (message-newline-and-reformat t))

 
 (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."


@@ -1959,7 +2082,7 @@ prefix, and don't delete any headers."
        (insert "\n"))
       (funcall message-citation-line-function))))
 
        (insert "\n"))
       (funcall message-citation-line-function))))
 

-(defvar mail-citation-hook)            ;Compiler directive
+(eval-when-compile (defvar mail-citation-hook))                ;Compiler directive

 (defun message-cite-original ()
   "Cite function in the standard Message manner."
   (if (and (boundp 'mail-citation-hook)
 (defun message-cite-original ()
   "Cite function in the standard Message manner."
   (if (and (boundp 'mail-citation-hook)


@@ -2101,21 +2224,26 @@ It should typically alter the sending method in some way or other."
     (put-text-property (point-min) (point-max) 'read-only nil))
   (message-fix-before-sending)
   (run-hooks 'message-send-hook)
     (put-text-property (point-min) (point-max) 'read-only nil))
   (message-fix-before-sending)
   (run-hooks 'message-send-hook)

-  (message "Sending...")
+  (message message-sending-message)

   (let ((alist message-send-method-alist)
        (success t)
   (let ((alist message-send-method-alist)
        (success t)

-       elem sent)
+       elem sent
+       (message-options message-options))
+    (message-options-set-recipient)

     (while (and success
                (setq elem (pop alist)))
     (while (and success
                (setq elem (pop alist)))

-      (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)))
+      (when (funcall (cadr elem))
+       (when (and (or (not (memq (car elem)
+                                 message-sent-message-via))
+                      (if (or (message-gnksa-enable-p 'multiple-copies)
+                              (not (eq (car elem) 'news)))
+                          (y-or-n-p
+                           (format
+                            "Already sent message via %s; resend? "
+                            (car elem)))
+                        (error "Denied posting -- multiple copies.")))
+                  (setq success (funcall (caddr elem) arg)))
+         (setq sent t))))

     (unless (or sent (not success))
       (error "No methods specified to send by"))
     (when (and success sent)
     (unless (or sent (not success))
       (error "No methods specified to send by"))
     (when (and success sent)


@@ -2187,6 +2315,12 @@ It should typically alter the sending method in some way or other."
 
 (defun message-send-mail-partially ()
   "Sendmail as message/partial."
 
 (defun message-send-mail-partially ()
   "Sendmail as message/partial."

+  ;; replace the header delimiter with a blank line
+  (goto-char (point-min))
+  (re-search-forward
+   (concat "^" (regexp-quote mail-header-separator) "\n"))
+  (replace-match "\n")
+  (run-hooks 'message-send-mail-hook)

   (let ((p (goto-char (point-min)))
        (tembuf (message-generate-new-buffer-clone-locals " message temp"))
        (curbuf (current-buffer))
   (let ((p (goto-char (point-min)))
        (tembuf (message-generate-new-buffer-clone-locals " message temp"))
        (curbuf (current-buffer))


@@ -2275,10 +2409,8 @@ It should typically alter the sending method in some way or other."
          (set-buffer tembuf)
          (erase-buffer)
          ;; Avoid copying text props.
          (set-buffer tembuf)
          (erase-buffer)
          ;; Avoid copying text props.

-         (insert (format
-                  "%s" (save-excursion
-                         (set-buffer mailbuf)
-                         (buffer-string))))
+         (insert (with-current-buffer mailbuf
+                   (buffer-substring-no-properties (point-min) (point-max))))

          ;; Remove some headers.
          (message-encode-message-body)
          (save-restriction
          ;; Remove some headers.
          (message-encode-message-body)
          (save-restriction


@@ -2294,13 +2426,16 @@ It should typically alter the sending method in some way or other."
          ;; require one newline at the end.
          (or (= (preceding-char) ?\n)
              (insert ?\n))
          ;; require one newline at the end.
          (or (= (preceding-char) ?\n)
              (insert ?\n))

-         (when (and news
+         (when 
+             (save-restriction
+               (message-narrow-to-headers)
+               (and news

                     (or (message-fetch-field "cc")
                         (message-fetch-field "to"))
                     (string= "text/plain"
                              (car
                               (mail-header-parse-content-type
                     (or (message-fetch-field "cc")
                         (message-fetch-field "to"))
                     (string= "text/plain"
                              (car
                               (mail-header-parse-content-type

-                               (message-fetch-field "content-type")))))
+                               (message-fetch-field "content-type"))))))

            (message-insert-courtesy-copy))
          (if (or (not message-send-mail-partially-limit)
                  (< (point-max) message-send-mail-partially-limit)
            (message-insert-courtesy-copy))
          (if (or (not message-send-mail-partially-limit)
                  (< (point-max) message-send-mail-partially-limit)


@@ -2482,10 +2617,9 @@ to find out how to use this."
              (buffer-disable-undo)
              (erase-buffer)
              ;; Avoid copying text props.
              (buffer-disable-undo)
              (erase-buffer)
              ;; Avoid copying text props.

-             (insert (format
-                      "%s" (save-excursion
-                             (set-buffer messbuf)
-                             (buffer-string))))
+             (insert (with-current-buffer messbuf
+                       (buffer-substring-no-properties 
+                        (point-min) (point-max))))

              (message-encode-message-body)
              ;; Remove some headers.
              (save-restriction
              (message-encode-message-body)
              ;; Remove some headers.
              (save-restriction


@@ -2762,7 +2896,10 @@ to find out how to use this."
        (re-search-backward message-signature-separator nil t)
        (beginning-of-line)
        (or (re-search-backward "[^ \n\t]" b t)
        (re-search-backward message-signature-separator nil t)
        (beginning-of-line)
        (or (re-search-backward "[^ \n\t]" b t)

-          (y-or-n-p "Empty article.  Really post? "))))
+          (if (message-gnksa-enable-p 'empty-article)
+              (y-or-n-p "Empty article.  Really post? ")
+            (message "Denied posting -- Empty article.")
+            nil))))

    ;; Check for control characters.
    (message-check 'control-chars
      (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)
    ;; Check for control characters.
    (message-check 'control-chars
      (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)


@@ -2781,8 +2918,11 @@ to find out how to use this."
      (or
       (not message-checksum)
       (not (eq (message-checksum) message-checksum))
      (or
       (not message-checksum)
       (not (eq (message-checksum) message-checksum))

-      (y-or-n-p
-       "It looks like no new text has been added.  Really post? ")))
+      (if (message-gnksa-enable-p 'quoted-text-only)
+         (y-or-n-p
+          "It looks like no new text has been added.  Really post? ")
+       (message "Denied posting -- no new text has been added.")
+       nil)))

    ;; Check the length of the signature.
    (message-check 'signature
      (goto-char (point-max))
    ;; Check the length of the signature.
    (message-check 'signature
      (goto-char (point-max))


@@ -2796,15 +2936,20 @@ to find out how to use this."
    (message-check 'quoting-style
      (goto-char (point-max))
      (let ((no-problem t))
    (message-check 'quoting-style
      (goto-char (point-max))
      (let ((no-problem t))

-       (when (search-backward-regexp "^>[^\n]*\n>" nil t)
-        (setq no-problem nil)
-        (while (not (eobp))
-          (when (and (not (eolp)) (looking-at "[^> \t]"))
-            (setq no-problem t))
-          (forward-line)))
+       (when (search-backward-regexp "^>[^\n]*\n" nil t)
+        (setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil t)))

        (if no-problem
           t
        (if no-problem
           t

-        (y-or-n-p "Your text should follow quoted text.  Really post? "))))))
+        (if (message-gnksa-enable-p 'quoted-text-only)
+            (y-or-n-p "Your text should follow quoted text.  Really post? ")
+          ;; Ensure that
+          (goto-char (point-min))
+          (re-search-forward
+           (concat "^" (regexp-quote mail-header-separator) "$"))
+          (if (search-forward-regexp "^[ \t]*[^>\n]" nil t)
+              (y-or-n-p "Your text should follow quoted text.  Really post? ")
+            (message "Denied posting -- only quoted text.")
+            nil)))))))

 
 (defun message-checksum ()
   "Return a \"checksum\" for the current buffer."
 
 (defun message-checksum ()
   "Return a \"checksum\" for the current buffer."


@@ -2937,7 +3082,6 @@ If NOW, use that time instead."
                      (mail-header-references message-reply-headers)
                      (mail-header-subject message-reply-headers)
                      psubject
                      (mail-header-references message-reply-headers)
                      (mail-header-subject message-reply-headers)
                      psubject

-                     (mail-header-subject message-reply-headers)

                      (not (string=
                            (message-strip-subject-re
                             (mail-header-subject message-reply-headers))
                      (not (string=
                            (message-strip-subject-re
                             (mail-header-subject message-reply-headers))


@@ -3022,18 +3166,7 @@ If NOW, use that time instead."
 (defun message-make-in-reply-to ()
   "Return the In-Reply-To header for this message."
   (when message-reply-headers
 (defun message-make-in-reply-to ()
   "Return the In-Reply-To header for this message."
   (when message-reply-headers

-    (let ((from (mail-header-from message-reply-headers))
-         (date (mail-header-date message-reply-headers)))
-      (when from
-       (let ((stop-pos
-              (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
-         (concat (if (and stop-pos
-                          (not (zerop stop-pos)))
-                     (substring from 0 stop-pos) from)
-                 "'s message of \""
-                 (if (or (not date) (string= date ""))
-                     "(unknown date)" date)
-                 "\""))))))
+    (mail-header-message-id message-reply-headers)))

 
 (defun message-make-distribution ()
   "Make a Distribution header."
 
 (defun message-make-distribution ()
   "Make a Distribution header."


@@ -3522,13 +3655,13 @@ than 988 characters long, and if they are not, trim them until they are."
     (setq message-buffer-list
          (nconc message-buffer-list (list (current-buffer))))))
 
     (setq message-buffer-list
          (nconc message-buffer-list (list (current-buffer))))))
 

-(defvar mc-modes-alist)
+;;;(defvar mc-modes-alist)

 (defun message-setup (headers &optional replybuffer actions)
 (defun message-setup (headers &optional replybuffer actions)

-  (when (and (boundp 'mc-modes-alist)
-            (not (assq 'message-mode mc-modes-alist)))
-    (push '(message-mode (encrypt . mc-encrypt-message)
-                        (sign . mc-sign-message))
-         mc-modes-alist))
+;;;   (when (and (boundp 'mc-modes-alist)
+;;;         (not (assq 'message-mode mc-modes-alist)))
+;;;     (push '(message-mode (encrypt . mc-encrypt-message)
+;;;                     (sign . mc-sign-message))
+;;;      mc-modes-alist))

   (when actions
     (setq message-send-actions actions))
   (setq message-reply-buffer replybuffer)
   (when actions
     (setq message-send-actions actions))
   (setq message-reply-buffer replybuffer)


@@ -3576,6 +3709,8 @@ than 988 characters long, and if they are not, trim them until they are."
   (message-insert-signature)
   (save-restriction
     (message-narrow-to-headers)
   (message-insert-signature)
   (save-restriction
     (message-narrow-to-headers)

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

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


@@ -3586,6 +3721,9 @@ than 988 characters long, and if they are not, trim them until they are."
 (defun message-set-auto-save-file-name ()
   "Associate the message buffer with a file in the drafts directory."
   (when message-auto-save-directory
 (defun message-set-auto-save-file-name ()
   "Associate the message buffer with a file in the drafts directory."
   (when message-auto-save-directory

+    (unless (file-directory-p
+            (directory-file-name message-auto-save-directory))
+      (gnus-make-directory message-auto-save-directory))

     (if (gnus-alive-p)
        (setq message-draft-article
              (nndraft-request-associate-buffer "drafts"))
     (if (gnus-alive-p)
        (setq message-draft-article
              (nndraft-request-associate-buffer "drafts"))


@@ -3648,13 +3786,15 @@ OTHER-HEADERS is an alist of header/value pairs."
                     (Subject . ,(or subject ""))))))
 
 (defun message-get-reply-headers (wide &optional to-address)
                     (Subject . ,(or subject ""))))))
 
 (defun message-get-reply-headers (wide &optional to-address)

-  (let (follow-to mct never-mct from to cc reply-to ccalist)
+  (let (follow-to mct never-mct from to cc reply-to mrt mft ccalist)

     ;; Find all relevant headers we need.
     (setq from (message-fetch-field "from")
          to (message-fetch-field "to")
          cc (message-fetch-field "cc")
          mct (message-fetch-field "mail-copies-to")
     ;; Find all relevant headers we need.
     (setq from (message-fetch-field "from")
          to (message-fetch-field "to")
          cc (message-fetch-field "cc")
          mct (message-fetch-field "mail-copies-to")

-         reply-to (message-fetch-field "reply-to"))
+         reply-to (message-fetch-field "reply-to")
+         mrt (message-fetch-field "mail-reply-to")
+         mft (message-fetch-field "mail-followup-to"))

 
     ;; Handle special values of Mail-Copies-To.
     (when mct
 
     ;; Handle special values of Mail-Copies-To.
     (when mct


@@ -3664,22 +3804,44 @@ OTHER-HEADERS is an alist of header/value pairs."
             (setq mct nil))
            ((or (equal (downcase mct) "always")
                 (equal (downcase mct) "poster"))
             (setq mct nil))
            ((or (equal (downcase mct) "always")
                 (equal (downcase mct) "poster"))

-            (setq mct (or reply-to from)))))
+            (setq mct (or mrt reply-to from)))))

 
     (if (or (not wide)
            to-address)
        (progn
 
     (if (or (not wide)
            to-address)
        (progn

-         (setq follow-to (list (cons 'To (or to-address reply-to from))))
-         (when (and wide mct)
-           (push (cons 'Cc mct) follow-to)))
+         (setq follow-to (list (cons 'To (or to-address mrt reply-to from))))
+         (when (and wide (or mft mct))
+           (push (cons 'Cc (or mft mct)) follow-to)))

       (let (ccalist)
        (save-excursion
          (message-set-work-buffer)
       (let (ccalist)
        (save-excursion
          (message-set-work-buffer)

-         (unless never-mct
-           (insert (or reply-to from "")))
-         (insert (if to (concat (if (bolp) "" ", ") to "") ""))
-         (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
-         (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
+          (if (and mft
+                   message-use-followup-to
+                   (or (not (eq message-use-followup-to 'ask))
+                       (message-y-or-n-p
+                       (concat "Obey Mail-Followup-To? ") t "\
+You should normally obey the Mail-Followup-To: header.  In this
+article, it has the value of
+
+" mft "
+
+which directs your response to " (if (string-match "," mft)
+                              "the specified addresses"
+                            "that address only") ".
+
+If a message is posted to several mailing lists, Mail-Followup-To is
+often used to direct the following discussion to one list only,
+because discussions that are spread over several lists tend to be
+fragmented and very difficult to follow.
+
+Also, some source/announcement lists are not indented for discussion;
+responses here are directed to other addresses.")))
+              (insert mft)
+           (unless never-mct
+             (insert (or mrt reply-to from "")))
+           (insert (if to (concat (if (bolp) "" ", ") to "") ""))
+           (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
+           (insert (if cc (concat (if (bolp) "" ", ") cc) "")))

          (goto-char (point-min))
          (while (re-search-forward "[ \t]+" nil t)
            (replace-match " " t t))
          (goto-char (point-min))
          (while (re-search-forward "[ \t]+" nil t)
            (replace-match " " t t))


@@ -3690,7 +3852,7 @@ OTHER-HEADERS is an alist of header/value pairs."
          (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)

-           (insert (or reply-to from "")))
+           (insert (or mrt reply-to from "")))

          (setq ccalist
                (mapcar
                 (lambda (addr)
          (setq ccalist
                (mapcar
                 (lambda (addr)


@@ -3778,7 +3940,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
   (interactive)
   (require 'gnus-sum)                  ; for gnus-list-identifiers
   (let ((cur (current-buffer))
   (interactive)
   (require 'gnus-sum)                  ; for gnus-list-identifiers
   (let ((cur (current-buffer))

-       from subject date reply-to mct
+       from subject date reply-to mrt mct

        references message-id follow-to
        (inhibit-point-motion-hooks t)
        (message-this-is-news t)
        references message-id follow-to
        (inhibit-point-motion-hooks t)
        (message-this-is-news t)


@@ -3801,6 +3963,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
            newsgroups (message-fetch-field "newsgroups")
            posted-to (message-fetch-field "posted-to")
            reply-to (message-fetch-field "reply-to")
            newsgroups (message-fetch-field "newsgroups")
            posted-to (message-fetch-field "posted-to")
            reply-to (message-fetch-field "reply-to")

+           mrt (message-fetch-field "mail-reply-to")

            distribution (message-fetch-field "distribution")
            mct (message-fetch-field "mail-copies-to"))
       (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
            distribution (message-fetch-field "distribution")
            mct (message-fetch-field "mail-copies-to"))
       (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))


@@ -3838,7 +4001,7 @@ A typical situation where `Followup-To: poster' is used is when the poster
 does not read the newsgroup, so he wouldn't see any replies sent to it."))
                  (progn
                    (setq message-this-is-news nil)
 does not read the newsgroup, so he wouldn't see any replies sent to it."))
                  (progn
                    (setq message-this-is-news nil)

-                   (cons 'To (or reply-to from "")))
+                   (cons 'To (or mrt reply-to from "")))

                (cons 'Newsgroups newsgroups)))
             (t
              (if (or (equal followup-to newsgroups)
                (cons 'Newsgroups newsgroups)))
             (t
              (if (or (equal followup-to newsgroups)


@@ -3874,7 +4037,7 @@ responses here are directed to other newsgroups."))
                             (equal (downcase mct) "nobody"))))
           (list (cons 'Cc (if (or (equal (downcase mct) "always")
                                   (equal (downcase mct) "poster"))
                             (equal (downcase mct) "nobody"))))
           (list (cons 'Cc (if (or (equal (downcase mct) "always")
                                   (equal (downcase mct) "poster"))

-                              (or reply-to from "")
+                              (or mrt reply-to from "")

                             mct)))))
 
      cur)
                             mct)))))
 
      cur)


@@ -4098,8 +4261,7 @@ Optional DIGEST will use digest to forward."
            (mml-insert-buffer cur))
        (if message-forward-show-mml
            (insert-buffer-substring cur)
            (mml-insert-buffer cur))
        (if message-forward-show-mml
            (insert-buffer-substring cur)

-         (mm-with-unibyte-current-buffer
-           (mml-insert-buffer cur))))
+         (mml-insert-buffer cur)))

       (setq e (point))
       (if message-forward-as-mime
          (if digest
       (setq e (point))
       (if message-forward-as-mime
          (if digest


@@ -4306,8 +4468,33 @@ which specify the range to operate on."
 (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
 
 ;; Support for toolbar
 (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
 
 ;; Support for toolbar

-(when (string-match "XEmacs\\|Lucid" emacs-version)
-  (require 'messagexmas))
+(eval-when-compile 
+  (defvar tool-bar-map)
+  (defvar tool-bar-mode))
+(if (featurep 'xemacs)
+    (require 'messagexmas)
+  (when (and (>= (string-to-int emacs-version) 21)
+            ;; I hate warnings --zsh.
+            (fboundp 'tool-bar-add-item-from-menu)
+            tool-bar-mode)
+    (defvar message-tool-bar-map
+      (let ((tool-bar-map (copy-keymap tool-bar-map)))
+       ;; Zap some items which aren't so relevant and take up space.
+       (dolist (key '(print-buffer kill-buffer save-buffer write-file
+                                   dired open-file))
+         (define-key tool-bar-map (vector key) nil))
+       
+       (tool-bar-add-item-from-menu
+        'message-send-and-exit "mail_send" message-mode-map)
+       (tool-bar-add-item-from-menu
+        'message-kill-buffer "close" message-mode-map)
+       (tool-bar-add-item-from-menu
+        'message-dont-send "cancel" message-mode-map)
+       (tool-bar-add-item-from-menu
+        'mml-attach-file "attach" message-mode-map)
+       (tool-bar-add-item-from-menu
+        'ispell-message "spell" message-mode-map)
+       tool-bar-map))))

 
 ;;; Group name completion.
 
 
 ;;; Group name completion.
 


@@ -4324,7 +4511,6 @@ Do a `tab-to-tab-stop' if not in those headers."
       (message-expand-group)
     (tab-to-tab-stop)))
 
       (message-expand-group)
     (tab-to-tab-stop)))
 

-(defvar gnus-active-hashtb)

 (defun message-expand-group ()
   "Expand the group name under point."
   (let* ((b (save-excursion
 (defun message-expand-group ()
   "Expand the group name under point."
   (let* ((b (save-excursion


@@ -4426,21 +4612,8 @@ regexp varstr."
 
 ;;; Miscellaneous functions
 
 
 ;;; Miscellaneous functions
 

-;; stolen (and renamed) from nnheader.el
-(if (fboundp 'subst-char-in-string)
-    (defsubst message-replace-chars-in-string (string from to)
-      (subst-char-in-string from to string))
-  (defun message-replace-chars-in-string (string from to)
-    "Replace characters in STRING from FROM to TO."
-    (let ((string (substring string 0))        ;Copy string.
-         (len (length string))
-         (idx 0))
-      ;; Replace all occurrences of FROM with TO.
-      (while (< idx len)
-       (when (= (aref string idx) from)
-         (aset string idx to))
-       (setq idx (1+ idx)))
-      string)))
+(defsubst message-replace-chars-in-string (string from to)
+  (mm-subst-char-in-string from to string))

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


@@ -4500,6 +4673,47 @@ regexp varstr."
     (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
       (read-string prompt))))
 
     (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
       (read-string prompt))))
 

+(defun message-use-alternative-email-as-from ()
+  (require 'mail-utils)
+  (let* ((fields '("To" "Cc")) 
+        (emails
+         (split-string
+          (mail-strip-quoted-names
+           (mapconcat 'message-fetch-reply-field fields ","))
+          "[ \f\t\n\r\v,]+"))
+        email)
+    (while emails
+      (if (string-match message-alternative-emails (car emails))
+         (setq email (car emails)
+               emails nil))
+      (pop emails))
+    (unless (or (not email) (equal email user-mail-address))
+      (goto-char (point-max))
+      (insert "From: " email "\n"))))
+
+(defun message-options-get (symbol)
+  (cdr (assq symbol message-options)))
+
+(defun message-options-set (symbol value)
+  (let ((the-cons (assq symbol message-options)))
+    (if the-cons
+       (if value 
+           (setcdr the-cons value)
+         (setq message-options (delq the-cons message-options)))
+      (and value
+          (push (cons symbol value) message-options))))
+  value)
+
+(defun message-options-set-recipient ()
+  (save-restriction
+    (message-narrow-to-headers-or-head)
+    (message-options-set 'message-sender
+                        (mail-strip-quoted-names 
+                         (message-fetch-field "from")))
+    (message-options-set 'message-recipients
+                         (mail-strip-quoted-names 
+                          (message-fetch-field "to")))))
+

 (provide 'message)
 
 (run-hooks 'message-load-hook)
 (provide 'message)
 
 (run-hooks 'message-load-hook)