Synch to No Gnus 200410290525.
[elisp/gnus.git-] / lisp / gnus-msg.el
index 5242448..f41a272 100644 (file)
@@ -445,7 +445,7 @@ Thank you for your help in stamping out bugs.
                  (not (string= ,group "")))
         (push (cons
                (intern gnus-draft-meta-information-header)
-               (gnus-inews-make-draft ,yanked))
+               (gnus-inews-make-draft (or ,yanked ,article)))
               message-required-headers))
        (unwind-protect
           (progn
@@ -467,15 +467,16 @@ Thank you for your help in stamping out bugs.
 (defun gnus-inews-make-draft-meta-information (group articles)
   (when (numberp articles)
     (setq articles (list articles)))
-  (concat "(\"" group "\" "
+  (concat "(\"" group "\""
          (if articles
-             (mapconcat
-              (lambda (elem)
-                (number-to-string
-                 (if (consp elem)
-                     (car elem)
-                   elem)))
-              articles " ")
+             (concat " "
+                     (mapconcat
+                      (lambda (elem)
+                        (number-to-string
+                         (if (consp elem)
+                             (car elem)
+                           elem)))
+                      articles " "))
            "")
          ")"))
 
@@ -848,12 +849,10 @@ Uses the process-prefix convention.  If given the symbolic
 prefix `a', cancel using the standard posting method; if not
 post using the current select method."
   (interactive (gnus-interactive "P\ny"))
-  (let ((articles (gnus-summary-work-articles n))
-       (message-post-method
+  (let ((message-post-method
         `(lambda (arg)
-           (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
-       article)
-    (while (setq article (pop articles))
+           (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))))
+    (dolist (article (gnus-summary-work-articles n))
       (when (gnus-summary-select-article t nil nil article)
        (when (gnus-eval-in-buffer-window gnus-article-buffer
                (save-excursion
@@ -1453,14 +1452,12 @@ forward those articles instead."
            (with-current-buffer gnus-original-article-buffer
              (nnmail-fetch-field "to"))))
         current-prefix-arg))
-  (let ((articles (gnus-summary-work-articles n))
-       article)
-    (while (setq article (pop articles))
-      (gnus-summary-select-article nil nil nil article)
-      (save-excursion
-       (set-buffer gnus-original-article-buffer)
-       (message-resend address))
-      (gnus-summary-mark-article-as-forwarded article))))
+  (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))
+    (gnus-summary-mark-article-as-forwarded article)))
 
 ;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
 (defun gnus-summary-resend-message-edit ()
@@ -1539,37 +1536,35 @@ The current group name will be inserted at \"%s\".")
 (defun gnus-summary-mail-crosspost-complaint (n)
   "Send a complaint about crossposting to the current article(s)."
   (interactive "P")
-  (let ((articles (gnus-summary-work-articles n))
-       article)
-    (while (setq article (pop articles))
-      (set-buffer gnus-summary-buffer)
-      (gnus-summary-goto-subject article)
-      (let ((group (gnus-group-real-name gnus-newsgroup-name))
-           newsgroups followup-to)
-       (gnus-summary-select-article)
-       (set-buffer gnus-original-article-buffer)
-       (if (and (<= (length (message-tokenize-header
-                             (setq newsgroups
-                                   (mail-fetch-field "newsgroups"))
-                             ", "))
-                    1)
-                (or (not (setq followup-to (mail-fetch-field "followup-to")))
-                    (not (member group (message-tokenize-header
-                                        followup-to ", ")))))
-           (if followup-to
-               (gnus-message 1 "Followup-to restricted")
-             (gnus-message 1 "Not a crossposted article"))
-         (set-buffer gnus-summary-buffer)
-         (gnus-summary-reply-with-original 1)
-         (set-buffer gnus-message-buffer)
-         (message-goto-body)
-         (insert (format gnus-crosspost-complaint newsgroups group))
-         (message-goto-subject)
-         (re-search-forward " *$")
-         (replace-match " (crosspost notification)" t t)
-         (gnus-deactivate-mark)
-         (when (gnus-y-or-n-p "Send this complaint? ")
-           (message-send-and-exit)))))))
+  (dolist (article (gnus-summary-work-articles n))
+    (set-buffer gnus-summary-buffer)
+    (gnus-summary-goto-subject article)
+    (let ((group (gnus-group-real-name gnus-newsgroup-name))
+         newsgroups followup-to)
+      (gnus-summary-select-article)
+      (set-buffer gnus-original-article-buffer)
+      (if (and (<= (length (message-tokenize-header
+                           (setq newsgroups
+                                 (mail-fetch-field "newsgroups"))
+                           ", "))
+                  1)
+              (or (not (setq followup-to (mail-fetch-field "followup-to")))
+                  (not (member group (message-tokenize-header
+                                      followup-to ", ")))))
+         (if followup-to
+             (gnus-message 1 "Followup-to restricted")
+           (gnus-message 1 "Not a crossposted article"))
+       (set-buffer gnus-summary-buffer)
+       (gnus-summary-reply-with-original 1)
+       (set-buffer gnus-message-buffer)
+       (message-goto-body)
+       (insert (format gnus-crosspost-complaint newsgroups group))
+       (message-goto-subject)
+       (re-search-forward " *$")
+       (replace-match " (crosspost notification)" t t)
+       (gnus-deactivate-mark)
+       (when (gnus-y-or-n-p "Send this complaint? ")
+         (message-send-and-exit))))))
 
 (defun gnus-mail-parse-comma-list ()
   (let (accumulated
@@ -1789,7 +1784,8 @@ 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 "[\000-\010\013-\037\200-\237]" nil t)
+    (while (re-search-forward (string-as-multibyte
+                              "[\000-\010\013-\037\200-\237]") nil t)
       (replace-match (format "\\%03o" (string-to-char (match-string 0)))
                     t t))
     ;; Break MIME tags purposely.
@@ -2037,9 +2033,11 @@ this is a reply."
                ;; Obsolete format of header match.
                (and (gnus-buffer-live-p gnus-article-copy)
                     (with-current-buffer gnus-article-copy
-                      (let ((header (message-fetch-field (pop style))))
-                        (and header
-                             (string-match (pop style) header))))))
+                      (save-restriction
+                        (nnheader-narrow-to-headers)
+                        (let ((header (message-fetch-field (pop style))))
+                          (and header
+                               (string-match (pop style) header)))))))
               ((or (symbolp match)
                    (functionp match))
                (cond
@@ -2055,9 +2053,11 @@ this is a reply."
                  ;; New format of header match.
                  (and (gnus-buffer-live-p gnus-article-copy)
                       (with-current-buffer gnus-article-copy
-                        (let ((header (message-fetch-field (nth 1 match))))
-                          (and header
-                               (string-match (nth 2 match) header))))))
+                        (save-restriction
+                          (nnheader-narrow-to-headers)
+                          (let ((header (message-fetch-field (nth 1 match))))
+                            (and header
+                                 (string-match (nth 2 match) header)))))))
                 (t
                  ;; This is a form to be evaled.
                  (eval match)))))
@@ -2165,8 +2165,8 @@ this is a reply."
        (setq v (with-temp-buffer
                  (insert-file-contents v)
                  (goto-char (point-max))
-                 (while (bolp)
-                   (delete-char -1))
+                 (skip-chars-backward "\n")
+                 (delete-region (+ (point) (if (bolp) 0 1)) (point-max))
                  (buffer-string))))
       (if (eq element 'import)
          (progn