(gnus-soup-send-packet): Don't use

[gnus] / lisp / gnus-soup.el

diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el
index be089bf..b5f1368 100644 (file)
--- a/lisp/gnus-soup.el
+++ b/lisp/gnus-soup.el
@@ -1,5 +1,7 @@
 ;;; 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, 1996, 1997, 1998, 1999, 2000, 2002
+;;     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>


@@ -67,9 +69,9 @@ The SOUP packet file name will be inserted at the %s.")
 
 ;;; Internal Variables:
 
 
 ;;; Internal Variables:
 

-(defvar gnus-soup-encoding-type ?n
+(defvar gnus-soup-encoding-type ?u

   "*Soup encoding type.
   "*Soup encoding type.

-`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox
+`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox

 format.")
 
 (defvar gnus-soup-index-type ?c
 format.")
 
 (defvar gnus-soup-index-type ?c


@@ -133,45 +135,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.
-         (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)))))
-       ;; Mark article as read.
-       (set-buffer gnus-summary-buffer)
+       ;; Put the article in a buffer.
+       (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-mark-as-read (car articles) gnus-souped-mark))

        (gnus-summary-remove-process-mark (car articles))
        (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))
        (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 +205,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)
 


@@ -244,7 +247,8 @@ $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\""
       ;; a soup header.
       (setq head-line
            (cond
       ;; a soup header.
       (setq head-line
            (cond

-            ((= gnus-soup-encoding-type ?n)
+            ((or (= gnus-soup-encoding-type ?u)
+                 (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility.

              (format "#! rnews %d\n" (buffer-size)))
             ((= gnus-soup-encoding-type ?m)
              (while (search-forward "\nFrom " nil t)
              (format "#! rnews %d\n" (buffer-size)))
             ((= gnus-soup-encoding-type ?m)
              (while (search-forward "\nFrom " nil t)


@@ -334,7 +338,8 @@ If NOT-ALL, don't pack ticked articles."
       (while (setq prefix (pop prefixes))
        (erase-buffer)
        (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
       (while (setq prefix (pop prefixes))
        (erase-buffer)
        (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))

-       (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file))))))
+       (let ((coding-system-for-write mm-text-coding-system))
+         (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))))

 
 (defun gnus-soup-pack (dir packer)
   (let* ((files (mapconcat 'identity
 
 (defun gnus-soup-pack (dir packer)
   (let* ((files (mapconcat 'identity


@@ -371,7 +376,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)


@@ -394,7 +399,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)


@@ -419,7 +424,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))


@@ -440,7 +445,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"


@@ -509,12 +514,15 @@ 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
               beg end)
          (cond

-          ((/= (gnus-soup-encoding-format
-                (gnus-soup-reply-encoding (car replies)))
-               ?n)
+          ((and (/= (gnus-soup-encoding-format
+                     (gnus-soup-reply-encoding (car replies)))
+                    ?u)
+                (/= (gnus-soup-encoding-format
+                     (gnus-soup-reply-encoding (car replies)))
+                    ?n)) ;; Gnus back compatibility.

            (error "Unsupported encoding"))
           ((null msg-buf)
            t)
            (error "Unsupported encoding"))
           ((null msg-buf)
            t)


@@ -532,26 +540,35 @@ Return whether the unpacking was successful."
                                     (match-beginning 1) (match-end 1)))))
              (switch-to-buffer tmp-buf)
              (erase-buffer)
                                     (match-beginning 1) (match-end 1)))))
              (switch-to-buffer tmp-buf)
              (erase-buffer)

+             (mm-disable-multibyte)

              (insert-buffer-substring msg-buf beg end)
              (insert-buffer-substring msg-buf beg end)

-             (goto-char (point-min))
-             (search-forward "\n\n")
-             (forward-char -1)
-             (insert mail-header-separator)
-             (setq message-newsreader (setq message-mailer
-                                            (gnus-extended-version)))

              (cond
               ((string= (gnus-soup-reply-kind (car replies)) "news")
                (gnus-message 5 "Sending news message to %s..."
                              (mail-fetch-field "newsgroups"))
                (sit-for 1)
                (let ((message-syntax-checks
              (cond
               ((string= (gnus-soup-reply-kind (car replies)) "news")
                (gnus-message 5 "Sending news message to %s..."
                              (mail-fetch-field "newsgroups"))
                (sit-for 1)
                (let ((message-syntax-checks

-                      'dont-check-for-anything-just-trust-me))
-                 (funcall message-send-news-function)))
+                      'dont-check-for-anything-just-trust-me)
+                     (method (if (functionp message-post-method)
+                                 (funcall message-post-method)
+                               message-post-method))
+                     result)
+                 (run-hooks 'message-send-news-hook)
+                 (gnus-open-server method)
+                 (message "Sending news via %s..."
+                          (gnus-server-string method))
+                 (unless (let ((mail-header-separator ""))
+                           (gnus-request-post method))
+                   (message "Couldn't send message via news: %s"
+                            (nnheader-get-report (car method))))))

               ((string= (gnus-soup-reply-kind (car replies)) "mail")
                (gnus-message 5 "Sending mail to %s..."
                              (mail-fetch-field "to"))
                (sit-for 1)
               ((string= (gnus-soup-reply-kind (car replies)) "mail")
                (gnus-message 5 "Sending mail to %s..."
                              (mail-fetch-field "to"))
                (sit-for 1)

-               (message-send-mail))
+               (let ((mail-header-separator ""))
+                 (mm-with-unibyte-current-buffer
+                   (funcall (or message-send-mail-real-function
+                                message-send-mail-function)))))

               (t
                (error "Unknown reply kind")))
              (set-buffer msg-buf)
               (t
                (error "Unknown reply kind")))
              (set-buffer msg-buf)