(gnus-inews-do-gcc): Don't have the backends do the slow *-request-group.
[gnus] / lisp / gnus-msg.el
index 4a21e6e..a7d6711 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-msg.el --- mail and post interface for Gnus
 
 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -9,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -151,7 +149,7 @@ See Info node `(gnus)Posting Styles'."
   :type 'boolean)
 
 (make-obsolete-variable 'gnus-inews-mark-gcc-as-read
-                       'gnus-gcc-mark-as-read)
+                       'gnus-gcc-mark-as-read "Emacs 22.1")
 
 (defcustom gnus-gcc-externalize-attachments nil
   "Should local-file attachments be included as external parts in Gcc copies?
@@ -265,7 +263,7 @@ This can also be a function receiving the group name as the only
 parameter, which should return non-nil if a confirmation is needed; or
 a regexp, in which case a confirmation is asked for if the group name
 matches the regexp."
-  :version "23.0" ;; No Gnus (default changed)
+  :version "23.1" ;; No Gnus (default changed)
   :group 'gnus-message
   :type '(choice (const :tag "No" nil)
                 (const :tag "Yes" t)
@@ -293,7 +291,7 @@ If nil, the address field will always be empty after invoking
 (defcustom gnus-message-highlight-citation
   t ;; gnus-treat-highlight-citation ;; gnus-cite dependency
   "Enable highlighting of different citation levels in message-mode."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group 'gnus-cite
   :group 'gnus-message
   :type 'boolean)
@@ -335,8 +333,7 @@ Please describe the bug in annoying, painstaking detail.
 Thank you for your help in stamping out bugs.
 ")
 
-(eval-and-compile
-  (autoload 'gnus-uu-post-news "gnus-uu" nil t))
+(autoload 'gnus-uu-post-news "gnus-uu" nil t)
 
 \f
 ;;;
@@ -423,7 +420,7 @@ Thank you for your help in stamping out bugs.
                     ;; There may be an old " *gnus article copy*" buffer.
                     (let (gnus-article-copy)
                       (gnus-configure-posting-styles ,group)))))
-       (gnus-pull ',(intern gnus-draft-meta-information-header)
+       (gnus-alist-pull ',(intern gnus-draft-meta-information-header)
                  message-required-headers)
        (when (and ,group
                  (not (string= ,group "")))
@@ -552,8 +549,7 @@ Gcc: header for archiving purposes."
                       (t nil))))
     (message-add-action
      `(when (gnus-buffer-exists-p ,buffer)
-       (save-excursion
-         (set-buffer ,buffer)
+       (with-current-buffer ,buffer
          ,(when to-be-marked
             (if (eq config 'forward)
                 `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
@@ -582,14 +578,13 @@ If ARG is 1, prompt for a group name to find the posting style."
                (if arg
                    (if (= 1 (prefix-numeric-value arg))
                        (gnus-group-completing-read
-                        "Use posting style of group"
-                        nil nil (gnus-read-active-file-p))
+                        "Use posting style of group"
+                        nil (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)
+      (with-current-buffer buffer
        (setq gnus-newsgroup-name group)))))
 
 (defun gnus-group-news (&optional arg)
@@ -612,16 +607,15 @@ network.  The corresponding back end must have a 'request-post method."
          (setq gnus-newsgroup-name
                (if arg
                    (if (= 1 (prefix-numeric-value arg))
-                       (gnus-group-completing-read "Use group"
-                                                   nil nil
+                       (gnus-group-completing-read "Use group"
+                                                   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)
+      (with-current-buffer buffer
        (setq gnus-newsgroup-name group)))))
 
 (defun gnus-group-post-news (&optional arg)
@@ -634,7 +628,7 @@ a news."
   (let ((gnus-newsgroup-name
         (if arg
             (if (= 1 (prefix-numeric-value arg))
-                (gnus-group-completing-read "Newsgroup: " nil nil
+                (gnus-group-completing-read "Newsgroup" nil
                                             (gnus-read-active-file-p))
               (gnus-group-group-name))
           ""))
@@ -660,15 +654,14 @@ posting style."
          (setq gnus-newsgroup-name
                (if arg
                    (if (= 1 (prefix-numeric-value arg))
-                       (gnus-group-completing-read "Use group"
-                                                   nil nil
+                       (gnus-group-completing-read "Use group"
+                                                   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)
+      (with-current-buffer buffer
        (setq gnus-newsgroup-name group)))))
 
 (defun gnus-summary-news-other-window (&optional arg)
@@ -691,8 +684,8 @@ network.  The corresponding back end must have a 'request-post method."
          (setq gnus-newsgroup-name
                (if arg
                    (if (= 1 (prefix-numeric-value arg))
-                       (gnus-group-completing-read "Use group"
-                                                   nil nil
+                       (gnus-group-completing-read "Use group"
+                                                   nil
                                                    (gnus-read-active-file-p))
                      "")
                  gnus-newsgroup-name))
@@ -704,8 +697,7 @@ network.  The corresponding back end must have a 'request-post method."
                   (remove
                    (car (gnus-find-method-for-group gnus-newsgroup-name))
                    gnus-discouraged-post-methods)))))
-      (save-excursion
-       (set-buffer buffer)
+      (with-current-buffer buffer
        (setq gnus-newsgroup-name group)))))
 
 (defun gnus-summary-post-news (&optional arg)
@@ -718,7 +710,7 @@ a news."
   (let ((gnus-newsgroup-name
         (if arg
             (if (= 1 (prefix-numeric-value arg))
-                (gnus-group-completing-read "Newsgroup: " nil nil
+                (gnus-group-completing-read "Newsgroup" nil
                                             (gnus-read-active-file-p))
               "")
           gnus-newsgroup-name))
@@ -820,7 +812,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)
-  (let ((article (gnus-summary-article-number)))
+  (let ((article (gnus-summary-article-number))
+       (mail-parse-charset gnus-newsgroup-charset))
     (gnus-setup-message 'reply-yank
       (gnus-summary-select-article t)
       (set-buffer gnus-original-article-buffer)
@@ -828,8 +821,7 @@ header line with the old Message-ID."
       (push
        `((lambda ()
           (when (gnus-buffer-exists-p ,gnus-summary-buffer)
-            (save-excursion
-              (set-buffer ,gnus-summary-buffer)
+            (with-current-buffer ,gnus-summary-buffer
               (gnus-cache-possibly-remove-article ,article nil nil nil t)
               (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
        message-send-actions)
@@ -845,16 +837,14 @@ 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*"))
-  (save-excursion
-    (set-buffer gnus-article-copy)
+  (with-current-buffer gnus-article-copy
     (mm-enable-multibyte))
   (let ((article-buffer (or article-buffer gnus-article-buffer))
        end beg)
     (if (not (and (get-buffer article-buffer)
                  (gnus-buffer-exists-p article-buffer)))
        (error "Can't find any article buffer")
-      (save-excursion
-       (set-buffer article-buffer)
+      (with-current-buffer article-buffer
        (let ((gnus-newsgroup-charset (or gnus-article-charset
                                          gnus-newsgroup-charset))
              (gnus-newsgroup-ignored-charsets
@@ -1038,8 +1028,8 @@ If SILENT, don't prompt the user."
                         gnus-last-posting-server)
                    ;; Just use the last value.
                    gnus-last-posting-server
-                 (completing-read
-                  "Posting method: " method-alist nil t
+                 (gnus-completing-read
+                  "Posting method" (mapcar 'car method-alist) t
                   (cons (or gnus-last-posting-server "") 0))))
          method-alist))))
      ;; Override normal method.
@@ -1104,7 +1094,7 @@ If VERY-WIDE, make a very wide reply."
            (if (or wide very-wide)
                t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very
                  ;; wide replies.
-             (y-or-n-p "Really reply by mail to article author? "))))
+             (y-or-n-p "Really reply by mail to article author? ")))
     (let* ((article
            (if (listp (car yank))
                (caar yank)
@@ -1120,8 +1110,7 @@ If VERY-WIDE, make a very wide reply."
            (gnus-summary-select-article)
          (dolist (article very-wide)
            (gnus-summary-select-article nil nil nil article)
-           (save-excursion
-             (set-buffer (gnus-copy-article-buffer))
+           (with-current-buffer (gnus-copy-article-buffer)
              (gnus-msg-treat-broken-reply-to)
              (save-restriction
                (message-narrow-to-head)
@@ -1144,8 +1133,7 @@ If VERY-WIDE, make a very wide reply."
   "Check the various replysign variables and take action accordingly."
   (when (or gnus-message-replysign gnus-message-replyencrypt)
     (let (signed encrypted)
-      (save-excursion
-       (set-buffer gnus-article-buffer)
+      (with-current-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)
@@ -1276,9 +1264,9 @@ For the `inline' alternatives, also see the variable
         current-prefix-arg))
   (dolist (article (gnus-summary-work-articles n))
     (gnus-summary-select-article nil nil nil article)
-    (save-excursion
-      (set-buffer gnus-original-article-buffer)
-      (message-resend address))
+    (with-current-buffer gnus-original-article-buffer
+      (let ((gnus-gcc-externalize-attachments nil))
+       (message-resend address)))
     (gnus-summary-mark-article-as-forwarded article)))
 
 ;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
@@ -1288,7 +1276,7 @@ A new buffer will be created to allow the user to modify body and
 contents of the message, and then, everything will happen as when
 composing a new message."
   (interactive)
-  (let ((article (gnus-summary-article-number)))
+  (let ((mail-parse-charset gnus-newsgroup-charset))
     (gnus-setup-message 'reply-yank
       (gnus-summary-select-article t)
       (set-buffer gnus-original-article-buffer)
@@ -1484,8 +1472,7 @@ If YANK is non-nil, include the original article."
       (insert nntp-server-type))
     (insert "\n\n\n\n\n")
     (let (text)
-      (save-excursion
-       (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
+      (with-current-buffer (gnus-get-buffer-create " *gnus environment info*")
        (erase-buffer)
        (gnus-debug)
        (setq text (buffer-string)))
@@ -1501,13 +1488,12 @@ If YANK is non-nil, include the original article."
 (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)
+   (list (gnus-completing-read "Buffer" (message-buffers) t)
         current-prefix-arg))
   (gnus-summary-iterate n
     (let ((gnus-inhibit-treatment t))
       (gnus-summary-select-article))
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (message-yank-buffer gnus-article-buffer))))
 
 (defun gnus-debug ()
@@ -1520,8 +1506,7 @@ The source file has to be in the Emacs load path."
     (gnus-message 4 "Please wait while we snoop your variables...")
     (sit-for 0)
     ;; Go through all the files looking for non-default values for variables.
-    (save-excursion
-      (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
+    (with-current-buffer (gnus-get-buffer-create " *gnus bug info*")
       (while files
        (erase-buffer)
        (when (and (setq file (locate-library (pop files)))
@@ -1562,7 +1547,7 @@ The source file has to be in the Emacs load path."
     ;; Remove any control chars - they seem to cause trouble for some
     ;; mailers.  (Byte-compiled output from the stuff above.)
     (goto-char point)
-    (while (re-search-forward (mm-string-as-multibyte
+    (while (re-search-forward (mm-string-to-multibyte
                               "[\000-\010\013-\037\200-\237]") nil t)
       (replace-match (format "\\%03o" (string-to-char (match-string 0)))
                     t t))))
@@ -1643,7 +1628,7 @@ this is a reply."
            (unless (gnus-check-server method)
              (error "Can't open server %s" (if (stringp method) method
                                              (car method))))
-           (unless (gnus-request-group group nil method)
+           (unless (gnus-request-group group t method)
              (gnus-request-create-group group method))
            (setq mml-externalize-attachments
                  (if (stringp gnus-gcc-externalize-attachments)
@@ -1693,6 +1678,11 @@ this is a reply."
                                    group method t t))))
                (gnus-message 1 "Couldn't store article in group %s: %s"
                              group (gnus-status-message method)))
+             (when (stringp method)
+               (setq method (gnus-server-to-method method)))
+             (when (and (listp method)
+                        (gnus-native-method-p method))
+               (setq group (gnus-group-short-name group)))
              (when (and group-art
                         ;; FIXME: Should gcc-mark-as-read work when
                         ;; Gnus is not running?
@@ -2000,5 +1990,4 @@ this is a reply."
 
 (provide 'gnus-msg)
 
-;;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b
 ;;; gnus-msg.el ends here