imap mail-source

[Simon Josefsson <jas@pdc.kth.se>]

This patch aginst Gnus makes it possible the use a IMAP server
similarly to POP servers, with `nnmail-spool-file', ie download all
articles and split them into nnmail backends. Probably not very useful
for nnimap users.

I'll submit the patch together with nnimap, when that happen.

Let me know if anyone use it or has any suggestions.

(You need to include your nnimap directory in `dgnushack.el's
load-path to compile it.)

1999-08-18  Simon Josefsson  <jas@pdc.kth.se>

	* mail-source.el (autoload): Load imap.
	(defvar): New imap mail-source.
	(mail-source-fetcher-alist): Map to imap fetcher function.
	(mail-source-fetch-imap): New function.
	(mail-source-fetch-imap-1): Ditto. (Need this to be able to use
	edebug, why?).

--- mail-source.el-	Wed Aug 18 17:49:20 1999
+++ mail-source.el	Wed Aug 18 17:51:45 1999
@@ -28,6 +28,8 @@
 (eval-when-compile (require 'cl))
 (eval-and-compile
   (autoload 'pop3-movemail "pop3"))
+(eval-and-compile
+  (autoload 'imap-open "imap"))
 (require 'format-spec)
 
 (defgroup mail-source nil
@@ -89,7 +91,16 @@
        (:password)
        (:authentication password))
       (maildir
-       (:path "~/Maildir/new/")))
+       (:path "~/Maildir/new/"))
+      (imap
+       (:server (getenv "MAILHOST"))
+       (:port)
+       (:stream)
+       (:authentication)
+       (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
+       (:password)
+       (:mailbox "INBOX")
+       (:predicate "UNSEEN UNDELETED")))
     "Mapping from keywords to default values.
 All keywords that can be used must be listed here."))
 
@@ -97,7 +108,8 @@
   '((file mail-source-fetch-file)
     (directory mail-source-fetch-directory)
     (pop mail-source-fetch-pop)
-    (maildir mail-source-fetch-maildir))
+    (maildir mail-source-fetch-maildir)
+    (imap mail-source-fetch-imap))
   "A mapping from source type to fetcher function.")
 
 (defvar mail-source-password-cache nil)
@@ -416,6 +428,38 @@
 		   (not (rename-file file mail-source-crash-box)))
 	  (incf found (mail-source-callback callback file))))
       found)))
+
+(defun mail-source-fetch-imap (source callback)
+  "Fetcher for imap sources."
+  (mail-source-bind (imap source)
+    (mail-source-fetch-imap-1)))
+
+(defun mail-source-fetch-imap-1 ()
+  (let ((found 0)
+	(buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
+	(mail-source-string (format "imap:%s:%s" server mailbox)))
+    (if (and (imap-open server port stream authentication buf)
+	     (imap-authenticate user password buf)
+	     (imap-mailbox-select mailbox nil buf))
+	(let (str (coding-system-for-write 'binary))
+	  (with-temp-file mail-source-crash-box
+	    ;; if predicate is nil, use all uids
+	    (dolist (uid (imap-search (or predicate "1:*") buf))
+	      (when (setq str (imap-fetch uid "RFC822" 'RFC822 nil buf))
+		(insert "From imap " (current-time-string) "\n")
+		(save-excursion
+		  (insert str "\n\n"))
+		(while (re-search-forward "^From " nil t)
+		  (replace-match ">From "))
+		(goto-char (point-max))))
+	    (nnheader-ms-strip-cr))
+	  (incf found (mail-source-callback callback server))
+	  (imap-mailbox-unselect buf)
+	  (imap-close buf))
+      (imap-close buf)
+      (error (imap-error-text buf)))
+    (kill-buffer buf)
+    found))
 
 (provide 'mail-source)