Update.
[elisp/gnus.git-] / lisp / gnus-soup.el
index ffc08cb..8a9a206 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -133,28 +133,26 @@ 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))
        ;; Mark article as read.
        (set-buffer gnus-summary-buffer)
        (gnus-summary-remove-process-mark (car articles))
@@ -168,11 +166,11 @@ move those articles instead."
   "Make a SOUP packet from the SOUP areas."
   (interactive)
   (gnus-soup-read-areas)
   "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.
@@ -205,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)
 
@@ -372,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)
@@ -395,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)
@@ -420,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))
@@ -441,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"
@@ -510,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
@@ -538,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..."