Synch with Oort Gnus.

[elisp/gnus.git-] / lisp / pop3.el

diff --git a/lisp/pop3.el b/lisp/pop3.el
index 0d898db..933f133 100644 (file)
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -1,6 +1,6 @@
 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
@@ -162,6 +162,28 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.")
     (kill-buffer crashbuf)
     message-count))
 
+(defun pop3-get-message-count ()
+  "Return the number of messages in the maildrop."
+  (let* ((process (pop3-open-server pop3-mailhost pop3-port))
+        message-count
+        (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
+             (pop3-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")))
+    (setq message-count (car (pop3-stat process)))
+    (pop3-quit process)
+    message-count))
+
 (defun pop3-open-server (mailhost port)
   "Open TCP connection to MAILHOST on PORT.
 Returns the process associated with the connection.
@@ -195,16 +217,16 @@ Argument PORT specifies connecting port."
         (ssl-program-arguments
          `(,@pop3-ssl-program-arguments ,extra-arg
            "-connect" ,(format "%s:%d" host service)))
-         (process (open-ssl-stream name buffer host service)))
+        (process (open-ssl-stream name buffer host service)))
     (when process
       (with-current-buffer buffer
        (goto-char (point-min))
        (while (and (memq (process-status process) '(open run))
-                    (goto-char (point-max))
-                    (forward-line -1)
-                    (not (looking-at "+OK")))
-          (accept-process-output process 1)
-          (sit-for 1))
+                   (goto-char (point-max))
+                   (forward-line -1)
+                   (not (looking-at "+OK")))
+         (accept-process-output process 1)
+         (sit-for 1))
        (delete-region (point-min) (point)))
       (and process (memq (process-status process) '(open run))
           process))))
@@ -470,7 +492,7 @@ If NOW, use that time instead."
   (pop3-send-command process (format "USER %s" user))
   (let ((response (pop3-read-response process t)))
     (if (not (and response (string-match "+OK" response)))
-       (error (format "USER %s not valid." user)))))
+       (error (format "USER %s not valid" user)))))
 
 (defun pop3-pass (process)
   "Send authentication information to the server."
@@ -598,7 +620,7 @@ where
   (if msgno
       (pop3-send-command process (format "UIDL %d" msgno))
     (pop3-send-command process "UIDL"))
-  
+
   (if (null (pop3-read-response process t))
       nil ;; UIDL is not supported on this server
     (let (pairs uidl)