X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fmail-source.el;h=b40163c4d4095e187041399c5425d0a3654d1862;hb=da5585ac5598dca14f6928a033427dd6be3c34aa;hp=6d7644abf8f537718c37a78ebf96aab31e50702a;hpb=aec51be27a1d5f815bf7eba9e6eca7e400f912cb;p=gnus diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 6d7644abf..b40163c4d 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' @@ -234,7 +234,10 @@ See Info node `(gnus)Mail Source Specifiers'." (defcustom mail-source-ignore-errors nil "*Ignore errors when querying mail sources. If nil, the user will be prompted when an error occurs. If non-nil, -the error will be ignored.") +the error will be ignored." + :version "21.4" + :group 'mail-source + :type 'boolean) (defcustom mail-source-primary-source nil "*Primary source for incoming mail. @@ -253,7 +256,7 @@ If non-nil, this maildrop will be checked periodically for new mail." :type 'file) (defcustom mail-source-directory message-directory - "Directory where files (if any) will be stored." + "Directory where incoming mail source files (if any) will be stored." :group 'mail-source :type 'directory) @@ -280,6 +283,7 @@ files older than number of days." "*If non-nil, ask for for confirmation before deleting old incoming files. This variable only applies when `mail-source-delete-incoming' is a positive number." + :version "21.4" :group 'mail-source :type 'boolean) @@ -300,6 +304,7 @@ number." (defcustom mail-source-movemail-program nil "If non-nil, name of program for fetching new mail." + :version "21.4" :group 'mail-source :type '(choice (const nil) string)) @@ -344,7 +349,7 @@ Common keywords should be listed here.") (:authentication password)) (maildir (:path (or (getenv "MAILDIR") "~/Maildir/")) - (:subdirs ("new" "cur")) + (:subdirs ("cur" "new")) (:function)) (imap (:server (getenv "MAILHOST")) @@ -357,6 +362,9 @@ Common keywords should be listed here.") (:mailbox "INBOX") (:predicate "UNSEEN UNDELETED") (:fetchflag "\\Deleted") + (:prescript) + (:prescript-delay) + (:postscript) (:dontexpunge)) (webmail (:subtype hotmail) @@ -490,7 +498,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) @@ -511,17 +520,6 @@ Return the number of files that were found." (error "Cannot get new mail")) 0))))))))) -(eval-and-compile - (if (fboundp 'make-temp-file) - (defalias 'mail-source-make-complex-temp-name 'make-temp-file) - (defun mail-source-make-complex-temp-name (prefix) - (let ((newname (make-temp-name prefix)) - (newprefix prefix)) - (while (file-exists-p newname) - (setq newprefix (concat newprefix "x")) - (setq newname (make-temp-name newprefix))) - newname)))) - (defun mail-source-delete-old-incoming (&optional age confirm) "Remove incoming files older than AGE days. If CONFIRM is non-nil, ask for confirmation before removing a file." @@ -551,33 +549,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 - (mail-source-make-complex-temp-name - (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." @@ -619,7 +617,8 @@ Pass INFO on to CALLBACK." (set-file-modes to mail-source-default-file-modes)) (if (and (or (not (buffer-modified-p errors)) (zerop (buffer-size errors))) - (zerop result)) + (and (numberp result) + (zerop result))) ;; No output => movemail won. t (set-buffer errors) @@ -655,8 +654,8 @@ Pass INFO on to CALLBACK." (delete-file from))) (defun mail-source-fetch-with-program (program) - (zerop (call-process shell-file-name nil nil nil - shell-command-switch program))) + (eq 0 (call-process shell-file-name nil nil nil + shell-command-switch program))) (defun mail-source-run-script (script spec &optional delay) (when script @@ -690,15 +689,15 @@ 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) "Fetcher for directory sources." (mail-source-bind (directory source) (mail-source-run-script - prescript (format-spec-make ?t path) - prescript-delay) + prescript (format-spec-make ?t path) prescript-delay) (let ((found 0) (mail-source-string (format "directory:%s" path))) (dolist (file (directory-files @@ -706,9 +705,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) @@ -772,7 +771,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 @@ -834,12 +834,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))) @@ -909,7 +910,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)) @@ -954,7 +955,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 @@ -978,9 +980,13 @@ This only works when `display-time' is enabled." (defun mail-source-fetch-imap (source callback) "Fetcher for imap sources." (mail-source-bind (imap source) + (mail-source-run-script + prescript (format-spec-make ?p password ?t mail-source-crash-box + ?s server ?P port ?u user) + prescript-delay) (let ((from (format "%s:%s:%s" server user port)) (found 0) - (buf (get-buffer-create (generate-new-buffer-name " *imap source*"))) + (buf (generate-new-buffer " *imap source*")) (mail-source-string (format "imap:%s:%s" server mailbox)) (imap-shell-program (or (list program) imap-shell-program)) remove) @@ -997,8 +1003,8 @@ This only works when `display-time' is enabled." (mm-disable-multibyte) ;; remember password (with-current-buffer buf - (when (or imap-password - (assoc from mail-source-password-cache)) + (when (and imap-password + (not (assoc from mail-source-password-cache))) (push (cons from imap-password) mail-source-password-cache))) ;; if predicate is nil, use all uids (dolist (uid (imap-search (or predicate "1:*") buf)) @@ -1016,7 +1022,9 @@ 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 (imap-range-to-message-set (gnus-compress-sequence remove)) fetchflag nil buf)) @@ -1030,8 +1038,12 @@ This only works when `display-time' is enabled." (setq mail-source-password-cache (delq (assoc from mail-source-password-cache) mail-source-password-cache)) - (error (imap-error-text buf))) + (error "IMAP error: %s" (imap-error-text buf))) (kill-buffer buf) + (mail-source-run-script + postscript + (format-spec-make ?p password ?t mail-source-crash-box + ?s server ?P port ?u user)) found))) (eval-and-compile @@ -1056,8 +1068,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