projects / elisp / gnus.git- / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-msg.el
diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 0e38631..51d8a53 100644 (file)
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -43,23 +43,23 @@
   "*Preferred method for posting USENET news.
 
 If this variable is `current' (which is the default), Gnus will use
   "*Preferred method for posting USENET news.
 
 If this variable is `current' (which is the default), Gnus will use
-the \"current\" select method when posting.  If it is nil, Gnus will
-use the native select method when posting.
+the \"current\" select method when posting.  If it is `native', Gnus
+will use the native select method when posting.
 
 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.
 
-If not nil nor `native', the value must be a valid method as discussed
+If not `native' nor `current', the value must be a valid method as discussed
 in the documentation of `gnus-select-method'.  It can also be a list of
 methods.  If that is the case, the user will be queried for what select
 method to use when posting."
   :group 'gnus-group-foreign
 in the documentation of `gnus-select-method'.  It can also be a list of
 methods.  If that is the case, the user will be queried for what select
 method to use when posting."
   :group 'gnus-group-foreign
-  :type `(choice (const nil)
-                 (const current)
-                (const native)
+  :link '(custom-manual "(gnus)Posting Server")
+  :type `(choice (const native)
+                (const current)
                 (sexp :tag "Methods" ,gnus-select-method)))
 
                 (sexp :tag "Methods" ,gnus-select-method)))
 
-(defvar gnus-outgoing-message-group nil
+(defcustom gnus-outgoing-message-group nil
   "*All outgoing messages will be put in this group.
 If you want to store all your outgoing mail and articles in the group
 \"nnml:archive\", you set this variable to that value.  This variable
   "*All outgoing messages will be put in this group.
 If you want to store all your outgoing mail and articles in the group
 \"nnml:archive\", you set this variable to that value.  This variable
@@ -68,18 +68,25 @@ can also be a list of group names.
 If you want to have greater control over what group to put each
 message in, you can set this variable to a function that checks the
 current newsgroup name and then returns a suitable group name (or list
 If you want to have greater control over what group to put each
 message in, you can set this variable to a function that checks the
 current newsgroup name and then returns a suitable group name (or list
-of names).")
+of names)."
+  :group 'gnus-message
+  :type '(choice (string :tag "Group")
+                 (function)))
 
 
-(defvar gnus-mailing-list-groups nil
+(defcustom gnus-mailing-list-groups nil
   "*Regexp matching groups that are really mailing lists.
 This is useful when you're reading a mailing list that has been
 gatewayed to a newsgroup, and you want to followup to an article in
   "*Regexp matching groups that are really mailing lists.
 This is useful when you're reading a mailing list that has been
 gatewayed to a newsgroup, and you want to followup to an article in
-the group.")
+the group."
+  :group 'gnus-message
+  :type 'regexp)
 
 
-(defvar gnus-add-to-list nil
-  "*If non-nil, add a `to-list' parameter automatically.")
+(defcustom gnus-add-to-list nil
+  "*If non-nil, add a `to-list' parameter automatically."
+  :group 'gnus-message
+  :type 'boolean)
 
 
-(defvar gnus-crosspost-complaint
+(defcustom gnus-crosspost-complaint
   "Hi,
 
 You posted the article below with the following Newsgroups header:
   "Hi,
 
 You posted the article below with the following Newsgroups header:
@@ -95,19 +102,45 @@ Thank you.
 "
   "Format string to be inserted when complaining about crossposts.
 The first %s will be replaced by the Newsgroups header;
 "
   "Format string to be inserted when complaining about crossposts.
 The first %s will be replaced by the Newsgroups header;
-the second with the current group name.")
-
-(defvar gnus-message-setup-hook '(gnus-maybe-setup-default-charset)
-  "Hook run after setting up a message buffer.")
-
-(defvar gnus-bug-create-help-buffer t
-  "*Should we create the *Gnus Help Bug* buffer?")
-
-(defvar gnus-posting-styles nil
-  "*Alist of styles to use when posting.")
-
-(defvar gnus-inews-mark-gcc-as-read nil
-  "If non-nil, automatically mark Gcc articles as read.")
+the second with the current group name."
+  :group 'gnus-message
+  :type 'string)
+
+(defcustom gnus-message-setup-hook '(gnus-maybe-setup-default-charset)
+  "Hook run after setting up a message buffer."
+  :group 'gnus-message
+  :type 'hook)
+
+(defcustom gnus-bug-create-help-buffer t
+  "*Should we create the *Gnus Help Bug* buffer?"
+  :group 'gnus-message
+  :type 'boolean)
+
+(defcustom gnus-posting-styles nil
+  "*Alist of styles to use when posting.
+See Info node `(gnus)Posting Styles'."
+  :group 'gnus-message
+  :type '(repeat (cons (choice (regexp)
+                              (function)
+                              (variable)
+                              (sexp))
+                      (repeat (list
+                               (choice (const signature)
+                                       (const signature-file)
+                                       (const organization)
+                                       (const address)
+                                       (const name)
+                                       (const body)
+                                       (string :tag "Header"))
+                               (choice (string)
+                                       (function)
+                                       (variable)
+                                       (sexp)))))))
+
+(defcustom gnus-inews-mark-gcc-as-read nil
+  "If non-nil, automatically mark Gcc articles as read."
+  :group 'gnus-message
+  :type 'boolean)
 
 (defcustom gnus-group-posting-charset-alist
   '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
 
 (defcustom gnus-group-posting-charset-alist
   '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
@@ -127,18 +160,20 @@ 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."
   :type '(repeat (list :tag "Permitted unencoded charsets"
 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")))))
+                      (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)
 
 ;;; Internal variables.
   :group 'gnus-charset)
 
 ;;; Internal variables.
@@ -152,6 +187,8 @@ use this option with care."
 (defvar gnus-last-posting-server nil)
 (defvar gnus-message-group-art nil)
 
 (defvar gnus-last-posting-server nil)
 (defvar gnus-message-group-art nil)
 
+(defvar gnus-msg-force-broken-reply-to nil)
+
 (defconst gnus-bug-message
   (format "Sending a bug report to the Gnus Towers.
 ========================================
 (defconst gnus-bug-message
   (format "Sending a bug report to the Gnus Towers.
 ========================================
@@ -197,6 +234,7 @@ Thank you for your help in stamping out bugs.
 
 (gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
   "p" gnus-summary-post-news
 
 (gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
   "p" gnus-summary-post-news
+  "i" gnus-summary-news-other-window
   "f" gnus-summary-followup
   "F" gnus-summary-followup-with-original
   "c" gnus-summary-cancel-article
   "f" gnus-summary-followup
   "F" gnus-summary-followup-with-original
   "c" gnus-summary-cancel-article
@@ -213,6 +251,8 @@ Thank you for your help in stamping out bugs.
   "m" gnus-summary-mail-other-window
   "u" gnus-uu-post-news
   "\M-c" gnus-summary-mail-crosspost-complaint
   "m" gnus-summary-mail-other-window
   "u" gnus-uu-post-news
   "\M-c" gnus-summary-mail-crosspost-complaint
+  "Br" gnus-summary-reply-broken-reply-to
+  "BR" gnus-summary-reply-broken-reply-to-with-original
   "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
@@ -244,7 +284,16 @@ Thank you for your help in stamping out bugs.
              (user-agent . Gnus))))
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
              (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)
+       ;; #### FIXME: for a reason that I did not manage to identify yet,
+       ;; the variable `gnus-newsgroup-name' does not honor a dynamically
+       ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
+       ;; After evaluation of @forms below, it gets the value we actually want
+       ;; to override, and the posting styles are used. For that reason, I've
+       ;; added an optional argument to `gnus-configure-posting-styles' to
+       ;; make sure that the correct value for the group name is used. -- drv
+       (add-hook 'message-mode-hook
+                (lambda ()
+                  (gnus-configure-posting-styles ,group)))
        (unwind-protect
           (progn
             ,@forms)
        (unwind-protect
           (progn
             ,@forms)
@@ -257,6 +306,7 @@ Thank you for your help in stamping out bugs.
         (gnus-run-hooks 'gnus-message-setup-hook))
        (gnus-add-buffer)
        (gnus-configure-windows ,config t)
         (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)
        (set-buffer-modified-p nil))))
 
 (defun gnus-inews-insert-draft-meta-information (group article)
@@ -291,19 +341,27 @@ Gcc: header for archiving purposes."
   ;; COMPOSEFUNC should return t if succeed.  Undocumented ???
   t)
 
   ;; COMPOSEFUNC should return t if succeed.  Undocumented ???
   t)
 
+(defvar save-selected-window-window)
+
 ;;;###autoload
 (defun gnus-button-mailto (address)
   "Mail to ADDRESS."
   (set-buffer (gnus-copy-article-buffer))
   (gnus-setup-message 'message
 ;;;###autoload
 (defun gnus-button-mailto (address)
   "Mail to ADDRESS."
   (set-buffer (gnus-copy-article-buffer))
   (gnus-setup-message 'message
-    (message-reply address)))
+    (message-reply address))
+  (and (boundp 'save-selected-window-window)
+       (not (window-live-p save-selected-window-window))
+       (setq save-selected-window-window (selected-window))))
 
 ;;;###autoload
 (defun gnus-button-reply (&optional to-address wide)
   "Like `message-reply'."
   (interactive)
   (gnus-setup-message 'message
 
 ;;;###autoload
 (defun gnus-button-reply (&optional to-address wide)
   "Like `message-reply'."
   (interactive)
   (gnus-setup-message 'message
-    (message-reply to-address wide)))
+    (message-reply to-address wide))
+  (and (boundp 'save-selected-window-window)
+       (not (window-live-p save-selected-window-window))
+       (setq save-selected-window-window (selected-window))))
 
 ;;;###autoload
 (define-mail-user-agent 'gnus-user-agent
 
 ;;;###autoload
 (define-mail-user-agent 'gnus-user-agent
@@ -373,15 +431,47 @@ If ARG is 1, prompt for a group name to find the posting style."
                                         (gnus-read-active-file-p))
                      (gnus-group-group-name))
                  ""))
                                         (gnus-read-active-file-p))
                      (gnus-group-group-name))
                  ""))
+         ;; #### see comment in gnus-setup-message -- drv
          (gnus-setup-message 'message (message-mail)))
       (save-excursion
        (set-buffer buffer)
        (setq gnus-newsgroup-name group)))))
 
          (gnus-setup-message 'message (message-mail)))
       (save-excursion
        (set-buffer buffer)
        (setq gnus-newsgroup-name group)))))
 
+(defun gnus-group-news (&optional arg)
+  "Start composing a news.
+If ARG, post to group under point.
+If ARG is 1, prompt for group name to post to.
+
+This function prepares a news even when using mail groups.  This is useful
+for posting messages to mail groups without actually sending them over the
+network.  The corresponding backend must have a 'request-post method."
+  (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 group: "
+                                        gnus-active-hashtb nil
+                                        (gnus-read-active-file-p))
+                     (gnus-group-group-name))
+                 ""))
+         ;; #### see comment in gnus-setup-message -- drv
+         (gnus-setup-message 'message
+           (message-news (gnus-group-real-name gnus-newsgroup-name))))
+      (save-excursion
+       (set-buffer buffer)
+       (setq gnus-newsgroup-name group)))))
+
 (defun gnus-group-post-news (&optional arg)
 (defun gnus-group-post-news (&optional arg)
-  "Start composing a news message.
-If ARG, post to the group under point.
-If ARG is 1, prompt for a group name."
+  "Start composing a message (a news by default).
+If ARG, post to group under point.  If ARG is 1, prompt for group name.
+Depending on the selected group, the message might be either a mail or
+a news."
   (interactive "P")
   ;; Bind this variable here to make message mode hooks work ok.
   (let ((gnus-newsgroup-name
   (interactive "P")
   ;; Bind this variable here to make message mode hooks work ok.
   (let ((gnus-newsgroup-name
@@ -393,10 +483,78 @@ If ARG is 1, prompt for a group name."
           "")))
     (gnus-post-news 'post gnus-newsgroup-name)))
 
           "")))
     (gnus-post-news 'post gnus-newsgroup-name)))
 
-(defun gnus-summary-post-news ()
-  "Start composing a news message."
-  (interactive)
-  (gnus-post-news 'post gnus-newsgroup-name))
+(defun gnus-summary-mail-other-window (&optional arg)
+  "Start composing a mail in another window.
+Use the posting of the current group by default.
+If ARG, don't do that.  If ARG is 1, prompt for 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 group: "
+                                        gnus-active-hashtb nil
+                                        (gnus-read-active-file-p))
+                     "")
+                 gnus-newsgroup-name))
+         ;; #### see comment in gnus-setup-message -- drv
+         (gnus-setup-message 'message (message-mail)))
+      (save-excursion
+       (set-buffer buffer)
+       (setq gnus-newsgroup-name group)))))
+
+(defun gnus-summary-news-other-window (&optional arg)
+  "Start composing a news in another window.
+Post to the current group by default.
+If ARG, don't do that.  If ARG is 1, prompt for group name to post to.
+
+This function prepares a news even when using mail groups.  This is useful
+for posting messages to mail groups without actually sending them over the
+network.  The corresponding backend must have a 'request-post method."
+  (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 group: "
+                                        gnus-active-hashtb nil
+                                        (gnus-read-active-file-p))
+                     "")
+                 gnus-newsgroup-name))
+         ;; #### see comment in gnus-setup-message -- drv
+         (gnus-setup-message 'message
+           (message-news (gnus-group-real-name gnus-newsgroup-name))))
+      (save-excursion
+       (set-buffer buffer)
+       (setq gnus-newsgroup-name group)))))
+
+(defun gnus-summary-post-news (&optional arg)
+  "Start composing a message.  Post to the current group by default.
+If ARG, don't do that.  If ARG is 1, prompt for a group name to post to.
+Depending on the selected group, the message might be either a mail or
+a news."
+  (interactive "P")
+  ;; Bind this variable here to make message mode hooks work ok.
+  (let ((gnus-newsgroup-name
+        (if arg
+            (if (= 1 (prefix-numeric-value arg))
+                (completing-read "Newsgroup: " gnus-active-hashtb nil
+                                 (gnus-read-active-file-p))
+              "")
+          gnus-newsgroup-name)))
+    (gnus-post-news 'post gnus-newsgroup-name)))
+
 
 (defun gnus-summary-followup (yank &optional force-news)
   "Compose a followup to an article.
 
 (defun gnus-summary-followup (yank &optional force-news)
   "Compose a followup to an article.
@@ -585,7 +743,14 @@ header line with the old Message-ID."
                           (or (message-goto-body) (point-max)))
            ;; Insert the original article headers.
            (insert-buffer-substring gnus-original-article-buffer beg end)
                           (or (message-goto-body) (point-max)))
            ;; Insert the original article headers.
            (insert-buffer-substring gnus-original-article-buffer beg end)
-           (article-decode-encoded-words))))
+           ;; Decode charsets.
+           (let ((gnus-article-decode-hook
+                  (delq 'article-decode-charset
+                        (copy-sequence gnus-article-decode-hook))))
+             ;; Needed for T-gnus.
+             (add-hook 'gnus-article-decode-hook
+                       'article-decode-encoded-words)
+             (run-hooks 'gnus-article-decode-hook)))))
       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
@@ -617,8 +782,7 @@ header line with the old Message-ID."
                force-news
                (and (gnus-news-group-p
                      (or pgroup gnus-newsgroup-name)
                force-news
                (and (gnus-news-group-p
                      (or pgroup gnus-newsgroup-name)
-                     (if header (mail-header-number header)
-                       gnus-current-article))
+                     (or header gnus-current-article))
                     (not mailing-list)
                     (not to-list)
                     (not to-address)))
                     (not mailing-list)
                     (not to-list)
                     (not to-address)))
@@ -651,10 +815,11 @@ header line with the old Message-ID."
        (when yank
          (gnus-inews-yank-articles yank))))))
 
        (when yank
          (gnus-inews-yank-articles yank))))))
 
-(defun gnus-msg-treat-broken-reply-to ()
+(defun gnus-msg-treat-broken-reply-to (&optional force)
   "Remove the Reply-to header iff broken-reply-to."
   "Remove the Reply-to header iff broken-reply-to."
-  (when (gnus-group-find-parameter
-        gnus-newsgroup-name 'broken-reply-to)
+  (when (or force
+           (gnus-group-find-parameter
+            gnus-newsgroup-name 'broken-reply-to))
     (save-restriction
       (message-narrow-to-head)
       (message-remove-header "reply-to"))))
     (save-restriction
       (message-narrow-to-head)
       (message-remove-header "reply-to"))))
@@ -662,28 +827,31 @@ header line with the old Message-ID."
 (defun gnus-post-method (arg group &optional silent)
   "Return the posting method based on GROUP and ARG.
 If SILENT, don't prompt the user."
 (defun gnus-post-method (arg group &optional silent)
   "Return the posting method based on GROUP and ARG.
 If SILENT, don't prompt the user."
-  (let ((group-method (gnus-find-method-for-group group)))
+  (let ((gnus-post-method (or (gnus-parameter-post-method group)
+                             gnus-post-method))
+       (group-method (gnus-find-method-for-group group)))
     (cond
      ;; If the group-method is nil (which shouldn't happen) we use
      ;; the default method.
      ((null group-method)
     (cond
      ;; If the group-method is nil (which shouldn't happen) we use
      ;; the default method.
      ((null group-method)
-      (or (and (null (eq gnus-post-method 'active)) gnus-post-method)
-         gnus-select-method message-post-method))
+      (or (and (listp gnus-post-method)        ;If not current/native/nil
+              (not (listp (car gnus-post-method))) ; and not a list of methods
+              gnus-post-method)        ;then use it.
+         gnus-select-method
+         message-post-method))
      ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))
      ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))
-      (if (eq gnus-post-method 'active)
+      (if (eq gnus-post-method 'current)
          gnus-select-method
        group-method))
      ;; We query the user for a post method.
      ((or arg
          gnus-select-method
        group-method))
      ;; We query the user for a post method.
      ((or arg
-         (and gnus-post-method
-              (not (eq gnus-post-method 'current))
+         (and (listp gnus-post-method)
               (listp (car gnus-post-method))))
       (let* ((methods
              ;; Collect all methods we know about.
              (append
               (listp (car gnus-post-method))))
       (let* ((methods
              ;; Collect all methods we know about.
              (append
-              (when (and gnus-post-method
-                         (not (eq gnus-post-method 'current)))
+              (when (listp gnus-post-method)
                 (if (listp (car gnus-post-method))
                     gnus-post-method
                   (list gnus-post-method)))
                 (if (listp (car gnus-post-method))
                     gnus-post-method
                   (list gnus-post-method)))
@@ -723,57 +891,102 @@ 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))
+          (gnus-get-function group-method 'request-post t))
+      (assert (not arg))
       group-method)
       group-method)
-     ((and gnus-post-method
-          (not (eq gnus-post-method 'current)))
+     ;; Use gnus-post-method.
+     ((listp gnus-post-method)         ;A method...
+      (assert (not (listp (car gnus-post-method)))) ;... not a list of methods.
       gnus-post-method)
       gnus-post-method)
-     ;; Use the normal select method.
+     ;; Use the normal select method (nil or native).
      (t gnus-select-method))))
 
 \f
      (t gnus-select-method))))
 
 \f
-
-(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."
+(defun gnus-message-make-user-agent (&optional include-mime-info max-column
+                                                newline-product)
+  "Return a user-agent info.  If INCLUDE-MIME-INFO is non-nil and the
+variable `mime-edit-user-agent-value' is bound, the value will be
+included in the return value.  If MAX-COLUMN is specified, the return
+value will be folded up as it were filled.  NEWLINE-PRODUCT specifies
+whether a newline should be inserted in front of each product-token.
+If the value is t or `hard', it works strictly.  Otherwise, if it is
+non-nil (e.g. `soft'), it works semi-strictly.
+
+Here is an example of how to use this function:
+
+\(add-hook 'gnus-message-setup-hook
+         (lambda nil
+           (setq message-user-agent nil)
+           (save-excursion
+             (save-restriction
+               (message-narrow-to-headers)
+               (goto-char (point-max))
+               (insert \"User-Agent: \"
+                       (gnus-message-make-user-agent t 76 'soft)
+                       \"\\n\")))))
+"
   (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))))
   (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)))
+    (when max-column
+      (unless (natnump max-column)
+       (setq max-column 76))
+      (with-temp-buffer
+       (set-buffer-multibyte t)
+       (insert (mapconcat 'identity (split-string user-agent) " "))
+       (goto-char (point-min))
+       (let ((bol t)
+             start agent agents width element swidth)
+         (while (re-search-forward "\\([^ ]+\\) ?" nil t)
+           (setq start (match-beginning 0))
+           (if (eq (char-after start) ?\()
+               (progn
+                 (goto-char start)
+                 (forward-list)
+                 (push (buffer-substring start (point)) agent))
+             (when agent
+               (push (nreverse agent) agents))
+             (setq agent (list (match-string 1)))))
+         (when agent
+           (push (nreverse agent) agents))
+         (setq agents (nreverse agents))
+         (if (> (+ 12 (string-width (caar agents))) max-column)
+             (setq user-agent "\n"
+                   width 0)
+           (setq user-agent ""
+                 width 11))
+         (while agents
+           (setq agent (car agents)
+                 agents (cdr agents))
+           (when (and (not bol)
+                      (or (memq newline-product '(t hard))
+                          (and newline-product
+                               (> (+ width 1
+                                     (string-width (mapconcat 'identity
+                                                              agent " ")))
+                                  max-column))))
+             (setq user-agent (concat user-agent "\n")
+                   width 0
+                   bol t))
+           (while agent
+             (setq element (car agent)
+                   swidth (string-width element)
+                   agent (cdr agent))
+             (if bol
+                 (setq user-agent (if (member user-agent '("" "\n"))
+                                      (concat user-agent element)
+                                    (concat user-agent " " element))
+                       width (+ width 1 swidth)
+                       bol nil)
+               (if (> (+ width 1 swidth) max-column)
+                   (setq user-agent (concat user-agent "\n " element)
+                         width (1+ swidth))
+                 (setq user-agent (concat user-agent " " element)
+                       width (+ width 1 swidth)))))))))
+    user-agent))
 
 \f
 ;;;
 
 \f
 ;;;
@@ -808,7 +1021,7 @@ If VERY-WIDE, make a very wide reply."
              (message-narrow-to-head)
              (setq headers (concat headers (buffer-string)))))))
       (set-buffer (gnus-copy-article-buffer))
              (message-narrow-to-head)
              (setq headers (concat headers (buffer-string)))))))
       (set-buffer (gnus-copy-article-buffer))
-      (gnus-msg-treat-broken-reply-to)
+      (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
       (save-restriction
        (message-narrow-to-head)
        (when very-wide
       (save-restriction
        (message-narrow-to-head)
        (when very-wide
@@ -825,6 +1038,24 @@ The original article will be yanked."
   (interactive "P")
   (gnus-summary-reply (gnus-summary-work-articles n) wide))
 
   (interactive "P")
   (gnus-summary-reply (gnus-summary-work-articles n) wide))
 
+(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
+  "Like `gnus-summary-reply' except removing reply-to field.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
+  (interactive
+   (list (and current-prefix-arg
+             (gnus-summary-work-articles 1))))
+  (let ((gnus-msg-force-broken-reply-to t))
+    (gnus-summary-reply yank wide very-wide)))
+
+(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
+  "Like `gnus-summary-reply-with-original' except removing reply-to field.
+The original article will be yanked."
+  (interactive "P")
+  (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
+
 (defun gnus-summary-wide-reply (&optional yank)
   "Start composing a wide reply mail to the current message.
 If prefix argument YANK is non-nil, the original article is yanked
 (defun gnus-summary-wide-reply (&optional yank)
   "Start composing a wide reply mail to the current message.
 If prefix argument YANK is non-nil, the original article is yanked
@@ -857,18 +1088,21 @@ The original article will be yanked."
    (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
 
 (defun gnus-summary-mail-forward (&optional full-headers post)
    (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
 
 (defun gnus-summary-mail-forward (&optional full-headers post)
-  "Forward the current message to another user.
+  "Forward the current message(s) to another user.
+If process marks exist, forward all marked messages;
 If FULL-HEADERS (the prefix), include full headers when forwarding."
   (interactive "P")
 If FULL-HEADERS (the prefix), include full headers when forwarding."
   (interactive "P")
-  (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))))
+  (if (null (cdr (gnus-summary-work-articles nil)))
+      (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)))
 
 (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.
@@ -1001,12 +1235,6 @@ The current group name will be inserted at \"%s\".")
          (when (gnus-y-or-n-p "Send this complaint? ")
            (message-send-and-exit)))))))
 
          (when (gnus-y-or-n-p "Send this complaint? ")
            (message-send-and-exit)))))))
 
-(defun gnus-summary-mail-other-window ()
-  "Compose mail in other window."
-  (interactive)
-  (gnus-setup-message 'message
-    (message-mail)))
-
 (defun gnus-mail-parse-comma-list ()
   (let (accumulated
        beg)
 (defun gnus-mail-parse-comma-list ()
   (let (accumulated
        beg)
@@ -1260,19 +1488,18 @@ this is a reply."
 ;;; Gcc handling.
 
 (defun gnus-inews-group-method (group)
 ;;; Gcc handling.
 
 (defun gnus-inews-group-method (group)
-  (cond ((and (null (gnus-get-info group))
-             (eq (car gnus-message-archive-method)
-                 (car
-                  (gnus-server-to-method
-                   (gnus-group-method group)))))
-        ;; If the group doesn't exist, we assume
-        ;; it's an archive group...
-        gnus-message-archive-method)
-       ;; Use the method.
-       ((gnus-info-method (gnus-get-info group))
-        (gnus-info-method (gnus-get-info group)))
-       ;; Find the method.
-       (t (gnus-group-method group))))
+  (cond
+   ;; If the group doesn't exist, we assume
+   ;; it's an archive group...
+   ((and (null (gnus-get-info group))
+        (eq (car (gnus-server-to-method gnus-message-archive-method))
+            (car (gnus-server-to-method (gnus-group-method group)))))
+    gnus-message-archive-method)
+   ;; Use the method.
+   ((gnus-info-method (gnus-get-info group))
+    (gnus-info-method (gnus-get-info group)))
+   ;; Find the method.
+   (t (gnus-server-to-method (gnus-group-method group)))))
 
 ;; Do Gcc handling, which copied the message over to some group.
 (defun gnus-inews-do-gcc (&optional gcc)
 
 ;; Do Gcc handling, which copied the message over to some group.
 (defun gnus-inews-do-gcc (&optional gcc)
@@ -1291,8 +1518,10 @@ this is a reply."
                        (message-tokenize-header gcc " ,")))
          ;; Copy the article over to some group(s).
          (while (setq group (pop groups))
                        (message-tokenize-header gcc " ,")))
          ;; Copy the article over to some group(s).
          (while (setq group (pop groups))
-           (gnus-check-server
-            (setq method (gnus-inews-group-method group)))
+           (unless (gnus-check-server
+                    (setq method (gnus-inews-group-method group)))
+             (error "Can't open server %s" (if (stringp method) method
+                                             (car method))))
            (unless (gnus-request-group group nil method)
              (gnus-request-create-group group method))
            (save-excursion
            (unless (gnus-request-group group nil method)
              (gnus-request-create-group group method))
            (save-excursion
@@ -1407,10 +1636,10 @@ this is a reply."
 
 ;;; Posting styles.
 
 
 ;;; Posting styles.
 
-(defun gnus-configure-posting-styles ()
+(defun gnus-configure-posting-styles (&optional group-name)
   "Configure posting styles according to `gnus-posting-styles'."
   (unless gnus-inhibit-posting-styles
   "Configure posting styles according to `gnus-posting-styles'."
   (unless gnus-inhibit-posting-styles
-    (let ((group (or gnus-newsgroup-name ""))
+    (let ((group (or group-name gnus-newsgroup-name ""))
          (styles gnus-posting-styles)
          style match variable attribute value v results
          filep name address element)
          (styles gnus-posting-styles)
          style match variable attribute value v results
          filep name address element)
@@ -1489,7 +1718,8 @@ this is a reply."
       (setq name (assq 'name results)
            address (assq 'address results))
       (setq results (delq name (delq address results)))
       (setq name (assq 'name results)
            address (assq 'address results))
       (setq results (delq name (delq address results)))
-      (make-local-variable 'message-setup-hook)
+      ;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
+      (make-local-hook 'message-setup-hook)
       (dolist (result results)
        (add-hook 'message-setup-hook
                  (cond
       (dolist (result results)
        (add-hook 'message-setup-hook
                  (cond
@@ -1521,19 +1751,21 @@ 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 "\n"))))))))
+                 nil 'local))
       (when (or name address)
        (add-hook 'message-setup-hook
                  `(lambda ()
       (when (or name address)
        (add-hook 'message-setup-hook
                  `(lambda ()
-                    (set (make-local-variable 'user-mail-address)
-                         ,(or (cdr address) user-mail-address))
+                    (set (make-local-variable 'user-mail-address)
+                         ,(or (cdr address) user-mail-address))
                     (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)
                     (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")))))))))
+                        (insert "From: " (message-make-from) "\n"))))
+                 nil 'local)))))
 
 
 ;;; @ for MIME Edit mode
 
 
 ;;; @ for MIME Edit mode
@@ -1542,7 +1774,7 @@ this is a reply."
 (defun gnus-maybe-setup-default-charset ()
   (let ((charset
         (and (boundp 'gnus-summary-buffer)
 (defun gnus-maybe-setup-default-charset ()
   (let ((charset
         (and (boundp 'gnus-summary-buffer)
-              (buffer-live-p gnus-summary-buffer)
+             (buffer-live-p gnus-summary-buffer)
              (save-excursion
                (set-buffer gnus-summary-buffer)
                default-mime-charset))))
              (save-excursion
                (set-buffer gnus-summary-buffer)
                default-mime-charset))))