(gnus-copy-article-buffer): Bind `inhibit-read-only' to t during modifying the
[elisp/gnus.git-] / lisp / mail-source.el
index 12839f0..31e1029 100644 (file)
   "The mail-fetching library."
   :group 'gnus)
 
+(defcustom mail-sources nil
+  "*Where the mail backends will look for incoming mail.
+This variable is a list of mail source specifiers."
+  :group 'mail-source
+  :type 'sexp)
+
 (defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
   "File where mail will be stored while processing it."
   :group 'mail-source
@@ -62,6 +68,8 @@
 (eval-and-compile
   (defvar mail-source-keyword-map
     '((file
+       (:prescript)
+       (:postscript)
        (:path (or (getenv "MAIL")
                  (concat "/usr/spool/mail/" (user-login-name)))))
       (directory
        (:prescript)
        (:postscript)
        (:server (getenv "MAILHOST"))
-       (:port "pop")
+       (:port 110)
        (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
        (:program)
        (:function)
        (:password)
+       (:connection)
        (:authentication password))
       (maildir
        (:path "~/Maildir/new/")))
@@ -111,12 +120,17 @@ All keywords that can be used must be listed here."))
 
 (defmacro mail-source-bind (type-source &rest body)
   "Return a `let' form that binds all variables in source TYPE.
+TYPE-SOURCE is a list where the first element is the TYPE, and
+the second variable is the SOURCE.
 At run time, the mail source specifier SOURCE will be inspected,
 and the variables will be set according to it.  Variables not
 specified will be given default values.
 
 After this is done, BODY will be executed in the scope
-of the `let' form."
+of the `let' form.
+
+The variables bound and their default values are described by
+the `mail-source-keyword-map' variable."
   `(let ,(mail-source-bind-1 (car type-source))
      (mail-source-set-1 ,(cadr type-source))
      ,@body))
@@ -162,8 +176,15 @@ 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)))
-      (+ found (funcall function source callback)))))
+                     callback mail-source-crash-box)))
+      (+ found
+         (condition-case err
+             (funcall function source callback)
+           (error
+            (unless (yes-or-no-p
+                    (format "Mail source error.  Continue? "))
+              (error "Cannot get new mail."))
+            0))))))
 
 (defun mail-source-make-complex-temp-name (prefix)
   (let ((newname (make-temp-name prefix))
@@ -289,9 +310,26 @@ 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)))))
     (let ((mail-source-string (format "file:%s" path)))
       (if (mail-source-movemail path mail-source-crash-box)
-         (mail-source-callback callback path)
+         (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))))))
        0))))
 
 (defun mail-source-fetch-directory (source callback)
@@ -311,10 +349,11 @@ If ARGS, PROMPT is used as an argument to `format'."
   "Fetcher for single-file sources."
   (mail-source-bind (pop source)
     (when prescript
-      (if (fboundp prescript)
+      (if (and (symbolp prescript)
+              (fboundp prescript))
          (funcall prescript)
-       (call-process shell-file-name nil nil nil
-                     shell-command-switch
+       (call-process shell-file-name nil 0 nil
+                     shell-command-switch 
                      (format-spec
                       prescript
                       (format-spec-make ?p password ?t mail-source-crash-box
@@ -322,13 +361,14 @@ If ARGS, PROMPT is used as an argument to `format'."
     (let ((from (format "%s:%s:%s" server user port))
          (mail-source-string (format "pop:%s@%s" user server))
          result)
-      (setq password
-           (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))
+      (when (eq authentication 'password)
+       (setq password
+             (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)))
       (when server
        (setenv "MAILHOST" server))
       (setq result
@@ -348,16 +388,18 @@ If ARGS, PROMPT is used as an argument to `format'."
                    (pop3-mailhost server)
                    (pop3-port port)
                    (pop3-authentication-scheme
-                    (if (eq authentication 'apop) 'apop 'pass)))
+                    (if (eq authentication 'apop) 'apop 'pass))
+                   (pop3-connection-type connection))
                (save-excursion (pop3-movemail mail-source-crash-box))))))
       (if result
          (prog1
              (mail-source-callback callback server)
            (when prescript
-             (if (fboundp prescript)
+             (if (and (symbolp postscript)
+                      (fboundp postscript))
                  (funcall prescript)
-               (call-process shell-file-name nil nil nil
-                             shell-command-switch
+               (call-process shell-file-name nil 0 nil
+                             shell-command-switch 
                              (format-spec
                               postscript
                               (format-spec-make