Synch to Oort Gnus.

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

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 2dc3d6d..c811ab9 100644 (file)
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -1,5 +1,5 @@
 ;;; gnus-msg.el --- mail and post interface for Semi-gnus
 ;;; gnus-msg.el --- mail and post interface for Semi-gnus

-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003

 ;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>

@@ -106,7 +106,7 @@ the second with the current group name."
   :group 'gnus-message
   :type 'string)
 
   :group 'gnus-message
   :type 'string)
 

-(defcustom gnus-message-setup-hook '(gnus-maybe-setup-default-charset)
+(defcustom gnus-message-setup-hook nil

   "Hook run after setting up a message buffer."
   :group 'gnus-message
   :type 'hook)
   "Hook run after setting up a message buffer."
   :group 'gnus-message
   :type 'hook)

@@ -120,6 +120,7 @@ the second with the current group name."
   "*Alist of styles to use when posting.
 See Info node `(gnus)Posting Styles'."
   :group 'gnus-message
   "*Alist of styles to use when posting.
 See Info node `(gnus)Posting Styles'."
   :group 'gnus-message

+  :link '(custom-manual "(gnus)Posting Styles")

   :type '(repeat (cons (choice (regexp)
                               (variable)
                               (list (const header)
   :type '(repeat (cons (choice (regexp)
                               (variable)
                               (list (const header)

@@ -135,6 +136,27 @@ See Info node `(gnus)Posting Styles'."
                                        (const x-face-file)
                                        (const name)
                                        (const body)
                                        (const x-face-file)
                                        (const name)
                                        (const body)

+                                       (const import)
+                                       (symbol)
+                                       (string :tag "Header"))
+                               (choice (string)
+                                       (function)
+                                       (variable)
+                                       (sexp)))))))
+
+(defcustom gnus-named-posting-styles nil
+  "Alist mapping names to the user-defined posting styles."
+  :group 'gnus-message
+  :type '(repeat (cons string
+                      (repeat (list
+                               (choice (const signature)
+                                       (const signature-file)
+                                       (const organization)
+                                       (const address)
+                                       (const x-face-file)
+                                       (const name)
+                                       (const body)
+                                       (const import)

                                        (symbol)
                                        (string :tag "Header"))
                                (choice (string)
                                        (symbol)
                                        (string :tag "Header"))
                                (choice (string)

@@ -158,19 +180,26 @@ See Info node `(gnus)Posting Styles'."
   "Should local-file attachments be included as external parts in Gcc copies?
 If it is `all', attach files as external parts;
 if a regexp and matches the Gcc group name, attach files as external parts;
   "Should local-file attachments be included as external parts in Gcc copies?
 If it is `all', attach files as external parts;
 if a regexp and matches the Gcc group name, attach files as external parts;

-If nil, attach files as normal parts."
+if nil, attach files as normal parts."

   :version "21.1"
   :group 'gnus-message
   :type '(choice (const nil :tag "None")
                 (const all :tag "Any")
                 (string :tag "Regexp")))
 
   :version "21.1"
   :group 'gnus-message
   :type '(choice (const nil :tag "None")
                 (const all :tag "Any")
                 (string :tag "Regexp")))
 

-(defcustom gnus-group-posting-charset-alist
-  '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
-    ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
-    (message-this-is-mail nil nil)
-    (message-this-is-news nil t))
-  "Alist of regexps and permitted unencoded charsets for posting.
+(gnus-define-group-parameter
+ posting-charset-alist
+ :type list
+ :function-document
+ "Return the permitted unencoded charsets for posting of GROUP."
+ :variable gnus-group-posting-charset-alist
+ :variable-default
+ '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
+   ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
+   (message-this-is-mail nil nil)
+   (message-this-is-news nil t))
+ :variable-document
+ "Alist of regexps and permitted unencoded charsets for posting.

 Each element of the alist has the form (TEST HEADER BODY-LIST), where
 TEST is either a regular expression matching the newsgroup header or a
 variable to query,
 Each element of the alist has the form (TEST HEADER BODY-LIST), where
 TEST is either a regular expression matching the newsgroup header or a
 variable to query,

@@ -182,22 +211,26 @@ nil (always encode using quoted-printable) or t (always use 8bit).
 
 Note that any value other than nil for HEADER infringes some RFCs, so
 use this option with care."
 
 Note that any value other than nil for HEADER infringes some RFCs, so
 use this option with care."

-  :type '(repeat (list :tag "Permitted unencoded charsets"
-                      (choice :tag "Where"
-                              (regexp :tag "Group")
-                              (const :tag "Mail message"
-                                     :value message-this-is-mail)
-                              (const :tag "News article"
-                                     :value message-this-is-news))
-                      (choice :tag "Header"
-                              (const :tag "None" nil)
-                              (symbol :tag "Charset"))
-                      (choice :tag "Body"
-                              (const :tag "Any" :value t)
-                              (const :tag "None" :value nil)
-                              (repeat :tag "Charsets"
-                                      (symbol :tag "Charset")))))
-  :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type
+ '(repeat (list :tag "Permitted unencoded charsets"
+               (choice :tag "Where"
+                       (regexp :tag "Group")
+                       (const :tag "Mail message" :value message-this-is-mail)
+                       (const :tag "News article" :value message-this-is-news))
+               (choice :tag "Header"
+                       (const :tag "None" nil)
+                       (symbol :tag "Charset"))
+               (choice :tag "Body"
+                       (const :tag "Any" :value t)
+                       (const :tag "None" :value nil)
+                       (repeat :tag "Charsets"
+                               (symbol :tag "Charset")))))
+ :parameter-type '(choice :tag "Permitted unencoded charsets"
+                         :value nil
+                         (repeat (symbol)))
+ :parameter-document       "\
+List of charsets that are permitted to be unencoded.")

 
 (defcustom gnus-debug-files
   '("gnus.el" "gnus-sum.el" "gnus-group.el"
 
 (defcustom gnus-debug-files
   '("gnus.el" "gnus-sum.el" "gnus-group.el"

@@ -228,14 +261,14 @@ This variable is used only when `gnus-post-method' is `current'."
 
 (defcustom gnus-message-replysign
   nil
 
 (defcustom gnus-message-replysign
   nil

-  "Automatically sign replys to signed messages.
+  "Automatically sign replies to signed messages.

 See also the `mml-default-sign-method' variable."
   :group 'gnus-message
   :type 'boolean)
 
 (defcustom gnus-message-replyencrypt
   nil
 See also the `mml-default-sign-method' variable."
   :group 'gnus-message
   :type 'boolean)
 
 (defcustom gnus-message-replyencrypt
   nil

-  "Automatically encrypt replys to encrypted messages.
+  "Automatically encrypt replies to encrypted messages.

 See also the `mml-default-encrypt-method' variable."
   :group 'gnus-message
   :type 'boolean)
 See also the `mml-default-encrypt-method' variable."
   :group 'gnus-message
   :type 'boolean)

@@ -249,15 +282,55 @@ See also the `mml-default-encrypt-method' variable."
 (defcustom gnus-confirm-mail-reply-to-news nil
   "If non-nil, Gnus requests confirmation when replying to news.
 This is done because new users often reply by mistake when reading
 (defcustom gnus-confirm-mail-reply-to-news nil
   "If non-nil, Gnus requests confirmation when replying to news.
 This is done because new users often reply by mistake when reading

-news."
+news.
+This can also be a function receiving the group name as the only
+parameter which should return non-nil iff a confirmation is needed, or
+a regexp, in which case a confirmation is asked for iff the group name
+matches the regexp."
+  :group 'gnus-message
+  :type '(choice (const :tag "No" nil)
+                (const :tag "Yes" t)
+                (regexp :tag "Iff group matches regexp")
+                (function :tag "Iff function evaluates to non-nil")))
+
+(defcustom gnus-confirm-treat-mail-like-news
+  nil
+  "If non-nil, Gnus will treat mail like news with regard to confirmation
+when replying by mail.  See the `gnus-confirm-mail-reply-to-news' variable
+for fine-tuning this.
+If nil, Gnus will never ask for confirmation if replying to mail."
+  :group 'gnus-message
+  :type 'boolean)
+
+(defcustom gnus-summary-resend-default-address t
+  "If non-nil, Gnus tries to suggest a default address to resend to.
+If nil, the address field will always be empty after invoking
+`gnus-summary-resend-message'."

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

+(defcustom gnus-user-agent 'full
+  "Which information should be exposed in the User-Agent header.
+
+It can be one of the symbols `full' \(show full information, i.e. Emacs and
+Gnus version and system configuration\), `emacs-gnus' \(show only Emacs and
+Gnus version\), `emacs-gnus-type' \(same as `emacs-gnus' plus system type\),
+`gnus' \(show only Gnus version\) or a custom string.  If you set it to a
+string, be sure to use a valid format, see RFC 2616."
+  :group 'gnus-message
+  :type '(choice (item :tag "Show full info" full)
+                (item :tag "Show Gnus and Emacs versions and system type"
+                      emacs-gnus-type)
+                (item :tag "Show Gnus and Emacs versions" emacs-gnus)
+                (item :tag "Show only Gnus version" gnus)
+                (string :tag "Other")))
+

 ;;; Internal variables.
 
 (defvar gnus-inhibit-posting-styles nil
   "Inhibit the use of posting styles.")
 
 ;;; Internal variables.
 
 (defvar gnus-inhibit-posting-styles nil
   "Inhibit the use of posting styles.")
 

+(defvar gnus-article-yanked-articles nil)

 (defvar gnus-message-buffer "*Mail Gnus*")
 (defvar gnus-article-copy nil)
 (defvar gnus-check-before-posting nil)
 (defvar gnus-message-buffer "*Mail Gnus*")
 (defvar gnus-article-copy nil)
 (defvar gnus-check-before-posting nil)

@@ -333,7 +406,8 @@ Thank you for your help in stamping out bugs.
   "om" gnus-summary-mail-forward
   "op" gnus-summary-post-forward
   "Om" gnus-summary-digest-mail-forward
   "om" gnus-summary-mail-forward
   "op" gnus-summary-post-forward
   "Om" gnus-summary-digest-mail-forward

-  "Op" gnus-summary-digest-post-forward)
+  "Op" gnus-summary-digest-post-forward
+  "P" gnus-summary-execute-command-with-posting-style)

 
 (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
   "b" gnus-summary-resend-bounced-mail
 
 (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
   "b" gnus-summary-resend-bounced-mail

@@ -343,15 +417,22 @@ Thank you for your help in stamping out bugs.
 
 ;;; Internal functions.
 
 
 ;;; Internal functions.
 

+(defun gnus-inews-make-draft ()
+  `(lambda ()
+     (gnus-inews-make-draft-meta-information
+      ,gnus-newsgroup-name ',gnus-article-reply)))
+

 (defvar gnus-article-reply nil)
 (defmacro gnus-setup-message (config &rest forms)
   (let ((winconf (make-symbol "gnus-setup-message-winconf"))
        (buffer (make-symbol "gnus-setup-message-buffer"))
        (article (make-symbol "gnus-setup-message-article"))
 (defvar gnus-article-reply nil)
 (defmacro gnus-setup-message (config &rest forms)
   (let ((winconf (make-symbol "gnus-setup-message-winconf"))
        (buffer (make-symbol "gnus-setup-message-buffer"))
        (article (make-symbol "gnus-setup-message-article"))

+       (yanked (make-symbol "gnus-setup-yanked-articles"))

        (group (make-symbol "gnus-setup-message-group")))
     `(let ((,winconf (current-window-configuration))
           (,buffer (buffer-name (current-buffer)))
           (,article gnus-article-reply)
        (group (make-symbol "gnus-setup-message-group")))
     `(let ((,winconf (current-window-configuration))
           (,buffer (buffer-name (current-buffer)))
           (,article gnus-article-reply)

+          (,yanked gnus-article-yanked-articles)

           (,group gnus-newsgroup-name)
           (message-header-setup-hook
            (copy-sequence message-header-setup-hook))
           (,group gnus-newsgroup-name)
           (message-header-setup-hook
            (copy-sequence message-header-setup-hook))

@@ -372,33 +453,37 @@ Thank you for your help in stamping out bugs.
        (add-hook 'message-mode-hook
                 (lambda ()
                   (gnus-configure-posting-styles ,group)))
        (add-hook 'message-mode-hook
                 (lambda ()
                   (gnus-configure-posting-styles ,group)))

+       (gnus-pull ',(intern gnus-draft-meta-information-header)
+                 message-required-headers)
+       (when (and ,group
+                 (not (string= ,group "")))
+        (push (cons
+               (intern gnus-draft-meta-information-header)
+               (gnus-inews-make-draft))
+              message-required-headers))

        (unwind-protect
           (progn
             ,@forms)
        (unwind-protect
           (progn
             ,@forms)

-        (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config)
-        (gnus-inews-insert-draft-meta-information ,group ,article)
+        (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+                                     ,yanked)

         (setq gnus-message-buffer (current-buffer))
         (set (make-local-variable 'gnus-message-group-art)
              (cons ,group ,article))
         (set (make-local-variable 'gnus-newsgroup-name) ,group)
         (setq gnus-message-buffer (current-buffer))
         (set (make-local-variable 'gnus-message-group-art)
              (cons ,group ,article))
         (set (make-local-variable 'gnus-newsgroup-name) ,group)

+        (gnus-maybe-setup-default-charset)

         (gnus-run-hooks 'gnus-message-setup-hook))
        (gnus-add-buffer)
        (gnus-configure-windows ,config t)
        (run-hooks 'post-command-hook)
        (set-buffer-modified-p nil))))
 
         (gnus-run-hooks 'gnus-message-setup-hook))
        (gnus-add-buffer)
        (gnus-configure-windows ,config t)
        (run-hooks 'post-command-hook)
        (set-buffer-modified-p nil))))
 

-(defun gnus-inews-insert-draft-meta-information (group article)
-  (save-excursion
-    (when (and group
-              (not (string= group ""))
-              (not (message-fetch-field gnus-draft-meta-information-header)))
-      (goto-char (point-min))
-      (insert gnus-draft-meta-information-header ": (\"" group "\" "
-             (if article (number-to-string
-                          (if (listp article)
-                              (car article)
-                            article)) "\"\"")
-             ")\n"))))
+(defun gnus-inews-make-draft-meta-information (group article)
+  (concat "(\"" group "\" "
+         (if article (number-to-string
+                      (if (listp article)
+                          (car article)
+                        article)) "\"\"")
+         ")"))

 
 ;;;###autoload
 (defun gnus-msg-mail (&optional to subject other-headers continue
 
 ;;;###autoload
 (defun gnus-msg-mail (&optional to subject other-headers continue

@@ -461,7 +546,8 @@ Gcc: header for archiving purposes."
                         (symbol-value (car elem))))
            (throw 'found (cons (cadr elem) (caddr elem)))))))))
 
                         (symbol-value (car elem))))
            (throw 'found (cons (cadr elem) (caddr elem)))))))))
 

-(defun gnus-inews-add-send-actions (winconf buffer article &optional config)
+(defun gnus-inews-add-send-actions (winconf buffer article
+                                           &optional config yanked)

   (make-local-hook 'message-sent-hook)
   (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
                                 'gnus-inews-do-gcc) nil t)
   (make-local-hook 'message-sent-hook)
   (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
                                 'gnus-inews-do-gcc) nil t)

@@ -475,15 +561,19 @@ Gcc: header for archiving purposes."
   (when (not message-use-multi-frames)
     (message-add-action
      `(set-window-configuration ,winconf) 'exit 'postpone 'kill))
   (when (not message-use-multi-frames)
     (message-add-action
      `(set-window-configuration ,winconf) 'exit 'postpone 'kill))

-  (message-add-action
-   `(when (gnus-buffer-exists-p ,buffer)
-      (save-excursion
-       (set-buffer ,buffer)
-       ,(when article
-          (if (eq config 'forward)
-              `(gnus-summary-mark-article-as-forwarded ',article)
-            `(gnus-summary-mark-article-as-replied ',article)))))
-   'send))
+  (let ((to-be-marked (cond
+                      (yanked yanked)
+                      (article (if (listp article) article (list article)))
+                      (t nil))))
+    (message-add-action
+     `(when (gnus-buffer-exists-p ,buffer)
+       (save-excursion
+         (set-buffer ,buffer)
+         ,(when to-be-marked
+            (if (eq config 'forward)
+                `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
+              `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
+     'send)))

 
 (put 'gnus-setup-message 'lisp-indent-function 1)
 (put 'gnus-setup-message 'edebug-form-spec '(form body))
 
 (put 'gnus-setup-message 'lisp-indent-function 1)
 (put 'gnus-setup-message 'edebug-form-spec '(form body))

@@ -565,7 +655,8 @@ a news."
           ""))
        ;; make sure last viewed article doesn't affect posting styles:
        (gnus-article-copy))
           ""))
        ;; make sure last viewed article doesn't affect posting styles:
        (gnus-article-copy))

-    (gnus-post-news 'post gnus-newsgroup-name)))
+    (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
+                   (string= gnus-newsgroup-name ""))))

 
 (defun gnus-summary-mail-other-window (&optional arg)
   "Start composing a mail in another window.
 
 (defun gnus-summary-mail-other-window (&optional arg)
   "Start composing a mail in another window.

@@ -668,7 +759,8 @@ yanked."
     ;; Send a followup.
     (gnus-post-news nil gnus-newsgroup-name
                    headers gnus-article-buffer
     ;; Send a followup.
     (gnus-post-news nil gnus-newsgroup-name
                    headers gnus-article-buffer

-                   yank nil force-news)))
+                   yank nil force-news)
+    (gnus-summary-handle-replysign)))

 
 (defun gnus-summary-followup-with-original (n &optional force-news)
   "Compose a followup to an article and include the original article."
 
 (defun gnus-summary-followup-with-original (n &optional force-news)
   "Compose a followup to an article and include the original article."

@@ -719,8 +811,7 @@ yanked."
             (with-current-buffer gnus-article-copy
               (save-restriction
                 (nnheader-narrow-to-headers)
             (with-current-buffer gnus-article-copy
               (save-restriction
                 (nnheader-narrow-to-headers)

-                (ietf-drums-unfold-fws)
-                (nnheader-parse-head t)))))
+                (nnheader-parse-naked-head)))))

        (message-yank-original)
        (setq beg (or beg (mark t))))
       (when articles
        (message-yank-original)
        (setq beg (or beg (mark t))))
       (when articles

@@ -774,8 +865,7 @@ post using the current select method."
 This is done simply by taking the old article and adding a Supersedes
 header line with the old Message-ID."
   (interactive)
 This is done simply by taking the old article and adding a Supersedes
 header line with the old Message-ID."
   (interactive)

-  (let ((article (gnus-summary-article-number))
-       (gnus-message-setup-hook '(gnus-maybe-setup-default-charset)))
+  (let ((article (gnus-summary-article-number)))

     (gnus-setup-message 'reply-yank
       (gnus-summary-select-article t)
       (set-buffer gnus-original-article-buffer)
     (gnus-setup-message 'reply-yank
       (gnus-summary-select-article t)
       (set-buffer gnus-original-article-buffer)

@@ -797,6 +887,9 @@ header line with the old Message-ID."
   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
   ;; this buffer should be passed to all mail/news reply/post routines.
   (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
   ;; this buffer should be passed to all mail/news reply/post routines.
   (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))

+  (save-excursion
+    (set-buffer gnus-article-copy)
+    (set-buffer-multibyte t))

   (let ((article-buffer (or article-buffer gnus-article-buffer))
        end beg)
     (if (not (and (get-buffer article-buffer)
   (let ((article-buffer (or article-buffer gnus-article-buffer))
        end beg)
     (if (not (and (get-buffer article-buffer)

@@ -813,43 +906,51 @@ header line with the old Message-ID."
            ;; Copy over the (displayed) article buffer, delete
            ;; hidden text and remove text properties.
            (widen)
            ;; Copy over the (displayed) article buffer, delete
            ;; hidden text and remove text properties.
            (widen)

-           (let ((inhibit-read-only t))
-             (copy-to-buffer gnus-article-copy (point-min) (point-max))
-             (set-buffer gnus-article-copy)
-             (when yank-string
-               (message-goto-body)
-               (delete-region (point) (point-max))
-               (insert yank-string))
-             ;; Encode bitmap smileys to ordinary text.
-             ;; Possibly, the original text might be restored.
-             (static-unless (featurep 'xemacs)
-               (when (featurep 'smiley-mule)
-                 (smiley-encode-buffer)))
-             (gnus-article-delete-text-of-type 'annotation)
-             (gnus-remove-text-with-property 'gnus-prev)
-             (gnus-remove-text-with-property 'gnus-next)
-             (gnus-remove-text-with-property 'gnus-decoration)
-             (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
-             (insert
-              (prog1
-                  (static-if (featurep 'xemacs)
-                      ;; Revome smiley extents for (possibly) XEmacs 21.1.
-                      (format "%s"
-                              (buffer-substring-no-properties (point-min)
-                                                              (point-max)))
-                    (buffer-substring-no-properties (point-min) (point-max)))
-                (erase-buffer))))
+           (copy-to-buffer gnus-article-copy (point-min) (point-max))
+           (set-buffer gnus-article-copy)
+           ;; There's invisible and intangible text in T-gnus.  Especially,
+           ;; if there is a boundary line (X-Boundary: ------------------),
+           ;; in the end of a header, it will cause a serious problem.
+           (add-text-properties (point-min) (point-max)
+                                '(invisible nil intangible nil))
+           (when yank-string
+             (message-goto-body)
+             (delete-region (point) (point-max))
+             (insert yank-string))
+           ;; Encode bitmap smileys to ordinary text.
+           ;; Possibly, the original text might be restored.
+           (static-unless (featurep 'xemacs)
+             (when (featurep 'smiley-mule)
+               (smiley-encode-buffer)))
+           (gnus-article-delete-text-of-type 'annotation)
+           (gnus-remove-text-with-property 'gnus-prev)
+           (gnus-remove-text-with-property 'gnus-next)
+           (gnus-remove-text-with-property 'gnus-decoration)
+           (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
+           (insert
+            (prog1
+                (static-if (featurep 'xemacs)
+                    ;; Revome smiley extents for (possibly) XEmacs 21.1.
+                    (format "%s"
+                            (buffer-substring-no-properties (point-min)
+                                                            (point-max)))
+                  (buffer-substring-no-properties (point-min) (point-max)))
+              (erase-buffer)))

            ;; Find the original headers.
            (set-buffer gnus-original-article-buffer)
            (goto-char (point-min))
            (while (looking-at message-unix-mail-delimiter)
              (forward-line 1))
            ;; Find the original headers.
            (set-buffer gnus-original-article-buffer)
            (goto-char (point-min))
            (while (looking-at message-unix-mail-delimiter)
              (forward-line 1))

-           (setq beg (point)
-                 end (or (message-goto-body) beg))
+           (let ((mail-header-separator ""))
+             (setq beg (point)
+                   end (or (message-goto-body)
+                           ;; There may be just a header.
+                           (point-max))))

            ;; Delete the headers from the displayed articles.
            (set-buffer gnus-article-copy)
            ;; Delete the headers from the displayed articles.
            (set-buffer gnus-article-copy)

-           (delete-region (goto-char (point-min))
-                          (or (message-goto-body) (point-max)))
+           (let ((mail-header-separator ""))
+             (delete-region (goto-char (point-min))
+                            (or (message-goto-body) (point-max))))

            ;; Insert the original article headers.
            (insert-buffer-substring gnus-original-article-buffer beg end)
            ;; Decode charsets.
            ;; Insert the original article headers.
            (insert-buffer-substring gnus-original-article-buffer beg end)
            ;; Decode charsets.

@@ -867,6 +968,7 @@ header line with the old Message-ID."
   (when article-buffer
     (gnus-copy-article-buffer))
   (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
   (when article-buffer
     (gnus-copy-article-buffer))
   (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))

+       (gnus-article-yanked-articles yank)

        (add-to-list gnus-add-to-list))
     (gnus-setup-message (cond (yank 'reply-yank)
                              (article-buffer 'reply)
        (add-to-list gnus-add-to-list))
     (gnus-setup-message (cond (yank 'reply-yank)
                              (article-buffer 'reply)

@@ -925,7 +1027,7 @@ header line with the old Message-ID."
          (gnus-inews-yank-articles yank))))))
 
 (defun gnus-msg-treat-broken-reply-to (&optional force)
          (gnus-inews-yank-articles yank))))))
 
 (defun gnus-msg-treat-broken-reply-to (&optional force)

-  "Remove the Reply-to header iff broken-reply-to."
+  "Remove the Reply-to header if broken-reply-to."

   (when (or force
            (gnus-group-find-parameter
             gnus-newsgroup-name 'broken-reply-to))
   (when (or force
            (gnus-group-find-parameter
             gnus-newsgroup-name 'broken-reply-to))

@@ -1114,15 +1216,23 @@ If VERY-WIDE, make a very wide reply."
    (list (and current-prefix-arg
              (gnus-summary-work-articles 1))))
   ;; Allow user to require confirmation before replying by mail to the
    (list (and current-prefix-arg
              (gnus-summary-work-articles 1))))
   ;; Allow user to require confirmation before replying by mail to the

-  ;; author of a news article.
-  (when (or (not (gnus-news-group-p gnus-newsgroup-name))
-           (not gnus-confirm-mail-reply-to-news)
+  ;; author of a news article (or mail message).
+  (when (or 
+           (not (or (gnus-news-group-p gnus-newsgroup-name)
+                    gnus-confirm-treat-mail-like-news))
+           (not (cond ((stringp gnus-confirm-mail-reply-to-news)
+                       (string-match gnus-confirm-mail-reply-to-news
+                                     gnus-newsgroup-name))
+                      ((functionp gnus-confirm-mail-reply-to-news)
+                       (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
+                      (t gnus-confirm-mail-reply-to-news)))

            (y-or-n-p "Really reply by mail to article author? "))
     (let* ((article
            (if (listp (car yank))
                (caar yank)
              (car yank)))
           (gnus-article-reply (or article (gnus-summary-article-number)))
            (y-or-n-p "Really reply by mail to article author? "))
     (let* ((article
            (if (listp (car yank))
                (caar yank)
              (car yank)))
           (gnus-article-reply (or article (gnus-summary-article-number)))

+          (gnus-article-yanked-articles yank)

           (headers ""))
       ;; Stripping headers should be specified with mail-yank-ignored-headers.
       (when yank
           (headers ""))
       ;; Stripping headers should be specified with mail-yank-ignored-headers.
       (when yank

@@ -1149,20 +1259,23 @@ If VERY-WIDE, make a very wide reply."
        (message-reply nil wide)
        (when yank
          (gnus-inews-yank-articles yank))
        (message-reply nil wide)
        (when yank
          (gnus-inews-yank-articles yank))

-;;     (when (or gnus-message-replysign gnus-message-replyencrypt)
-;;       (let (signed encrypted)
-;;         (save-excursion
-;;           (set-buffer gnus-article-buffer)
-;;           (setq signed (memq 'signed gnus-article-wash-types))
-;;           (setq encrypted (memq 'encrypted gnus-article-wash-types)))
-;;         (cond ((and gnus-message-replysign signed)
-;;                (mml-secure-message mml-default-sign-method 'sign))
-;;               ((and gnus-message-replyencrypt encrypted)
-;;                (mml-secure-message mml-default-encrypt-method
-;;                                    (if gnus-message-replysignencrypted
-;;                                        'signencrypt
-;;                                      'encrypt))))))
-       ))))
+       (gnus-summary-handle-replysign)))))
+
+(defun gnus-summary-handle-replysign ()
+  "Check the various replysign variables and take action accordingly."
+  (when nil;;(or gnus-message-replysign gnus-message-replyencrypt)
+    (let (signed encrypted)
+      (save-excursion
+       (set-buffer gnus-article-buffer)
+       (setq signed (memq 'signed gnus-article-wash-types))
+       (setq encrypted (memq 'encrypted gnus-article-wash-types)))
+      (cond ((and gnus-message-replyencrypt encrypted)
+            (mml-secure-message mml-default-encrypt-method
+                                (if gnus-message-replysignencrypted
+                                    'signencrypt
+                                  'encrypt)))
+           ((and gnus-message-replysign signed)
+            (mml-secure-message mml-default-sign-method 'sign))))))

 
 (defun gnus-summary-reply-with-original (n &optional wide)
   "Start composing a reply mail to the current message.
 
 (defun gnus-summary-reply-with-original (n &optional wide)
   "Start composing a reply mail to the current message.

@@ -1227,17 +1340,22 @@ If FULL-HEADERS (the prefix), include full headers when forwarding.
 Note that this function definition for T-gnus is totally different
 from the original Gnus."
   (interactive "P")
 Note that this function definition for T-gnus is totally different
 from the original Gnus."
   (interactive "P")

-  (if (null (cdr (gnus-summary-work-articles nil)))
+  (if (cdr (gnus-summary-work-articles nil))
+      ;; Process marks are given.
+      (gnus-summary-digest-mail-forward nil post)
+    ;; No process marks.
+    (let* ((gnus-article-reply (gnus-summary-article-number))
+          (gnus-article-yanked-articles (list gnus-article-reply))
+          charset
+          (message-included-forward-headers
+           (if full-headers "" message-included-forward-headers)))

       (gnus-setup-message 'forward
        (gnus-summary-select-article)
       (gnus-setup-message 'forward
        (gnus-summary-select-article)

-       (let ((charset default-mime-charset))
-         (set-buffer gnus-original-article-buffer)
-         (make-local-variable 'default-mime-charset)
-         (setq default-mime-charset charset))
-       (let ((message-included-forward-headers
-              (if full-headers "" message-included-forward-headers)))
-         (message-forward post)))
-    (gnus-summary-digest-mail-forward nil post)))
+       (setq charset default-mime-charset)
+       (set-buffer gnus-original-article-buffer)
+       (make-local-variable 'default-mime-charset)
+       (setq default-mime-charset charset)
+       (message-forward post)))))

 
 (defun gnus-summary-digest-mail-forward (&optional n post)
   "Digests and forwards all articles in this series.
 
 (defun gnus-summary-digest-mail-forward (&optional n post)
   "Digests and forwards all articles in this series.

@@ -1247,9 +1365,10 @@ If N is nil and any articles have been marked with the process mark,
 forward those articles instead.
 Optional POST will use news to forward instead of mail."
   (interactive "P")
 forward those articles instead.
 Optional POST will use news to forward instead of mail."
   (interactive "P")

-  (let ((articles (gnus-summary-work-articles n))
-       (topics "Topics:\n")
-       subject article frame)
+  (let* ((articles (gnus-summary-work-articles n))
+        (gnus-article-yanked-articles (copy-sequence articles))
+        (topics "Topics:\n")
+        subject article frame)

     (when (car articles)
       (gnus-setup-message 'forward
        (gnus-summary-select-article)
     (when (car articles)
       (gnus-setup-message 'forward
        (gnus-summary-select-article)

@@ -1302,7 +1421,8 @@ forward those articles instead."
   (interactive
    (list (message-read-from-minibuffer
          "Resend message(s) to: "
   (interactive
    (list (message-read-from-minibuffer
          "Resend message(s) to: "

-         (when (gnus-buffer-live-p gnus-original-article-buffer)
+         (when (and gnus-summary-resend-default-address
+                    (gnus-buffer-live-p gnus-original-article-buffer))

            ;; If some other article is currently selected, the
            ;; initial-contents is wrong. Whatever, it is just the
            ;; initial-contents.
            ;; If some other article is currently selected, the
            ;; initial-contents is wrong. Whatever, it is just the
            ;; initial-contents.

@@ -1486,7 +1606,9 @@ The current group name will be inserted at \"%s\".")
               message-required-news-headers
             message-required-mail-headers)))
        (goto-char (point-max))
               message-required-news-headers
             message-required-mail-headers)))
        (goto-char (point-max))

-       (insert "Gcc: " group "\n")
+       (if (string-match " " group)
+           (insert "Gcc: \"" group "\"\n")
+         (insert "Gcc: " group "\n"))

        (widen)))
     (gnus-inews-do-gcc)
     (when (and (get-buffer gnus-group-buffer)
        (widen)))
     (gnus-inews-do-gcc)
     (when (and (get-buffer gnus-group-buffer)

@@ -1629,17 +1751,15 @@ The source file has to be in the Emacs load path."
       (insert ";----------------- Environment follows ------------------\n\n"))
     (while olist
       (if (boundp (car olist))
       (insert ";----------------- Environment follows ------------------\n\n"))
     (while olist
       (if (boundp (car olist))

-         (condition-case ()
-             (pp `(setq ,(car olist)
-                        ,(if (or (consp (setq sym (symbol-value (car olist))))
-                                 (and (symbolp sym)
-                                      (not (or (eq sym nil)
-                                               (eq sym t)))))
-                             (list 'quote (symbol-value (car olist)))
-                           (symbol-value (car olist))))
-                 (current-buffer))
-           (error
-            (format "(setq %s 'whatever)\n" (car olist))))
+         (ignore-errors
+           (pp `(setq ,(car olist)
+                      ,(if (or (consp (setq sym (symbol-value (car olist))))
+                               (and (symbolp sym)
+                                    (not (or (eq sym nil)
+                                             (eq sym t)))))
+                           (list 'quote (symbol-value (car olist)))
+                         (symbol-value (car olist))))
+               (current-buffer)))

        (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
       (setq olist (cdr olist)))
     ;; Remove any control chars - they seem to cause trouble for some
        (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
       (setq olist (cdr olist)))
     ;; Remove any control chars - they seem to cause trouble for some

@@ -1667,15 +1787,14 @@ this is a reply."
   (interactive "P")
   (gnus-summary-select-article t)
   (set-buffer gnus-original-article-buffer)
   (interactive "P")
   (gnus-summary-select-article t)
   (set-buffer gnus-original-article-buffer)

-  (let ((gnus-message-setup-hook '(gnus-maybe-setup-default-charset)))
-    (gnus-setup-message 'compose-bounce
-      (let* ((references (mail-fetch-field "references"))
-            (parent (and references (gnus-parent-id references))))
-       (message-bounce)
-       ;; If there are references, we fetch the article we answered to.
-       (and fetch parent
-            (gnus-summary-refer-article parent)
-            (gnus-summary-show-all-headers))))))
+  (gnus-setup-message 'compose-bounce
+    (let* ((references (mail-fetch-field "references"))
+          (parent (and references (gnus-parent-id references))))
+      (message-bounce)
+      ;; If there are references, we fetch the article we answered to.
+      (and fetch parent
+          (gnus-summary-refer-article parent)
+          (gnus-summary-show-all-headers)))))

 
 ;;; Gcc handling.
 
 
 ;;; Gcc handling.
 

@@ -1736,6 +1855,9 @@ this is a reply."
                              group (gnus-status-message method))
                (sit-for 2))
              (when (and group-art
                              group (gnus-status-message method))
                (sit-for 2))
              (when (and group-art

+                        ;; FIXME: Should gcc-mark-as-read work when
+                        ;; Gnus is not running?
+                        (gnus-alive-p)

                         (or gnus-gcc-mark-as-read
                             gnus-inews-mark-gcc-as-read))
                (gnus-group-mark-article-read group (cdr group-art)))
                         (or gnus-gcc-mark-as-read
                             gnus-inews-mark-gcc-as-read))
                (gnus-group-mark-article-read group (cdr group-art)))

@@ -1754,8 +1876,15 @@ this is a reply."
                    group))))
        (when gcc
          (insert "Gcc: "
                    group))))
        (when gcc
          (insert "Gcc: "

-                 (if (stringp gcc) gcc
-                   (mapconcat 'identity gcc " "))
+                 (if (stringp gcc)
+                     (if (string-match " " gcc)
+                         (concat "\"" gcc "\"")
+                       gcc)
+                   (mapconcat (lambda (group)
+                                (if (string-match " " group)
+                                    (concat "\"" group "\"")
+                                  group))
+                              gcc " "))

                  "\n"))))))
 
 (defun gnus-inews-insert-archive-gcc (&optional group)
                  "\n"))))))
 
 (defun gnus-inews-insert-archive-gcc (&optional group)

@@ -1816,8 +1945,12 @@ this is a reply."
              (progn
                (insert
                 (if (stringp gcc-self-val)
              (progn
                (insert
                 (if (stringp gcc-self-val)

-                    gcc-self-val
-                  group))
+                    (if (string-match " " gcc-self-val)
+                        (concat "\"" gcc-self-val "\"")
+                      gcc-self-val)
+                  (if (string-match " " group)
+                      (concat "\"" group "\"")
+                    group)))

                (if (not (eq gcc-self-val 'none))
                    (insert "\n")
                  (progn
                (if (not (eq gcc-self-val 'none))
                    (insert "\n")
                  (progn

@@ -1825,14 +1958,27 @@ this is a reply."
                    (kill-line))))
            ;; Use the list of groups.
            (while (setq name (pop groups))
                    (kill-line))))
            ;; Use the list of groups.
            (while (setq name (pop groups))

-             (insert (if (string-match ":" name)
-                         name
-                       (gnus-group-prefixed-name
-                        name gnus-message-archive-method)))
+             (let ((str (if (string-match ":" name)
+                            name
+                          (gnus-group-prefixed-name
+                           name gnus-message-archive-method))))
+               (insert (if (string-match " " str)
+                           (concat "\"" str "\"")
+                         str)))

              (when groups
                (insert " ")))
            (insert "\n")))))))
 
              (when groups
                (insert " ")))
            (insert "\n")))))))
 

+(defun gnus-mailing-list-followup-to ()
+  "Look at the headers in the current buffer and return a Mail-Followup-To address."
+  (let ((x-been-there (gnus-fetch-original-field "x-beenthere"))
+       (list-post (gnus-fetch-original-field "list-post")))
+    (when (and list-post
+              (string-match "mailto:\\([^>]+\\)" list-post))
+      (setq list-post (match-string 1 list-post)))
+    (or list-post
+       x-been-there)))
+

 ;;; Posting styles.
 
 (defun gnus-configure-posting-styles (&optional group-name)
 ;;; Posting styles.
 
 (defun gnus-configure-posting-styles (&optional group-name)

@@ -1840,8 +1986,8 @@ this is a reply."
   (unless gnus-inhibit-posting-styles
     (let ((group (or group-name gnus-newsgroup-name ""))
          (styles gnus-posting-styles)
   (unless gnus-inhibit-posting-styles
     (let ((group (or group-name gnus-newsgroup-name ""))
          (styles gnus-posting-styles)

-         style match variable attribute value v results
-         filep name address element)
+         style match attribute results
+         name address)

       ;; If the group has a posting-style parameter, add it at the end with a
       ;; regexp matching everything, to be sure it takes precedence over all
       ;; the others.
       ;; If the group has a posting-style parameter, add it at the end with a
       ;; regexp matching everything, to be sure it takes precedence over all
       ;; the others.

@@ -1886,56 +2032,18 @@ this is a reply."
                  ;; This is a form to be evaled.
                  (eval match)))))
          ;; We have a match, so we set the variables.
                  ;; This is a form to be evaled.
                  (eval match)))))
          ;; We have a match, so we set the variables.

+         (setq style (gnus-configure-posting-style style nil))

          (dolist (attribute style)
          (dolist (attribute style)

-           (setq element (pop attribute)
-                 variable nil
-                 filep nil)
-           (setq value
-                 (cond
-                  ((eq (car attribute) ':file)
-                   (setq filep t)
-                   (cadr attribute))
-                  ((eq (car attribute) :value)
-                   (cadr attribute))
-                  (t
-                   (car attribute))))
-           ;; We get the value.
-           (setq v
-                 (cond
-                  ((stringp value)
-                   value)
-                  ((or (symbolp value)
-                       (gnus-functionp value))
-                   (cond ((gnus-functionp value)
-                          (funcall value))
-                         ((boundp value)
-                          (symbol-value value))))
-                  ((listp value)
-                   (eval value))))
-           ;; Translate obsolescent value.
-           (cond
-            ((eq element 'signature-file)
-             (setq element 'signature
-                   filep t))
-            ((eq element 'x-face-file)
-             (setq element 'x-face
-                   filep t)))
-           ;; Get the contents of file elems.
-           (when (and filep v)
-             (setq v (with-temp-buffer
-                       (insert-file-contents v)
-                       (goto-char (point-max))
-                       (while (bolp)
-                         (delete-char -1))
-                       (buffer-string))))
-           (setq results (delq (assoc element results) results))
-           (push (cons element v) results))))
+           (setq results (delq (assoc (car attribute) results) results))
+           (push attribute results))))

       ;; Now we have all the styles, so we insert them.
       (setq name (assq 'name results)
            address (assq 'address results))
       (setq results (delq name (delq address results)))
       ;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
       (make-local-hook 'message-setup-hook)
       ;; Now we have all the styles, so we insert them.
       (setq name (assq 'name results)
            address (assq 'address results))
       (setq results (delq name (delq address results)))
       ;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
       (make-local-hook 'message-setup-hook)

+      (setq results (sort results (lambda (x y)
+                                   (string-lessp (car x) (car y)))))

       (dolist (result results)
        (add-hook 'message-setup-hook
                  (cond
       (dolist (result results)
        (add-hook 'message-setup-hook
                  (cond

@@ -1967,7 +2075,9 @@ this is a reply."
                           (let ((value ,(cdr result)))
                             (when value
                               (message-goto-eoh)
                           (let ((value ,(cdr result)))
                             (when value
                               (message-goto-eoh)

-                              (insert ,header ": " value "\n"))))))))
+                              (insert ,header ": " value)
+                              (unless (bolp)
+                                (insert "\n")))))))))

                  nil 'local))
       (when (or name address)
        (add-hook 'message-setup-hook
                  nil 'local))
       (when (or name address)
        (add-hook 'message-setup-hook

@@ -1983,6 +2093,76 @@ this is a reply."
                         (insert "From: " (message-make-from) "\n"))))
                  nil 'local)))))
 
                         (insert "From: " (message-make-from) "\n"))))
                  nil 'local)))))
 

+;; splitted from gnus-configure-posting-styles to allow recursive traversal.
+(defun gnus-configure-posting-style (style stack)
+  "Parse one posting style STYLE and returns the value as an alist."
+  (let (results element variable filep value v)
+    (dolist (attribute style)
+      (setq element (pop attribute)
+           variable nil
+           filep nil)
+      (setq value
+           (cond
+            ((eq (car attribute) ':file)
+             (setq filep t)
+             (cadr attribute))
+            ((eq (car attribute) :value)
+             (cadr attribute))
+            (t
+             (car attribute))))
+      ;; We get the value.
+      (setq v
+           (cond
+            ((stringp value)
+             value)
+            ((or (symbolp value)
+                 (gnus-functionp value))
+             (cond ((gnus-functionp value)
+                    (funcall value))
+                   ((boundp value)
+                    (symbol-value value))))
+            ((listp value)
+             (eval value))))
+      ;; Translate obsolescent value.
+      (cond
+       ((eq element 'signature-file)
+       (setq element 'signature
+             filep t))
+       ((eq element 'x-face-file)
+       (setq element 'x-face
+             filep t)))
+      ;; Get the contents of file elems.
+      (when (and filep v)
+       (setq v (with-temp-buffer
+                 (insert-file-contents v)
+                 (goto-char (point-max))
+                 (while (bolp)
+                   (delete-char -1))
+                 (buffer-string))))
+      (if (eq element 'import)
+         (progn
+           (if (member v stack)
+               (error "Circular import of \"%s\"" v))
+           (setq results
+                 (nconc (nreverse (gnus-configure-posting-style
+                                   (cdr (assoc v gnus-named-posting-styles))
+                                   (cons v stack)))
+                        results)))
+       (push (cons element v) results)))
+    (nreverse results)))
+
+(defun gnus-summary-execute-command-with-posting-style (style command)
+  "Temporarily select a posting-style named STYLE and execute COMMAND."
+  (interactive
+   (let ((style (completing-read "Posting style: "
+                                gnus-named-posting-styles nil t)))
+     (list style
+          (key-binding
+           (read-key-sequence
+            (format "Command to execute with %s: " style))))))
+  (let ((gnus-posting-styles (list (list ".*" (list 'import style)))))
+    (call-interactively command)))
+

 
 ;;; @ for MIME Edit mode
 ;;;
 
 ;;; @ for MIME Edit mode
 ;;;