Slightly improve documentation for a couple of variables

[gnus] / lisp / mail-source.el

diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index 018fb32..be0cea4 100644 (file)
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -1,5 +1,5 @@
 ;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail
@@ -27,7 +27,8 @@
 
 (eval-when-compile (require 'cl))
 (eval-and-compile
-  (autoload 'pop3-movemail "pop3"))
+  (autoload 'pop3-movemail "pop3")
+  (autoload 'pop3-get-message-count "pop3"))
 (require 'format-spec)
 
 (defgroup mail-source nil
@@ -61,7 +62,7 @@ If non-nil, this maildrop will be checked periodically for new mail."
   :group 'mail-source
   :type 'integer)
 
-(defcustom mail-source-delete-incoming t
+(defcustom mail-source-delete-incoming nil
   "*If non-nil, delete incoming files after handling."
   :group 'mail-source
   :type 'boolean)
@@ -113,7 +114,8 @@ Common keywords should be listed here.")
        (:password)
        (:authentication password))
       (maildir
-       (:path "~/Maildir/new/")
+       (:path (or (getenv "MAILDIR") "~/Maildir/"))
+       (:subdirs ("new" "cur"))
        (:function))
       (imap
        (:server (getenv "MAILHOST"))
@@ -130,6 +132,7 @@ Common keywords should be listed here.")
        (:subtype hotmail)
        (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
        (:password)
+       (:dontexpunge)
        (:authentication password)))
     "Mapping from keywords to default values.
 All keywords that can be used must be listed here."))
@@ -604,13 +607,32 @@ This only works when `display-time' is enabled."
   "Fetcher for maildir sources."
   (mail-source-bind (maildir source)
     (let ((found 0)
-         (mail-source-string (format "maildir:%s" path)))
-      (dolist (file (directory-files path t))
-       (when (and (not (file-directory-p file))
-                  (not (if function
-                           (funcall function file mail-source-crash-box)
-                         (rename-file file mail-source-crash-box))))
-         (incf found (mail-source-callback callback file))))
+         mail-source-string)
+      (unless (string-match "/$" path)
+       (setq path (concat path "/")))
+      (dolist (subdir subdirs)
+       (when (file-directory-p (concat path subdir))
+         (setq mail-source-string (format "maildir:%s%s" path subdir))
+         (dolist (file (directory-files (concat path subdir) t))
+           (when (and (not (file-directory-p file))
+                      (not (if function
+                               (funcall function file mail-source-crash-box)
+                             (let ((coding-system-for-write 
+                                    mm-text-coding-system)
+                                   (coding-system-for-read 
+                                    mm-text-coding-system))
+                               (with-temp-file mail-source-crash-box
+                                 (insert-file-contents file)
+                                 (goto-char (point-min))
+                                 (unless (looking-at "\n*From ")
+                                   (insert "From maildir " 
+                                           (current-time-string) "\n"))
+                                 (while (re-search-forward "^From " nil t)
+                                   (replace-match ">From "))
+                                 (goto-char (point-max))
+                                 (insert "\n\n"))
+                               (delete-file file)))))
+             (incf found (mail-source-callback callback file))))))
       found)))
 
 (eval-and-compile
@@ -630,15 +652,23 @@ 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 ((found 0)
+    (let ((from (format "%s:%s:%s" server user port))
+         (found 0)
          (buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
          (mail-source-string (format "imap:%s:%s" server mailbox))
          remove)
       (if (and (imap-open server port stream authentication buf)
-              (imap-authenticate user password buf)
+              (imap-authenticate
+               user (or (cdr (assoc from mail-source-password-cache))
+                        password) buf)
               (imap-mailbox-select mailbox nil buf))
          (let (str (coding-system-for-write 'binary))
            (with-temp-file mail-source-crash-box
+             ;; remember password
+             (with-current-buffer buf
+               (when (or imap-password
+                         (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))
                (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))
@@ -659,6 +689,11 @@ This only works when `display-time' is enabled."
              (imap-mailbox-close buf))
            (imap-close buf))
        (imap-close buf)
+       ;; We nix out the password in case the error
+       ;; was because of a wrong password being given.
+       (setq mail-source-password-cache
+             (delq (assoc from mail-source-password-cache)
+                   mail-source-password-cache))
        (error (imap-error-text buf)))
       (kill-buffer buf)
       found)))
@@ -669,13 +704,23 @@ This only works when `display-time' is enabled."
 (defun mail-source-fetch-webmail (source callback)
   "Fetch for webmail source."
   (mail-source-bind (webmail source)
-    (when (eq authentication 'password)
-      (setq password
-           (or password
-               (mail-source-read-passwd
-                (format "Password for %s at %s: " user subtype)))))
-    (webmail-fetch mail-source-crash-box subtype user password)
-    (mail-source-callback callback (symbol-name subtype))))
+    (let ((mail-source-string (format "webmail:%s:%s" subtype user))
+         (webmail-newmail-only dontexpunge)
+         (webmail-move-to-trash-can (not dontexpunge)))
+      (when (eq authentication 'password)
+       (setq password
+             (or password
+                 (cdr (assoc (format "webmail:%s:%s" subtype user) 
+                             mail-source-password-cache))
+                 (mail-source-read-passwd
+                  (format "Password for %s at %s: " user subtype))))
+       (when (and password
+                  (not (assoc (format "webmail:%s:%s" subtype user) 
+                              mail-source-password-cache)))
+         (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)))))
 
 (provide 'mail-source)