This commit was generated by cvs2svn to compensate for changes in r6200,

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

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 4bd55a6..116ad34 100644 (file)
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -1,9 +1,11 @@
-;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+;;; gnus-msg.el --- mail and post interface for Semi-gnus
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.

 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>

-;; Keywords: news
+;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;     Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Keywords: mail, news, MIME

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 

@@ -33,12 +35,12 @@
 (require 'message)
 (require 'gnus-art)
 
 (require 'message)
 (require 'gnus-art)
 

-(defcustom gnus-post-method 'current
+(defcustom gnus-post-method nil

   "*Preferred method for posting USENET news.
 
 If this variable is `current', Gnus will use the \"current\" select
 method when posting.  If it is nil (which is the default), Gnus will
   "*Preferred method for posting USENET news.
 
 If this variable is `current', Gnus will use the \"current\" select
 method when posting.  If it is nil (which is the default), Gnus will

-use the native select method when posting.
+use the native posting method of the server.

 
 This method will not be used in mail groups and the like, only in
 \"real\" newsgroups.
 
 This method will not be used in mail groups and the like, only in
 \"real\" newsgroups.

@@ -100,16 +102,13 @@ the second with the current group name.")
 (defvar gnus-posting-styles nil
   "*Alist of styles to use when posting.")
 
 (defvar gnus-posting-styles nil
   "*Alist of styles to use when posting.")
 

-(defcustom gnus-group-posting-charset-alist
-  '(("^no\\." iso-8859-1)
-    (message-this-is-mail nil)
-    ("^de\\." nil)
-    (".*" iso-8859-1)
-    (message-this-is-news iso-8859-1))
-  "Alist of regexps (to match group names) and default charsets to be unencoded when posting."
-  :type '(repeat (list (regexp :tag "Group")
-                      (symbol :tag "Charset")))
-  :group 'gnus-charset)
+(defvar gnus-posting-style-alist
+  '((organization . message-user-organization)
+    (signature . message-signature)
+    (signature-file . message-signature-file)
+    (address . user-mail-address)
+    (name . user-full-name))
+  "*Mapping from style parameters to variables.")

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

@@ -122,16 +121,21 @@ the second with the current group name.")
 (defvar gnus-message-group-art nil)
 
 (defconst gnus-bug-message
 (defvar gnus-message-group-art nil)
 
 (defconst gnus-bug-message

-  "Sending a bug report to the Gnus Towers.
+  (format "Sending a bug report to the Gnus Towers.
+========================================
+
+This gnus is the %s%s.
+If you think the bug is a Semi-gnus bug, send a bug report to Semi-gnus
+Developers. (the addresses below are mailing list addresses)
+

 ========================================
 
 The buffer below is a mail buffer.  When you press `C-c C-c', it will
 be sent to the Gnus Bug Exterminators.
 
 ========================================
 
 The buffer below is a mail buffer.  When you press `C-c C-c', it will
 be sent to the Gnus Bug Exterminators.
 

-The thing near the bottom of the buffer is how the environment
-settings will be included in the mail.  Please do not delete that.
-They will tell the Bug People what your environment is, so that it
-will be easier to locate the bugs.
+At the bottom of the buffer you'll see lots of variable settings.
+Please do not delete those.  They will tell the Bug People what your
+environment is, so that it will be easier to locate the bugs.

 
 If you have found a bug that makes Emacs go \"beep\", set
 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
 
 If you have found a bug that makes Emacs go \"beep\", set
 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')

@@ -140,7 +144,12 @@ and include the backtrace in your bug report.
 Please describe the bug in annoying, painstaking detail.
 
 Thank you for your help in stamping out bugs.
 Please describe the bug in annoying, painstaking detail.
 
 Thank you for your help in stamping out bugs.

-")
+"
+
+         gnus-product-name
+         (if (string= gnus-product-name "Semi-gnus")
+             ""
+           ", a modified version of Semi-gnus")))

 
 (eval-and-compile
   (autoload 'gnus-uu-post-news "gnus-uu" nil t)
 
 (eval-and-compile
   (autoload 'gnus-uu-post-news "gnus-uu" nil t)

@@ -161,7 +170,6 @@ Thank you for your help in stamping out bugs.
   "c" gnus-summary-cancel-article
   "s" gnus-summary-supersede-article
   "r" gnus-summary-reply
   "c" gnus-summary-cancel-article
   "s" gnus-summary-supersede-article
   "r" gnus-summary-reply

-  "y" gnus-summary-yank-message

   "R" gnus-summary-reply-with-original
   "w" gnus-summary-wide-reply
   "W" gnus-summary-wide-reply-with-original
   "R" gnus-summary-reply-with-original
   "w" gnus-summary-wide-reply
   "W" gnus-summary-wide-reply-with-original

@@ -172,8 +180,8 @@ Thank you for your help in stamping out bugs.
   "\M-c" gnus-summary-mail-crosspost-complaint
   "om" gnus-summary-mail-forward
   "op" gnus-summary-post-forward
   "\M-c" gnus-summary-mail-crosspost-complaint
   "om" gnus-summary-mail-forward
   "op" gnus-summary-post-forward

-  "Om" gnus-uu-digest-mail-forward
-  "Op" gnus-uu-digest-post-forward)
+  "Om" gnus-summary-mail-digest
+  "Op" gnus-summary-post-digest)

 
 (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

@@ -194,7 +202,11 @@ Thank you for your help in stamping out bugs.
           (,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))

-          (message-mode-hook (copy-sequence message-mode-hook)))
+          (message-mode-hook (copy-sequence message-mode-hook))
+          (message-startup-parameter-alist
+           '((reply-buffer . gnus-copy-article-buffer)
+             (original-buffer . gnus-original-article-buffer)
+             (user-agent . Gnus))))

        (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
        (add-hook 'message-mode-hook 'gnus-configure-posting-styles)
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
        (add-hook 'message-mode-hook 'gnus-configure-posting-styles)

@@ -205,38 +217,22 @@ Thank you for your help in stamping out bugs.
         (setq gnus-message-buffer (current-buffer))
         (set (make-local-variable 'gnus-message-group-art)
              (cons ,group ,article))
         (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)
-        (set (make-local-variable 'message-posting-charset)
-             (gnus-setup-posting-charset ,group))
+        (make-local-variable 'gnus-newsgroup-name)

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

-(defun gnus-setup-posting-charset (group)
-  (let ((alist gnus-group-posting-charset-alist)
-       (group (or group ""))
-       elem)
-    (when group
-      (catch 'found
-       (while (setq elem (pop alist))
-         (when (or (and (stringp (car elem))
-                        (string-match (car elem) group))
-                   (and (gnus-functionp (car elem))
-                        (funcall (car elem) group))
-                   (and (symbolp (car elem))
-                        (symbol-value (car elem))))
-           (throw 'found (cadr elem))))))))
-

 (defun gnus-inews-add-send-actions (winconf buffer article)
   (make-local-hook 'message-sent-hook)
   (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
   (setq message-post-method
        `(lambda (arg)
           (gnus-post-method arg ,gnus-newsgroup-name)))
 (defun gnus-inews-add-send-actions (winconf buffer article)
   (make-local-hook 'message-sent-hook)
   (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
   (setq message-post-method
        `(lambda (arg)
           (gnus-post-method arg ,gnus-newsgroup-name)))

-  (setq message-newsreader (setq message-mailer (gnus-extended-version)))
-  (message-add-action
-   `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
+  (setq message-user-agent (gnus-extended-version))
+  (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
   (message-add-action
    `(when (gnus-buffer-exists-p ,buffer)
       (save-excursion

@@ -250,29 +246,11 @@ Thank you for your help in stamping out bugs.
 
 ;;; Post news commands of Gnus group mode and summary mode
 
 
 ;;; Post news commands of Gnus group mode and summary mode
 

-(defun gnus-group-mail (&optional arg)
-  "Start composing a mail.
-If ARG, use the group under the point to find a posting style.
-If ARG is 1, prompt for a group name to find the posting style."
-  (interactive "P")
-  ;; We can't `let' gnus-newsgroup-name here, since that leads
-  ;; to local variables leaking.
-  (let ((group gnus-newsgroup-name)
-       (buffer (current-buffer)))
-    (unwind-protect
-       (progn
-         (setq gnus-newsgroup-name
-               (if arg
-                   (if (= 1 (prefix-numeric-value arg))
-                       (completing-read "Use posting style of group: "
-                                        gnus-active-hashtb nil
-                                        (gnus-read-active-file-p))
-                     (gnus-group-group-name))
-                 ""))
-         (gnus-setup-message 'message (message-mail)))
-      (save-excursion
-       (set-buffer buffer)
-       (setq gnus-newsgroup-name group)))))
+(defun gnus-group-mail ()
+  "Start composing a mail."
+  (interactive)
+  (gnus-setup-message 'message
+    (message-mail)))

 
 (defun gnus-group-post-news (&optional arg)
   "Start composing a news message.
 
 (defun gnus-group-post-news (&optional arg)
   "Start composing a news message.

@@ -359,8 +337,10 @@ post using the current select method."
        article)
     (while (setq article (pop articles))
       (when (gnus-summary-select-article t nil nil article)
        article)
     (while (setq article (pop articles))
       (when (gnus-summary-select-article t nil nil article)

-       (when (gnus-eval-in-buffer-window gnus-original-article-buffer
-               (message-cancel-news))
+       (when (gnus-eval-in-buffer-window gnus-article-buffer
+               (save-excursion
+                 (set-buffer gnus-original-article-buffer)
+                 (message-cancel-news)))

          (gnus-summary-mark-as-read article gnus-canceled-mark)
          (gnus-cache-remove-article 1))
        (gnus-article-hide-headers-if-wanted))
          (gnus-summary-mark-as-read article gnus-canceled-mark)
          (gnus-cache-remove-article 1))
        (gnus-article-hide-headers-if-wanted))

@@ -371,7 +351,8 @@ 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)))
+  (let ((article (gnus-summary-article-number))
+       gnus-message-setup-hook)

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

@@ -393,9 +374,7 @@ 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)
-    (mm-enable-multibyte))
+  (buffer-disable-undo gnus-article-copy)

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

@@ -426,10 +405,10 @@ header line with the old Message-ID."
          ;; Delete the headers from the displayed articles.
          (set-buffer gnus-article-copy)
          (delete-region (goto-char (point-min))
          ;; Delete the headers from the displayed articles.
          (set-buffer gnus-article-copy)
          (delete-region (goto-char (point-min))

-                        (or (search-forward "\n\n" nil t) (point-max)))
+                        (or (search-forward "\n\n" nil t) (point)))

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

-         (article-decode-encoded-words)))
+         (gnus-article-decode-rfc1522)))

       gnus-article-copy)))
 
 (defun gnus-post-news (post &optional group header article-buffer yank subject
       gnus-article-copy)))
 
 (defun gnus-post-news (post &optional group header article-buffer yank subject

@@ -525,16 +504,14 @@ If SILENT, don't prompt the user."
                   (list gnus-post-method)))
               gnus-secondary-select-methods
               (mapcar 'cdr gnus-server-alist)
                   (list gnus-post-method)))
               gnus-secondary-select-methods
               (mapcar 'cdr gnus-server-alist)

-              (mapcar 'car gnus-opened-servers)

               (list gnus-select-method)
               (list group-method)))
             method-alist post-methods method)
        ;; Weed out all mail methods.
        (while methods
          (setq method (gnus-server-get-method "" (pop methods)))
               (list gnus-select-method)
               (list group-method)))
             method-alist post-methods method)
        ;; Weed out all mail methods.
        (while methods
          (setq method (gnus-server-get-method "" (pop methods)))

-         (when (and (or (gnus-method-option-p method 'post)
-                        (gnus-method-option-p method 'post-mail))
-                    (not (member method post-methods)))
+         (when (or (gnus-method-option-p method 'post)
+                   (gnus-method-option-p method 'post-mail))

            (push method post-methods)))
        ;; Create a name-method alist.
        (setq method-alist
            (push method post-methods)))
        ;; Create a name-method alist.
        (setq method-alist

@@ -557,9 +534,8 @@ If SILENT, don't prompt the user."
      ;; Override normal method.
      ((and (eq gnus-post-method 'current)
           (not (eq (car group-method) 'nndraft))
      ;; Override normal method.
      ((and (eq gnus-post-method 'current)
           (not (eq (car group-method) 'nndraft))

-          (gnus-get-function group-method 'request-post t)

           (not arg))
           (not arg))

-      group-method)
+      group-method) 

      ((and gnus-post-method
           (not (eq gnus-post-method 'current)))
       gnus-post-method)
      ((and gnus-post-method
           (not (eq gnus-post-method 'current)))
       gnus-post-method)

@@ -568,31 +544,55 @@ If SILENT, don't prompt the user."
 
 \f
 
 
 \f
 

-;; Dummies to avoid byte-compile warning.
+;; Dummy to avoid byte-compile warning.

 (defvar nnspool-rejected-article-hook)
 (defvar xemacs-codename)
 
 (defun gnus-extended-version ()
 (defvar nnspool-rejected-article-hook)
 (defvar xemacs-codename)
 
 (defun gnus-extended-version ()

-  "Stringified Gnus version and Emacs version."
+  "Stringified gnus version."

   (interactive)
   (interactive)

-  (concat
-   "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t)
-   " (" gnus-version ")"
-   " "
-   (cond
-    ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
-     (concat "Emacs/" (match-string 1 emacs-version)))
-    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
-                  emacs-version)
-     (concat (match-string 1 emacs-version)
-            (format "/%d.%d" emacs-major-version emacs-minor-version)
-            (if (match-beginning 3)
-                (match-string 3 emacs-version)
-              "")
-            (if (boundp 'xemacs-codename)
-                (concat " (" xemacs-codename ")")
-              "")))
-    (t emacs-version))))
+  (concat gnus-product-name "/" gnus-version-number))
+
+(defun gnus-message-make-user-agent (&optional include-mime-info max-column)
+  "Return user-agent info.
+INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable
+  `mime-edit-user-agent-value' exists, the return value will include it.
+MAX-COLUMN the optional second argument if it is specified, the return value
+  will be folded up in the proper way."
+  (let ((user-agent (if (and include-mime-info
+                            (boundp 'mime-edit-user-agent-value))
+                       (concat (gnus-extended-version)
+                               " "
+                               mime-edit-user-agent-value)
+                     (gnus-extended-version))))
+    (if max-column
+       (let (boundary)
+         (unless (natnump max-column) (setq max-column 76))
+         (with-temp-buffer
+           (insert "            " user-agent)
+           (goto-char 13)
+           (while (re-search-forward "[\n\t ]+" nil t)
+             (replace-match " "))
+           (goto-char 13)
+           (while (re-search-forward "[^ ()/]+\\(/[^ ()/]+\\)? ?" nil t)
+             (while (eq ?\( (char-after (point)))
+               (forward-list)
+               (skip-chars-forward " "))
+             (skip-chars-backward " ")
+             (if (> (current-column) max-column)
+                 (progn
+                   (if (or (not boundary) (eq ?\n (char-after boundary)))
+                       (progn
+                         (setq boundary (point))
+                         (unless (eobp)
+                           (delete-char 1)
+                           (insert "\n ")))
+                     (goto-char boundary)
+                     (delete-char 1)
+                     (insert "\n ")))
+               (setq boundary (point))))
+           (buffer-substring 13 (point-max))))
+      user-agent)))

 
 \f
 ;;;
 
 \f
 ;;;

@@ -641,26 +641,54 @@ The original article will be yanked."
   (interactive "P")
   (gnus-summary-reply-with-original n t))
 
   (interactive "P")
   (gnus-summary-reply-with-original n t))
 

-(defun gnus-summary-mail-forward (&optional not-used post)
+(defun gnus-summary-mail-forward (&optional full-headers post)

   "Forward the current message to another user.
   "Forward the current message to another user.

-If POST, post instead of mail."
+If FULL-HEADERS (the prefix), include full headers when forwarding."

   (interactive "P")
   (gnus-setup-message 'forward
     (gnus-summary-select-article)
   (interactive "P")
   (gnus-setup-message 'forward
     (gnus-summary-select-article)

-    (let (text)
-      (save-excursion
-       (set-buffer gnus-original-article-buffer)
-       (setq text (buffer-string)))
-      (set-buffer (gnus-get-buffer-create
-                  (generate-new-buffer-name " *Gnus forward*")))
-      (erase-buffer)
-      (insert text)
-      (goto-char (point-min))
-      (when (looking-at "From ")
-       (replace-match "X-From-Line: ") )
-      (run-hooks 'gnus-article-decode-hook)
+    (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))))
 
       (message-forward post))))
 

+(defun gnus-summary-post-forward (&optional full-headers)
+  "Forward the current article to a newsgroup.
+If FULL-HEADERS (the prefix), include full headers when forwarding."
+  (interactive "P")
+  (gnus-summary-mail-forward full-headers t))
+
+;;; XXX: generate Subject and ``Topics''?
+(defun gnus-summary-mail-digest (&optional n post)
+  "Digests and forwards all articles in this series."
+  (interactive "P")
+  (let ((subject "Digested Articles")
+       (articles (gnus-summary-work-articles n))
+       article)
+    (gnus-setup-message 'forward
+      (gnus-summary-select-article)
+      (if post (message-news nil subject) (message-mail nil subject))
+      (message-goto-body)
+      (while (setq article (pop articles))
+       (save-window-excursion
+         (set-buffer gnus-summary-buffer)
+         (gnus-summary-select-article nil nil nil article)
+         (gnus-summary-remove-process-mark article))
+       (insert (mime-make-tag "message" "rfc822") "\n")
+       (insert-buffer-substring gnus-original-article-buffer))
+      (push-mark)
+      (message-goto-body)
+      (mime-edit-enclose-digest-region (point)(mark t)))))
+
+(defun gnus-summary-post-digest (&optional n)
+  "Digest and forwards all articles in this series to a newsgroup."
+  (interactive "P")
+  (gnus-summary-mail-digest n t))
+ 

 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
   (interactive "sResend message(s) to: \nP")
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
   (interactive "sResend message(s) to: \nP")

@@ -672,12 +700,6 @@ If POST, post instead of mail."
        (set-buffer gnus-original-article-buffer)
        (message-resend address)))))
 
        (set-buffer gnus-original-article-buffer)
        (message-resend address)))))
 

-(defun gnus-summary-post-forward (&optional full-headers)
-  "Forward the current article to a newsgroup.
-If FULL-HEADERS (the prefix), include full headers when forwarding."
-  (interactive "P")
-  (gnus-summary-mail-forward full-headers t))
-

 (defvar gnus-nastygram-message
   "The following article was inappropriately posted to %s.\n\n"
   "Format string to insert in nastygrams.
 (defvar gnus-nastygram-message
   "The following article was inappropriately posted to %s.\n\n"
   "Format string to insert in nastygrams.

@@ -709,8 +731,7 @@ The current group name will be inserted at \"%s\".")
        (gnus-summary-select-article)
        (set-buffer gnus-original-article-buffer)
        (if (and (<= (length (message-tokenize-header
        (gnus-summary-select-article)
        (set-buffer gnus-original-article-buffer)
        (if (and (<= (length (message-tokenize-header

-                             (setq newsgroups
-                                   (mail-fetch-field "newsgroups"))
+                             (setq newsgroups (mail-fetch-field "newsgroups"))

                              ", "))
                     1)
                 (or (not (setq followup-to (mail-fetch-field "followup-to")))
                              ", "))
                     1)
                 (or (not (setq followup-to (mail-fetch-field "followup-to")))

@@ -837,7 +858,8 @@ If YANK is non-nil, include the original article."
       (insert gnus-bug-message)
       (goto-char (point-min)))
     (message-pop-to-buffer "*Gnus Bug*")
       (insert gnus-bug-message)
       (goto-char (point-min)))
     (message-pop-to-buffer "*Gnus Bug*")

-    (message-setup `((To . ,gnus-maintainer) (Subject . "")))
+    (message-setup
+     `((To . ,gnus-maintainer) (Cc . ,semi-gnus-developers) (Subject . "")))

     (when gnus-bug-create-help-buffer
       (push `(gnus-bug-kill-buffer) message-send-actions))
     (goto-char (point-min))
     (when gnus-bug-create-help-buffer
       (push `(gnus-bug-kill-buffer) message-send-actions))
     (goto-char (point-min))

@@ -849,10 +871,7 @@ If YANK is non-nil, include the original article."
               (stringp nntp-server-type))
       (insert nntp-server-type))
     (insert "\n\n\n\n\n")
               (stringp nntp-server-type))
       (insert nntp-server-type))
     (insert "\n\n\n\n\n")

-    (save-excursion
-      (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
-      (gnus-debug))
-    (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>")
+    (gnus-debug)

     (goto-char (point-min))
     (search-forward "Subject: " nil t)
     (message "")))
     (goto-char (point-min))
     (search-forward "Subject: " nil t)
     (message "")))

@@ -861,19 +880,6 @@ If YANK is non-nil, include the original article."
   (when (get-buffer "*Gnus Help Bug*")
     (kill-buffer "*Gnus Help Bug*")))
 
   (when (get-buffer "*Gnus Help Bug*")
     (kill-buffer "*Gnus Help Bug*")))
 

-(defun gnus-summary-yank-message (buffer n)
-  "Yank the current article into a composed message."
-  (interactive
-   (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
-        current-prefix-arg))
-  (gnus-summary-iterate n
-    (let ((gnus-display-mime-function nil)
-         (gnus-inhibit-treatment t))
-      (gnus-summary-select-article))
-    (save-excursion
-      (set-buffer buffer)
-      (message-yank-buffer gnus-article-buffer))))
-

 (defun gnus-debug ()
   "Attempts to go through the Gnus source file and report what variables have been changed.
 The source file has to be in the Emacs load path."
 (defun gnus-debug ()
   "Attempts to go through the Gnus source file and report what variables have been changed.
 The source file has to be in the Emacs load path."

@@ -889,6 +895,7 @@ The source file has to be in the Emacs load path."
     ;; Go through all the files looking for non-default values for variables.
     (save-excursion
       (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
     ;; Go through all the files looking for non-default values for variables.
     (save-excursion
       (set-buffer (gnus-get-buffer-create " *gnus bug info*"))

+      (buffer-disable-undo (current-buffer))

       (while files
        (erase-buffer)
        (when (and (setq file (locate-library (pop files)))
       (while files
        (erase-buffer)
        (when (and (setq file (locate-library (pop files)))

@@ -947,14 +954,15 @@ 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)

-  (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)))))
+  (let (gnus-message-setup-hook)
+    (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.
 

@@ -966,7 +974,7 @@ this is a reply."
       (save-restriction
        (message-narrow-to-headers)
        (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
       (save-restriction
        (message-narrow-to-headers)
        (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))

-             (cur (current-buffer))
+             (coding-system-for-write 'raw-text)

              groups group method)
          (when gcc
            (message-remove-header "gcc")
              groups group method)
          (when gcc
            (message-remove-header "gcc")

@@ -994,17 +1002,14 @@ this is a reply."
                (gnus-request-create-group group method))
              (save-excursion
                (nnheader-set-temp-buffer " *acc*")
                (gnus-request-create-group group method))
              (save-excursion
                (nnheader-set-temp-buffer " *acc*")

-               (insert-buffer-substring cur)
-               (message-encode-message-body)
-               (save-restriction
-                 (message-narrow-to-headers)
-                 (mail-encode-encoded-word-buffer))
+               (insert-buffer-substring message-encoding-buffer)
+               (gnus-run-hooks 'gnus-before-do-gcc-hook)

                (goto-char (point-min))
                (when (re-search-forward
                       (concat "^" (regexp-quote mail-header-separator) "$")
                       nil t)
                  (replace-match "" t t ))
                (goto-char (point-min))
                (when (re-search-forward
                       (concat "^" (regexp-quote mail-header-separator) "$")
                       nil t)
                  (replace-match "" t t ))

-               (unless (gnus-request-accept-article group method t t)
+               (unless (gnus-request-accept-article group method t)

                  (gnus-message 1 "Couldn't store article in group %s: %s"
                                group (gnus-status-message method))
                  (sit-for 2))
                  (gnus-message 1 "Couldn't store article in group %s: %s"
                                group (gnus-status-message method))
                  (sit-for 2))

@@ -1035,7 +1040,7 @@ this is a reply."
          (and gnus-newsgroup-name
               (gnus-group-find-parameter
                gnus-newsgroup-name 'gcc-self)))
          (and gnus-newsgroup-name
               (gnus-group-find-parameter
                gnus-newsgroup-name 'gcc-self)))

-        result
+        result 

         (groups
          (cond
           ((null gnus-message-archive-method)
         (groups
          (cond
           ((null gnus-message-archive-method)

@@ -1103,126 +1108,86 @@ this is a reply."
 
 ;;; Posting styles.
 
 
 ;;; Posting styles.
 

+(defvar gnus-message-style-insertions nil)
+

 (defun gnus-configure-posting-styles ()
   "Configure posting styles according to `gnus-posting-styles'."
   (unless gnus-inhibit-posting-styles
 (defun gnus-configure-posting-styles ()
   "Configure posting styles according to `gnus-posting-styles'."
   (unless gnus-inhibit-posting-styles

-    (let ((group (or gnus-newsgroup-name ""))
-         (styles gnus-posting-styles)
-         style match variable attribute value v results
-         filep name address element)
-      ;; 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.
-      (when gnus-newsgroup-name
-       (let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
-         (when tmp-style
-           (setq styles (append styles (list (cons ".*" tmp-style)))))))
+    (let ((styles gnus-posting-styles)
+         (gnus-newsgroup-name (or gnus-newsgroup-name ""))
+         style match variable attribute value value-value)
+      (make-local-variable 'gnus-message-style-insertions)

       ;; Go through all styles and look for matches.
       ;; Go through all styles and look for matches.

-      (dolist (style styles)
-       (setq match (pop style))
-       (goto-char (point-min))
-       (when (cond
-              ((stringp match)
-               ;; Regexp string match on the group name.
-               (string-match match group))
-              ((eq match 'header)
-               (let ((header (message-fetch-field (pop style))))
-                 (and header
-                      (string-match (pop style) header))))
-              ((or (symbolp match)
-                   (gnus-functionp match))
-               (cond
-                ((gnus-functionp match)
-                 ;; Function to be called.
-                 (funcall match))
-                ((boundp match)
-                 ;; Variable to be checked.
-                 (symbol-value match))))
-              ((listp match)
-               ;; This is a form to be evaled.
-               (eval match)))
+      (while styles
+       (setq style (pop styles)
+             match (pop style))
+       (when (cond ((stringp match)
+                    ;; Regexp string match on the group name.
+                    (string-match match gnus-newsgroup-name))
+                   ((or (symbolp match)
+                        (gnus-functionp match))
+                    (cond ((gnus-functionp match)
+                           ;; Function to be called.
+                           (funcall match))
+                          ((boundp match)
+                           ;; Variable to be checked.
+                           (symbol-value match))))
+                   ((listp match)
+                    ;; This is a form to be evaled.
+                    (eval match)))

          ;; We have a match, so we set the variables.
          ;; We have a match, so we set the variables.

-         (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.
-           (when (eq element 'signature-file)
-             (setq element 'signature
-                   filep t))
-           ;; Get the contents of file elems.
-           (when (and filep v)
-             (setq v (with-temp-buffer
-                       (insert-file-contents v)
-                       (buffer-string))))
-           (setq results (delq (assoc element results) results))
-           (push (cons element v) 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-variable 'message-setup-hook)
-      (dolist (result results)
-       (when (cdr result)
-         (add-hook 'message-setup-hook
-                   (cond
-                    ((eq 'eval (car result))
-                     'ignore)
-                    ((eq 'body (car result))
-                     `(lambda ()
-                        (save-excursion
-                          (message-goto-body)
-                          (insert ,(cdr result)))))
-                    ((eq 'signature (car result))
-                     (set (make-local-variable 'message-signature) nil)
-                     (set (make-local-variable 'message-signature-file) nil)
-                     `(lambda ()
-                        (save-excursion
-                          (let ((message-signature ,(cdr result)))
-                            (when message-signature
-                              (message-insert-signature))))))
-                    (t
-                     (let ((header
-                            (if (symbolp (car result))
-                                (capitalize (symbol-name (car result)))
-                              (car result))))
-                       `(lambda ()
-                          (save-excursion
-                            (message-remove-header ,header)
-                            (message-goto-eoh)
-                            (insert ,header ": " ,(cdr result) "\n")))))))))
-      (when (or name address)
-       (add-hook 'message-setup-hook
-                 `(lambda ()
-                    (let ((user-full-name ,(or (cdr name) (user-full-name)))
-                          (user-mail-address
-                           ,(or (cdr address) user-mail-address)))
-                      (save-excursion
-                        (message-remove-header "From")
-                        (message-goto-eoh)
-                        (insert "From: " (message-make-from) "\n")))))))))
+         (while style
+           (setq attribute (pop style)
+                 value (cadr attribute)
+                 variable nil)
+           ;; We find the variable that is to be modified.
+           (if (and (not (stringp (car attribute)))
+                    (not (eq 'body (car attribute)))
+                    (not (setq variable
+                               (cdr (assq (car attribute) 
+                                          gnus-posting-style-alist)))))
+               (message "Couldn't find attribute %s" (car attribute))
+             ;; We get the value.
+             (setq value-value
+                   (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))))
+             (if variable
+                 ;; This is an ordinary variable.
+                 (set (make-local-variable variable) value-value)
+               ;; This is either a body or a header to be inserted in the
+               ;; message.
+               (when value-value
+                 (let ((attr (car attribute)))
+                   (make-local-variable 'message-setup-hook)
+                   (if (eq 'body attr)
+                       (add-hook 'message-setup-hook
+                                 `(lambda ()
+                                    (save-excursion
+                                      (message-goto-body)
+                                      (insert ,value-value))))
+                     (add-hook 'message-setup-hook
+                               'gnus-message-insert-stylings)
+                     (push (cons (if (stringp attr) attr
+                                   (symbol-name attr))
+                                 value-value)
+                           gnus-message-style-insertions))))))))))))
+
+(defun gnus-message-insert-stylings ()
+  (let (val)
+    (save-excursion
+      (message-goto-eoh)
+      (while (setq val (pop gnus-message-style-insertions))
+       (when (cdr val)
+         (insert (car val) ": " (cdr val) "\n"))
+       (gnus-pull (car val) gnus-message-style-insertions)))))

 
 ;;; Allow redefinition of functions.
 
 
 ;;; Allow redefinition of functions.