Synch to No Gnus 200405122100.
[elisp/gnus.git-] / lisp / mail-source.el
index e84f79c..1871fec 100644 (file)
@@ -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 <larsi@gnus.org>
 ;; Keywords: news, mail
 (eval-when-compile
   (require 'cl)
   (require 'imap)
-  (defvar display-time-mail-function)
-  (autoload 'pop3-movemail "pop3")
-  (autoload 'pop3-get-message-count "pop3"))
+  (defvar display-time-mail-function))
 (eval-and-compile
-  (autoload 'nnheader-cancel-timer "nnheader")
-  (autoload 'nnheader-run-at-time "nnheader"))
+  (autoload 'pop3-movemail "pop3")
+  (autoload 'pop3-get-message-count "pop3")
+  (autoload 'nnheader-cancel-timer "nnheader"))
 (require 'format-spec)
 (require 'message) ;; for `message-directory'
 
@@ -345,7 +345,7 @@ Common keywords should be listed here.")
        (:leave))
       (maildir
        (:path (or (getenv "MAILDIR") "~/Maildir/"))
-       (:subdirs ("new" "cur"))
+       (:subdirs ("cur" "new"))
        (:function))
       (imap
        (:server (getenv "MAILHOST"))
@@ -358,6 +358,9 @@ Common keywords should be listed here.")
        (:mailbox "INBOX")
        (:predicate "UNSEEN UNDELETED")
        (:fetchflag "\\Deleted")
+       (:prescript)
+       (:prescript-delay)
+       (:postscript)
        (:dontexpunge))
       (webmail
        (:subtype hotmail)
@@ -512,17 +515,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."
@@ -567,7 +559,7 @@ Pass INFO on to CALLBACK."
        (if (eq mail-source-delete-incoming t)
            (delete-file mail-source-crash-box)
          (let ((incoming
-                (mail-source-make-complex-temp-name
+                (mm-make-temp-file
                  (expand-file-name
                   mail-source-incoming-file-prefix
                   mail-source-directory))))
@@ -620,7 +612,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)
@@ -656,8 +649,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
@@ -840,12 +833,14 @@ 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-send-mail-with-smtp' or
-`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-send-mail-with-smtp'
+or `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)))
@@ -915,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))
@@ -945,10 +940,6 @@ This only works when `display-time' is enabled."
                              (let ((coding-system-for-write
                                     nnheader-text-coding-system)
                                    (coding-system-for-read
-                                    nnheader-text-coding-system)
-                                   (output-coding-system
-                                    nnheader-text-coding-system)
-                                   (input-coding-system
                                     nnheader-text-coding-system))
                                (with-temp-file mail-source-crash-box
                                  (insert-file-contents file)
@@ -987,20 +978,22 @@ This only works when `display-time' is enabled."
 (defun mail-source-fetch-imap (source callback)
   "Fetcher for imap sources."
   (mail-source-bind (imap source)
-    (let* ((from (format "%s:%s:%s" server user port))
-          (found 0)
-          (buffer-name " *imap source*")
-          (buf (get-buffer-create (generate-new-buffer-name buffer-name)))
-          (mail-source-string (format "imap:%s:%s" server mailbox))
-          (imap-shell-program (or (list program) imap-shell-program))
-          remove)
-      (if (and (imap-open server port stream authentication buffer-name)
+    (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 (generate-new-buffer " *imap source*"))
+         (mail-source-string (format "imap:%s:%s" server mailbox))
+         (imap-shell-program (or (list program) imap-shell-program))
+         remove)
+      (if (and (imap-open server port stream authentication buf)
               (imap-authenticate
                user (or (cdr (assoc from mail-source-password-cache))
                         password) buf)
               (imap-mailbox-select mailbox nil buf))
          (let ((coding-system-for-write mail-source-imap-file-coding-system)
-               (output-coding-system mail-source-imap-file-coding-system)
                str)
            (with-temp-file mail-source-crash-box
              ;; Avoid converting 8-bit chars from inserted strings to
@@ -1008,8 +1001,8 @@ This only works when `display-time' is enabled."
              (set-buffer-multibyte nil)
              ;; 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))
@@ -1028,6 +1021,7 @@ This only works when `display-time' is enabled."
              (nnheader-ms-strip-cr))
            (incf found (mail-source-callback callback server))
            (when (and remove fetchflag)
+             (setq remove (nreverse remove))
              (imap-message-flags-add
               (imap-range-to-message-set (gnus-compress-sequence remove))
               fetchflag nil buf))
@@ -1041,8 +1035,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