Update.

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

diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el
index 43887f0..8a9a206 100644 (file)
--- a/lisp/gnus-soup.el
+++ b/lisp/gnus-soup.el
@@ -1,8 +1,8 @@
 ;;; gnus-soup.el --- SOUP packet writing support for Gnus
 ;;; gnus-soup.el --- SOUP packet writing support for Gnus

-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.

 
 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
 
 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>

-;;     Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;;     Lars Magne Ingebrigtsen <larsi@gnus.org>

 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: news, mail
 
 ;; This file is part of GNU Emacs.

@@ -133,45 +133,44 @@ If N is nil and any articles have been marked with the process mark,
 move those articles instead."
   (interactive "P")
   (let* ((articles (gnus-summary-work-articles n))
 move those articles instead."
   (interactive "P")
   (let* ((articles (gnus-summary-work-articles n))

-        (tmp-buf (get-buffer-create "*soup work*"))
+        (tmp-buf (gnus-get-buffer-create "*soup work*"))

         (area (gnus-soup-area gnus-newsgroup-name))
         (prefix (gnus-soup-area-prefix area))
         headers)
     (buffer-disable-undo tmp-buf)
     (save-excursion
       (while articles
         (area (gnus-soup-area gnus-newsgroup-name))
         (prefix (gnus-soup-area-prefix area))
         headers)
     (buffer-disable-undo tmp-buf)
     (save-excursion
       (while articles

-       ;; Find the header of the article.
-       (set-buffer gnus-summary-buffer)
-       (when (setq headers (gnus-summary-article-header (car articles)))

          ;; Put the article in a buffer.
          ;; Put the article in a buffer.

-         (set-buffer tmp-buf)
-         (when (gnus-request-article-this-buffer
-                (car articles) gnus-newsgroup-name)
-           (save-restriction
-             (message-narrow-to-head)
-             (message-remove-header gnus-soup-ignored-headers t))
-           (gnus-soup-store gnus-soup-directory prefix headers
-                            gnus-soup-encoding-type
-                            gnus-soup-index-type)
-           (gnus-soup-area-set-number
-            area (1+ (or (gnus-soup-area-number area) 0)))))
+       (set-buffer tmp-buf)
+       (when (gnus-request-article-this-buffer
+              (car articles) gnus-newsgroup-name)
+         (setq headers (nnheader-parse-head t))
+         (save-restriction
+           (message-narrow-to-head)
+           (message-remove-header gnus-soup-ignored-headers t))
+         (gnus-soup-store gnus-soup-directory prefix headers
+                          gnus-soup-encoding-type
+                          gnus-soup-index-type)
+         (gnus-soup-area-set-number
+          area (1+ (or (gnus-soup-area-number area) 0))))

        ;; Mark article as read.
        (set-buffer gnus-summary-buffer)
        (gnus-summary-remove-process-mark (car articles))
        (gnus-summary-mark-as-read (car articles) gnus-souped-mark)
        (setq articles (cdr articles)))
       (kill-buffer tmp-buf))
        ;; Mark article as read.
        (set-buffer gnus-summary-buffer)
        (gnus-summary-remove-process-mark (car articles))
        (gnus-summary-mark-as-read (car articles) gnus-souped-mark)
        (setq articles (cdr articles)))
       (kill-buffer tmp-buf))

-    (gnus-soup-save-areas)))
+    (gnus-soup-save-areas)
+    (gnus-set-mode-line 'summary)))

 
 (defun gnus-soup-pack-packet ()
   "Make a SOUP packet from the SOUP areas."
   (interactive)
   (gnus-soup-read-areas)
 
 (defun gnus-soup-pack-packet ()
   "Make a SOUP packet from the SOUP areas."
   (interactive)
   (gnus-soup-read-areas)

-  (unless (file-exists-p gnus-soup-directory)
-    (message "No such directory: %s" gnus-soup-directory))
-  (when (null (directory-files gnus-soup-directory nil "\\.MSG$"))
-    (message "No files to pack."))
-  (gnus-soup-pack gnus-soup-directory gnus-soup-packer))
+  (if (file-exists-p gnus-soup-directory)
+      (if (directory-files gnus-soup-directory nil "\\.MSG$")
+         (gnus-soup-pack gnus-soup-directory gnus-soup-packer)
+       (message "No files to pack."))
+    (message "No such directory: %s" gnus-soup-directory)))

 
 (defun gnus-group-brew-soup (n)
   "Make a soup packet from the current group.
 
 (defun gnus-group-brew-soup (n)
   "Make a soup packet from the current group.

@@ -204,7 +203,9 @@ for matching on group names.
 For instance, if you want to brew on all the nnml groups, as well as
 groups with \"emacs\" in the name, you could say something like:
 
 For instance, if you want to brew on all the nnml groups, as well as
 groups with \"emacs\" in the name, you could say something like:
 

-$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\""
+$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
+
+Note -- this function hasn't been implemented yet."

   (interactive)
   nil)
 
   (interactive)
   nil)
 

@@ -310,6 +311,8 @@ If NOT-ALL, don't pack ticked articles."
           (or (mail-header-lines header) "0"))))
 
 (defun gnus-soup-save-areas ()
           (or (mail-header-lines header) "0"))))
 
 (defun gnus-soup-save-areas ()

+  "Write all SOUP buffers."
+  (interactive)

   (gnus-soup-write-areas)
   (save-excursion
     (let (buf)
   (gnus-soup-write-areas)
   (save-excursion
     (let (buf)

@@ -369,7 +372,7 @@ though the two last may be nil if they are missing."
     (when (file-exists-p file)
       (save-excursion
        (set-buffer (nnheader-find-file-noselect file 'force))
     (when (file-exists-p file)
       (save-excursion
        (set-buffer (nnheader-find-file-noselect file 'force))

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

        (goto-char (point-min))
        (while (not (eobp))
          (push (vector (gnus-soup-field)
        (goto-char (point-min))
        (while (not (eobp))
          (push (vector (gnus-soup-field)

@@ -392,7 +395,7 @@ file.  The vector contain three strings, [prefix name encoding]."
   (let (replies)
     (save-excursion
       (set-buffer (nnheader-find-file-noselect file))
   (let (replies)
     (save-excursion
       (set-buffer (nnheader-find-file-noselect file))

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

       (goto-char (point-min))
       (while (not (eobp))
        (push (vector (gnus-soup-field) (gnus-soup-field)
       (goto-char (point-min))
       (while (not (eobp))
        (push (vector (gnus-soup-field) (gnus-soup-field)

@@ -417,7 +420,7 @@ file.  The vector contain three strings, [prefix name encoding]."
   "Write the AREAS file."
   (interactive)
   (when gnus-soup-areas
   "Write the AREAS file."
   (interactive)
   (when gnus-soup-areas

-    (nnheader-temp-write (concat gnus-soup-directory "AREAS")
+    (with-temp-file (concat gnus-soup-directory "AREAS")

       (let ((areas gnus-soup-areas)
            area)
        (while (setq area (pop areas))
       (let ((areas gnus-soup-areas)
            area)
        (while (setq area (pop areas))

@@ -438,7 +441,7 @@ file.  The vector contain three strings, [prefix name encoding]."
 
 (defun gnus-soup-write-replies (dir areas)
   "Write a REPLIES file in DIR containing AREAS."
 
 (defun gnus-soup-write-replies (dir areas)
   "Write a REPLIES file in DIR containing AREAS."

-  (nnheader-temp-write (concat dir "REPLIES")
+  (with-temp-file (concat dir "REPLIES")

     (let (area)
       (while (setq area (pop areas))
        (insert (format "%s\t%s\t%s\n"
     (let (area)
       (while (setq area (pop areas))
        (insert (format "%s\t%s\t%s\n"

@@ -507,7 +510,7 @@ Return whether the unpacking was successful."
                                 ".MSG"))
               (msg-buf (and (file-exists-p msg-file)
                             (nnheader-find-file-noselect msg-file)))
                                 ".MSG"))
               (msg-buf (and (file-exists-p msg-file)
                             (nnheader-find-file-noselect msg-file)))

-              (tmp-buf (get-buffer-create " *soup send*"))
+              (tmp-buf (gnus-get-buffer-create " *soup send*"))

               beg end)
          (cond
           ((/= (gnus-soup-encoding-format
               beg end)
          (cond
           ((/= (gnus-soup-encoding-format

@@ -535,8 +538,7 @@ Return whether the unpacking was successful."
              (search-forward "\n\n")
              (forward-char -1)
              (insert mail-header-separator)
              (search-forward "\n\n")
              (forward-char -1)
              (insert mail-header-separator)

-             (setq message-newsreader (setq message-mailer
-                                            (gnus-extended-version)))
+             (setq message-user-agent (gnus-extended-version))

              (cond
               ((string= (gnus-soup-reply-kind (car replies)) "news")
                (gnus-message 5 "Sending news message to %s..."
              (cond
               ((string= (gnus-soup-reply-kind (car replies)) "news")
                (gnus-message 5 "Sending news message to %s..."