+;; Borrowed from nnheader-accept-process-output in nnheader.el. See the
+;; comments there for explanations about the values.
+
+(eval-and-compile
+ (if (and (fboundp 'nnheader-accept-process-output)
+ (boundp 'nnheader-read-timeout))
+ (defalias 'pop3-accept-process-output 'nnheader-accept-process-output)
+ ;; Borrowed from `nnheader.el':
+ (defvar pop3-read-timeout
+ (if (string-match "windows-nt\\|os/2\\|cygwin"
+ (symbol-name system-type))
+ 1.0
+ 0.01)
+ "How long pop3 should wait between checking for the end of output.
+Shorter values mean quicker response, but are more CPU intensive.")
+ (defun pop3-accept-process-output (process)
+ (accept-process-output
+ process
+ (truncate pop3-read-timeout)
+ (truncate (* (- pop3-read-timeout
+ (truncate pop3-read-timeout))
+ 1000))))))
+
+(defvar pop3-uidl)
+;; List of UIDLs of existing messages at present in the server:
+;; ("UIDL1" "UIDL2" "UIDL3"...)
+
+(defvar pop3-uidl-saved)
+;; Locally saved UIDL data; an alist of the server, the user, and the UIDL
+;; and timestamp pairs:
+;; (("SERVER_A" ("USER_A1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ("USER_A2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ...)
+;; ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;; ...))
+;; Where TIMESTAMP is the most significant two digits of an Emacs time,
+;; i.e. the return value of `current-time'.
+
+;;;###autoload
+(defun pop3-movemail (file)
+ "Transfer contents of a maildrop to the specified FILE.
+Use streaming commands."
+ (let ((process (pop3-open-server pop3-mailhost pop3-port))
+ messages total-size
+ pop3-uidl
+ pop3-uidl-saved)
+ (pop3-logon process)
+ (if pop3-leave-mail-on-server
+ (setq messages (pop3-uidl-stat process)
+ total-size (cadr messages)
+ messages (car messages))
+ (let ((size (pop3-stat process)))
+ (dotimes (i (car size)) (push (1+ i) messages))
+ (setq messages (nreverse messages)
+ total-size (cadr size))))
+ (when messages
+ (with-current-buffer (process-buffer process)
+ (pop3-send-streaming-command process "RETR" messages total-size)
+ (pop3-write-to-file file messages)
+ (unless pop3-leave-mail-on-server
+ (pop3-send-streaming-command process "DELE" messages nil))))
+ (if pop3-leave-mail-on-server
+ (when (prog1 (pop3-uidl-dele process) (pop3-quit process))
+ (pop3-uidl-save))
+ (pop3-quit process)
+ ;; Remove UIDL data for the account that got not to leave mails.
+ (setq pop3-uidl-saved (pop3-uidl-load))
+ (let ((elt (assoc pop3-maildrop
+ (cdr (assoc pop3-mailhost pop3-uidl-saved)))))
+ (when elt
+ (setcdr elt nil)
+ (pop3-uidl-save))))
+ t))
+
+(defun pop3-send-streaming-command (process command messages total-size)
+ (erase-buffer)
+ (let ((count (length messages))
+ (i 1)
+ (start-point (point-min))
+ (waited-for 0))
+ (while messages
+ (process-send-string process (format "%s %d\r\n" command (pop messages)))
+ ;; Only do 100 messages at a time to avoid pipe stalls.
+ (when (zerop (% i pop3-stream-length))
+ (setq start-point
+ (pop3-wait-for-messages process pop3-stream-length
+ total-size start-point))
+ (incf waited-for pop3-stream-length))
+ (incf i))
+ (pop3-wait-for-messages process (- count waited-for)
+ total-size start-point)))
+
+(defun pop3-wait-for-messages (process count total-size start-point)
+ (while (> count 0)
+ (goto-char start-point)
+ (while (or (and (re-search-forward "^\\+OK" nil t)
+ (or (not total-size)
+ (re-search-forward "^\\.\r?\n" nil t)))
+ (re-search-forward "^-ERR " nil t))
+ (decf count)
+ (setq start-point (point)))
+ (unless (memq (process-status process) '(open run))
+ (error "pop3 process died"))
+ (when total-size
+ (let ((size 0))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\+OK.*\n" nil t)
+ (setq size (+ size (- (point))
+ (if (re-search-forward "^\\.\r?\n" nil 'move)
+ (match-beginning 0)
+ (point)))))
+ (message "pop3 retrieved %dKB (%d%%)"
+ (truncate (/ size 1000))
+ (truncate (* (/ (* size 1.0) total-size) 100)))))
+ (pop3-accept-process-output process))
+ start-point)
+
+(defun pop3-write-to-file (file messages)
+ (let ((pop-buffer (current-buffer))
+ (start (point-min))
+ beg end
+ temp-buffer)
+ (with-temp-buffer
+ (setq temp-buffer (current-buffer))
+ (with-current-buffer pop-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^\\+OK" nil t)
+ (forward-line 1)
+ (setq beg (point))
+ (when (re-search-forward "^\\.\r?\n" nil t)
+ (setq start (point))
+ (forward-line -1)
+ (setq end (point)))
+ (with-current-buffer temp-buffer
+ (goto-char (point-max))
+ (let ((hstart (point)))
+ (insert-buffer-substring pop-buffer beg end)
+ (pop3-clean-region hstart (point))
+ (goto-char (point-max))
+ (pop3-munge-message-separator hstart (point))
+ (when pop3-leave-mail-on-server
+ (pop3-uidl-add-xheader hstart (pop messages)))
+ (goto-char (point-max))))))
+ (let ((coding-system-for-write 'binary))
+ (goto-char (point-min))
+ ;; Check whether something inserted a newline at the start and
+ ;; delete it.
+ (when (eolp)
+ (delete-char 1))
+ (write-region (point-min) (point-max) file nil 'nomesg)))))
+
+(defun pop3-logon (process)
+ (let ((pop3-password pop3-password))
+ ;; for debugging only
+ (if pop3-debug (switch-to-buffer (process-buffer process)))
+ ;; query for password
+ (if (and pop3-password-required (not pop3-password))
+ (setq pop3-password
+ (read-passwd (format "Password for %s: " pop3-maildrop))))
+ (cond ((equal 'apop pop3-authentication-scheme)
+ (pop3-apop process pop3-maildrop))
+ ((equal 'pass pop3-authentication-scheme)
+ (pop3-user process pop3-maildrop)
+ (pop3-pass process))
+ (t (error "Invalid POP3 authentication scheme")))))
+
+(defun pop3-get-message-count ()
+ "Return the number of messages in the maildrop."