Synch with Oort Gnus.

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

diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index 982db42..6cc9e78 100644 (file)
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -30,12 +30,12 @@
   (require 'imap)
   (eval-when-compile (defvar display-time-mail-function)))
 (eval-and-compile
+  (defvar pop3-leave-mail-on-server)
   (autoload 'pop3-movemail "pop3")
   (autoload 'pop3-get-message-count "pop3")
   (autoload 'nnheader-cancel-timer "nnheader")
   (autoload 'nnheader-run-at-time "nnheader"))
 (require 'format-spec)
-(require 'mm-util)
 (require 'message) ;; for `message-directory'
 
 (defgroup mail-source nil
@@ -48,12 +48,12 @@
   (eval-when-compile
     (mapcar (lambda (a)
              (list 'const (car a)))
-     imap-authenticator-alist)))
+           imap-authenticator-alist)))
 (defconst mail-source-imap-streams
   (eval-when-compile
     (mapcar (lambda (a)
              (list 'const (car a)))
-     imap-stream-alist)))
+           imap-stream-alist)))
 
 (defcustom mail-sources nil
   "*Where the mail backends will look for incoming mail.
@@ -193,17 +193,17 @@ See Info node `(gnus)Mail Source Specifiers'."
                        (const :format "" webmail)
                        (checklist :tag "Options" :greedy t
                                   (group :inline t
-                                        (const :format "" :value :subtype)
-                                        ;; Should be generated from
-                                        ;; `webmail-type-definition', but we
-                                        ;; can't require webmail without W3.
-                                        (choice :tag "Subtype"
-                                                :value hotmail
-                                                (const hotmail)
-                                                (const yahoo)
-                                                (const netaddress)
-                                                (const netscape)
-                                                (const my-deja)))
+                                         (const :format "" :value :subtype)
+                                         ;; Should be generated from
+                                         ;; `webmail-type-definition', but we
+                                         ;; can't require webmail without W3.
+                                         (choice :tag "Subtype"
+                                                 :value hotmail
+                                                 (const hotmail)
+                                                 (const yahoo)
+                                                 (const netaddress)
+                                                 (const netscape)
+                                                 (const my-deja)))
                                   (group :inline t
                                          (const :format "" :value :user)
                                          (string :tag "User"))
@@ -304,7 +304,9 @@ Common keywords should be listed here.")
        (:program)
        (:function)
        (:password)
-       (:authentication password))
+       (:connection)
+       (:authentication password)
+       (:leave))
       (maildir
        (:path (or (getenv "MAILDIR") "~/Maildir/"))
        (:subdirs ("new" "cur"))
@@ -590,7 +592,7 @@ If ARGS, PROMPT is used as an argument to `format'."
 
 (defun mail-source-fetch-with-program (program)
   (zerop (call-process shell-file-name nil nil nil
-                      shell-command-switch program)))
+                      shell-command-switch program)))
 
 (defun mail-source-run-script (script spec &optional delay)
   (when script
@@ -676,7 +678,12 @@ 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)
+                   (pop3-leave-mail-on-server
+                    (or leave
+                        (and (boundp 'pop3-leave-mail-on-server)
+                             pop3-leave-mail-on-server))))
                (if (or debug-on-quit debug-on-error)
                    (save-excursion (pop3-movemail mail-source-crash-box))
                  (condition-case err
@@ -848,19 +855,23 @@ This only works when `display-time' is enabled."
                       (not (if function
                                (funcall function file mail-source-crash-box)
                              (let ((coding-system-for-write
-                                    mm-text-coding-system)
+                                    nnheader-text-coding-system)
                                    (coding-system-for-read
-                                    mm-text-coding-system))
+                                    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)
                                  (goto-char (point-min))
-;;;                               ;; Unix mail format
-;;;                              (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))
+;;;                              ;; Unix mail format
+;;;                              (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")
                                  ;; MMDF mail format
                                  (insert "\001\001\001\001\n"))
@@ -880,8 +891,7 @@ This only works when `display-time' is enabled."
   (autoload 'imap-error-text "imap")
   (autoload 'imap-message-flags-add "imap")
   (autoload 'imap-list-to-message-set "imap")
-  (autoload 'imap-range-to-message-set "imap")
-  (autoload 'nnheader-ms-strip-cr "nnheader"))
+  (autoload 'imap-range-to-message-set "imap"))
 
 (defvar mail-source-imap-file-coding-system 'binary
   "Coding system for the crashbox made by `mail-source-fetch-imap'.")
@@ -891,7 +901,8 @@ This only works when `display-time' is enabled."
   (mail-source-bind (imap source)
     (let ((from (format "%s:%s:%s" server user port))
          (found 0)
-         (buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
+         (buf (get-buffer-create
+               (format " *imap source %s:%s:%s *" server user mailbox)))
          (mail-source-string (format "imap:%s:%s" server mailbox))
          (imap-shell-program (or (list program) imap-shell-program))
          remove)
@@ -901,11 +912,12 @@ This only works when `display-time' is enabled."
                         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
              ;; multibyte.
-             (mm-disable-multibyte)
+             (set-buffer-multibyte nil)
              ;; remember password
              (with-current-buffer buf
                (when (or imap-password