X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmail-source.el;h=7172930067552d49524dd502e10ee847707e1e85;hb=b163bd0df28602df80acf1d6cbaa9f9bfaba9048;hp=9c0cd5b5c2e7814bc676e516565e0dd4ab5a553c;hpb=ae830d9e4a614e655918cc6b3481c0362f230c89;p=gnus diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 9c0cd5b5c..717293006 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -1,5 +1,6 @@ ;;; mail-source.el --- functions for fetching mail -;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -32,8 +33,7 @@ (eval-and-compile (autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") - (autoload 'nnheader-cancel-timer "nnheader") - (autoload 'nnheader-run-at-time "nnheader")) + (autoload 'nnheader-cancel-timer "nnheader")) (require 'format-spec) (require 'mm-util) (require 'message) ;; for `message-directory' @@ -493,7 +493,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) @@ -543,33 +544,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." @@ -683,7 +684,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) @@ -698,8 +700,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) @@ -763,7 +766,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 @@ -825,12 +829,13 @@ Pass INFO on to CALLBACK." "Open and close a POP connection shortly. POP server should be defined in `mail-source-primary-source' (which is preferred) or `mail-sources'. You may use it for the POP-before-SMTP -authentication. To do that, you need to set the option -`message-send-mail-function' to `message-smtpmail-send-it' and put the -following line in .gnus file: +authentication. To do that, you need to set the +`message-send-mail-function' variable as `message-smtpmail-send-it' +and put the following line in your ~/.gnus.el file: \(add-hook 'message-send-mail-hook 'mail-source-touch-pop) -" + +See the Gnus manual for details." (let ((sources (if mail-source-primary-source (list mail-source-primary-source) mail-sources))) @@ -900,7 +905,7 @@ This only works when `display-time' is enabled." (setq display-time-mail-function #'mail-source-new-mail-p) ;; Set up the main timer. (setq mail-source-report-new-mail-timer - (nnheader-run-at-time + (run-at-time (* 60 mail-source-report-new-mail-interval) (* 60 mail-source-report-new-mail-interval) #'mail-source-start-idle-timer)) @@ -945,7 +950,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 @@ -1011,6 +1017,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 @@ -1056,8 +1063,10 @@ 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) +;;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd ;;; mail-source.el ends here