From 13fedf515a4498dba4f9f2cfd16913650260e3c7 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 17 May 2004 21:57:51 +0000 Subject: [PATCH] Synch to No Gnus 200405172048. --- lisp/ChangeLog | 13 +++++++++++ lisp/mail-source.el | 63 ++++++++++++++++++++++++++++----------------------- lisp/nnrss.el | 36 ++++++++++++++--------------- lisp/spam.el | 36 +++++++++++++++++------------ 4 files changed, 87 insertions(+), 61 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3836235..02ca1d5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,18 @@ +2004-05-17 Teodor Zlatanov + + * 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 + * 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 --- 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 --- 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 --- 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)) -- 1.7.10.4