Importing Pterodactyl Gnus v0.97.

[elisp/gnus.git-] / lisp / mail-source.el

diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index acd758c..cc58f6f 100644 (file)
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -69,6 +69,7 @@ This variable is a list of mail source specifiers."
   (defvar mail-source-keyword-map
     '((file
        (:prescript)
+       (:prescript-delay)
        (:postscript)
        (:path (or (getenv "MAIL")
                  (concat "/usr/spool/mail/" (user-login-name)))))
@@ -78,6 +79,7 @@ This variable is a list of mail source specifiers."
        (:predicate identity))
       (pop
        (:prescript)
+       (:prescript-delay)
        (:postscript)
        (:server (getenv "MAILHOST"))
        (:port 110)
@@ -181,7 +183,7 @@ Return the number of files that were found."
              (funcall function source callback)
            (error
             (unless (yes-or-no-p
-                    (format "Mail source error.  Continue? "))
+                    (format "Mail source error (%s).  Continue? " err))
               (error "Cannot get new mail."))
             0))))))
 
@@ -202,19 +204,19 @@ Pass INFO on to CALLBACK."
        (when (file-exists-p mail-source-crash-box)
          (delete-file mail-source-crash-box))
        0)
-    (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 mail-source-delete-incoming
-         (delete-file mail-source-crash-box)
-       (let ((incoming
-              (mail-source-make-complex-temp-name
-               (expand-file-name
-                "Incoming" 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))))
-    1))
+    (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 mail-source-delete-incoming
+           (delete-file mail-source-crash-box)
+         (let ((incoming
+                (mail-source-make-complex-temp-name
+                 (expand-file-name
+                  "Incoming" 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)))))))
 
 (defun mail-source-movemail (from to)
   "Move FROM to TO using movemail."
@@ -302,6 +304,23 @@ If ARGS, PROMPT is used as an argument to `format'."
   (zerop (call-process shell-file-name nil nil nil
                       shell-command-switch program)))
 
+(defun mail-source-run-script (script spec &optional delay)
+  (when script
+    (if (and (symbolp script) (fboundp script))
+       (funcall script)
+      (mail-source-call-script
+       (format-spec script spec))))
+  (when delay
+    (sleep-for delay)))
+
+(defun mail-source-call-script (script)
+  (let ((background nil))
+    (when (string-match "& *$" script)
+      (setq script (substring script 0 (match-beginning 0))
+           background 0))
+    (call-process shell-file-name nil background nil
+                 shell-command-switch script)))
+
 ;;;
 ;;; Different fetchers
 ;;;
@@ -309,26 +328,15 @@ If ARGS, PROMPT is used as an argument to `format'."
 (defun mail-source-fetch-file (source callback)
   "Fetcher for single-file sources."
   (mail-source-bind (file source)
-    (when prescript
-      (if (and (symbolp prescript) (fboundp prescript))
-         (funcall prescript)
-       (call-process shell-file-name nil nil nil
-                     shell-command-switch 
-                     (format-spec
-                      prescript
-                      (format-spec-make ?t mail-source-crash-box)))))
+    (mail-source-run-script
+     prescript (format-spec-make ?t mail-source-crash-box)
+     prescript-delay)
     (let ((mail-source-string (format "file:%s" path)))
       (if (mail-source-movemail path mail-source-crash-box)
          (prog1
              (mail-source-callback callback path)
-           (when prescript
-             (if (and (symbolp prescript) (fboundp prescript))
-                 (funcall prescript)
-               (call-process shell-file-name nil nil nil
-                             shell-command-switch 
-                             (format-spec
-                              postscript
-                              (format-spec-make ?t mail-source-crash-box))))))
+           (mail-source-run-script
+            postscript (format-spec-make ?t mail-source-crash-box)))
        0))))
 
 (defun mail-source-fetch-directory (source callback)
@@ -347,16 +355,11 @@ If ARGS, PROMPT is used as an argument to `format'."
 (defun mail-source-fetch-pop (source callback)
   "Fetcher for single-file sources."
   (mail-source-bind (pop source)
-    (when prescript
-      (if (and (symbolp prescript)
-              (fboundp prescript))
-         (funcall prescript)
-       (call-process shell-file-name nil 0 nil
-                     shell-command-switch 
-                     (format-spec
-                      prescript
-                      (format-spec-make ?p password ?t mail-source-crash-box
-                                        ?s server ?P port ?u user)))))
+    (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))
          (mail-source-string (format "pop:%s@%s" user server))
          result)
@@ -365,9 +368,7 @@ If ARGS, PROMPT is used as an argument to `format'."
              (or password
                  (cdr (assoc from mail-source-password-cache))
                  (mail-source-read-passwd
-                  (format "Password for %s at %s: " user server))))
-       (unless (assoc from mail-source-password-cache)
-         (push (cons from password) mail-source-password-cache)))
+                  (format "Password for %s at %s: " user server)))))
       (when server
        (setenv "MAILHOST" server))
       (setq result
@@ -390,19 +391,16 @@ If ARGS, PROMPT is used as an argument to `format'."
                     (if (eq authentication 'apop) 'apop 'pass)))
                (save-excursion (pop3-movemail mail-source-crash-box))))))
       (if result
-         (prog1
-             (mail-source-callback callback server)
-           (when prescript
-             (if (and (symbolp postscript)
-                      (fboundp postscript))
-                 (funcall prescript)
-               (call-process shell-file-name nil 0 nil
-                             shell-command-switch 
-                             (format-spec
-                              postscript
-                              (format-spec-make
-                               ?p password ?t mail-source-crash-box
-                               ?s server ?P port ?u user))))))
+         (progn
+           (when (eq authentication 'password)
+             (unless (assoc from mail-source-password-cache)
+               (push (cons from password) mail-source-password-cache)))
+           (prog1
+               (mail-source-callback callback server)
+             (mail-source-run-script
+              postscript
+              (format-spec-make ?p password ?t mail-source-crash-box
+                                ?s server ?P port ?u user))))
        ;; We nix out the password in case the error
        ;; was because of a wrong password being given.
        (setq mail-source-password-cache