Synch to No Gnus 200405172048.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3836235..02ca1d5 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,18 @@
+2004-05-17  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * spam.el (spam-summary-prepare-exit): fix messages, so they show
+       only when there is spam or ham to be processed
+
 2004-05-17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+       * mail-source.el (mail-source-delete-crash-box): Refactor.
+       (mail-source-fetch): Use it.
+       (mail-source-fetch-file): Ditto.
+       (mail-source-fetch-directory): Run postscript in loop. 
+       (mail-source-fetch-pop): Delete.
+       (mail-source-fetch-maildir): Ditto.
+       (mail-source-fetch-imap): Ditto.
+
        * imap.el (imap-authenticators): Comment out sasl.
 
        * message.el (message-skip-to-next-address): New function.

diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index 1871fec..22cdd44 100644 (file)
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -494,7 +494,8 @@ Return the number of files that were found."
            (when (file-exists-p mail-source-crash-box)
              (message "Processing mail from %s..." mail-source-crash-box)
              (setq found (mail-source-callback
-                          callback mail-source-crash-box)))
+                          callback mail-source-crash-box))
+             (mail-source-delete-crash-box))
            (+ found
               (if (or debug-on-quit debug-on-error)
                   (funcall function source callback)
@@ -544,33 +545,33 @@ If CONFIRM is non-nil, ask for confirmation before removing a file."
          (delete-file ffile))))))
 
 (defun mail-source-callback (callback info)
-  "Call CALLBACK on the mail file, and then remove the mail file.
-Pass INFO on to CALLBACK."
+  "Call CALLBACK on the mail file.  Pass INFO on to CALLBACK."
   (if (or (not (file-exists-p mail-source-crash-box))
          (zerop (nth 7 (file-attributes mail-source-crash-box))))
       (progn
        (when (file-exists-p mail-source-crash-box)
          (delete-file mail-source-crash-box))
        0)
-    (prog1
-       (funcall callback mail-source-crash-box info)
-      (when (file-exists-p mail-source-crash-box)
-       ;; Delete or move the incoming mail out of the way.
-       (if (eq mail-source-delete-incoming t)
-           (delete-file mail-source-crash-box)
-         (let ((incoming
-                (mm-make-temp-file
-                 (expand-file-name
-                  mail-source-incoming-file-prefix
-                  mail-source-directory))))
-           (unless (file-exists-p (file-name-directory incoming))
-             (make-directory (file-name-directory incoming) t))
-           (rename-file mail-source-crash-box incoming t)
-           ;; remove old incoming files?
-           (when (natnump mail-source-delete-incoming)
-             (mail-source-delete-old-incoming
-              mail-source-delete-incoming
-              mail-source-delete-old-incoming-confirm))))))))
+    (funcall callback mail-source-crash-box info)))
+
+(defun mail-source-delete-crash-box ()
+  (when (file-exists-p mail-source-crash-box)
+    ;; Delete or move the incoming mail out of the way.
+    (if (eq mail-source-delete-incoming t)
+       (delete-file mail-source-crash-box)
+      (let ((incoming
+            (mm-make-temp-file
+             (expand-file-name
+              mail-source-incoming-file-prefix
+              mail-source-directory))))
+       (unless (file-exists-p (file-name-directory incoming))
+         (make-directory (file-name-directory incoming) t))
+       (rename-file mail-source-crash-box incoming t)
+       ;; remove old incoming files?
+       (when (natnump mail-source-delete-incoming)
+         (mail-source-delete-old-incoming
+          mail-source-delete-incoming
+          mail-source-delete-old-incoming-confirm))))))
 
 (defun mail-source-movemail (from to)
   "Move FROM to TO using movemail."
@@ -684,7 +685,8 @@ Pass INFO on to CALLBACK."
          (prog1
              (mail-source-callback callback path)
            (mail-source-run-script
-            postscript (format-spec-make ?t mail-source-crash-box)))
+            postscript (format-spec-make ?t mail-source-crash-box))
+           (mail-source-delete-crash-box))
        0))))
 
 (defun mail-source-fetch-directory (source callback)
@@ -699,8 +701,9 @@ Pass INFO on to CALLBACK."
        (when (and (file-regular-p file)
                   (funcall predicate file)
                   (mail-source-movemail file mail-source-crash-box))
-         (incf found (mail-source-callback callback file))))
-      (mail-source-run-script postscript (format-spec-make ?t path))
+         (incf found (mail-source-callback callback file))
+         (mail-source-run-script postscript (format-spec-make ?t path))
+         (mail-source-delete-crash-box)))
       found)))
 
 (defun mail-source-fetch-pop (source callback)
@@ -770,7 +773,8 @@ Pass INFO on to CALLBACK."
              (mail-source-run-script
               postscript
               (format-spec-make ?p password ?t mail-source-crash-box
-                                ?s server ?P port ?u user))))
+                                ?s server ?P port ?u user))
+             (mail-source-delete-crash-box)))
        ;; We nix out the password in case the error
        ;; was because of a wrong password being given.
        (setq mail-source-password-cache
@@ -955,7 +959,8 @@ This only works when `display-time' is enabled."
                                  ;; MMDF mail format
                                  (insert "\001\001\001\001\n"))
                                (delete-file file)))))
-             (incf found (mail-source-callback callback file))))))
+             (incf found (mail-source-callback callback file))
+             (mail-source-delete-crash-box)))))
       found)))
 
 (eval-and-compile
@@ -1020,6 +1025,7 @@ This only works when `display-time' is enabled."
                  (goto-char (point-max))))
              (nnheader-ms-strip-cr))
            (incf found (mail-source-callback callback server))
+           (mail-source-delete-crash-box)
            (when (and remove fetchflag)
              (setq remove (nreverse remove))
              (imap-message-flags-add
@@ -1065,7 +1071,8 @@ This only works when `display-time' is enabled."
          (push (cons (format "webmail:%s:%s" subtype user) password)
                mail-source-password-cache)))
       (webmail-fetch mail-source-crash-box subtype user password)
-      (mail-source-callback callback (symbol-name subtype)))))
+      (mail-source-callback callback (symbol-name subtype))
+      (mail-source-delete-crash-box))))
 
 (provide 'mail-source)
 

diff --git a/lisp/nnrss.el b/lisp/nnrss.el
index 2e410e1..fc2662a 100644 (file)
--- a/lisp/nnrss.el
+++ b/lisp/nnrss.el
@@ -253,7 +253,7 @@ ARTICLE is the article number of the current headline.")
 (defun nnrss-fetch (url &optional local)
   "Fetch URL and put it in a the expected Lisp structure."
   (with-temp-buffer
-  ;some CVS versions of url.el need this to close the connection quickly
+    ;;some CVS versions of url.el need this to close the connection quickly
     (let* (xmlform htmlform)
       ;; bit o' work necessary for w3 pre-cvs and post-cvs
       (if local
@@ -261,23 +261,23 @@ ARTICLE is the article number of the current headline.")
            (insert-file-contents url))
        (mm-url-insert url))
 
-;; Because xml-parse-region can't deal with anything that isn't
-;; xml and w3-parse-buffer can't deal with some xml, we have to
-;; parse with xml-parse-region first and, if that fails, parse
-;; with w3-parse-buffer.  Yuck.  Eventually, someone should find out
-;; why w3-parse-buffer fails to parse some well-formed xml and
-;; fix it.
-
-    (condition-case err
-       (setq xmlform (xml-parse-region (point-min) (point-max)))
-      (error (if (fboundp 'w3-parse-buffer)
-                (setq htmlform (caddar (w3-parse-buffer
-                                        (current-buffer))))
-              (message "nnrss: Not valid XML and w3 parse not available (%s)"
-                       url))))
-    (if htmlform
-       htmlform
-      xmlform))))
+      ;; Because xml-parse-region can't deal with anything that isn't
+      ;; xml and w3-parse-buffer can't deal with some xml, we have to
+      ;; parse with xml-parse-region first and, if that fails, parse
+      ;; with w3-parse-buffer.  Yuck.  Eventually, someone should find out
+      ;; why w3-parse-buffer fails to parse some well-formed xml and
+      ;; fix it.
+
+      (condition-case err
+         (setq xmlform (xml-parse-region (point-min) (point-max)))
+       (error (if (fboundp 'w3-parse-buffer)
+                  (setq htmlform (caddar (w3-parse-buffer
+                                          (current-buffer))))
+                (message "nnrss: Not valid XML and w3 parse not available (%s)"
+                         url))))
+      (if htmlform
+         htmlform
+       xmlform))))
 
 (defun nnrss-possibly-change-group (&optional group server)
   (when (and server

diff --git a/lisp/spam.el b/lisp/spam.el
index 1634027..adb83c7 100644 (file)
--- a/lisp/spam.el
+++ b/lisp/spam.el
@@ -861,11 +861,14 @@ Will not return a nil score."
 
     (unless (and spam-move-spam-nonspam-groups-only
                 (spam-group-spam-contents-p gnus-newsgroup-name))
-      (gnus-message 6 "Marking spam as expired and moving it to %s"
-                   (gnus-parameter-spam-process-destination 
-                    gnus-newsgroup-name))
-      (spam-mark-spam-as-expired-and-move-routine
-       (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
+      (when (< 0 (length (spam-list-articles
+                         gnus-newsgroup-articles
+                         'spam)))
+       (gnus-message 6 "Marking spam as expired and moving it to %s"
+                     (gnus-parameter-spam-process-destination 
+                      gnus-newsgroup-name))
+       (spam-mark-spam-as-expired-and-move-routine
+        (gnus-parameter-spam-process-destination gnus-newsgroup-name))))
 
     ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
     ;; expire spam, in case the above did not expire them
@@ -888,16 +891,19 @@ Will not return a nil score."
                     (spam-group-processor-p gnus-newsgroup-name processor))
            (spam-register-routine classification check)))))
 
-    (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
-      (gnus-message 6 "Copying ham")
-      (spam-ham-copy-routine
-       (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
-
-    ;; now move all ham articles out of spam groups
-    (when (spam-group-spam-contents-p gnus-newsgroup-name)
-      (gnus-message 6 "Moving ham messages from spam group")
-      (spam-ham-move-routine
-       (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
+    (when (< 0 (length (spam-list-articles
+                       gnus-newsgroup-articles
+                       'ham)))
+      (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
+       (gnus-message 6 "Copying ham")
+       (spam-ham-copy-routine
+        (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
+
+      ;; now move all ham articles out of spam groups
+      (when (spam-group-spam-contents-p gnus-newsgroup-name)
+       (gnus-message 6 "Moving ham messages from spam group")
+       (spam-ham-move-routine
+        (gnus-parameter-ham-process-destination gnus-newsgroup-name)))))
 
   (setq spam-old-ham-articles nil)
   (setq spam-old-spam-articles nil))