Remove arch-tags from all files, since these are no longer needed.

[bpt/emacs.git] / lisp / gnus / pop3.el

diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 8206c4d..34bf71d 100644 (file)
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -1,7 +1,7 @@
 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,

-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.

 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
 ;; Maintainer: FSF
 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
 ;; Maintainer: FSF


@@ -98,6 +98,12 @@ thing can fall apart and leave you with a corrupt mailbox."
   :type 'boolean
   :group 'pop3)
 
   :type 'boolean
   :group 'pop3)
 

+(defcustom pop3-display-message-size-flag t
+  "*If non-nil, display the size of the message that is being fetched."
+  :version "22.1" ;; Oort Gnus
+  :type 'boolean
+  :group 'pop3) 
+

 (defvar pop3-timestamp nil
   "Timestamp returned when initially connected to the POP server.
 Used for APOP authentication.")
 (defvar pop3-timestamp nil
   "Timestamp returned when initially connected to the POP server.
 Used for APOP authentication.")


@@ -105,31 +111,28 @@ Used for APOP authentication.")
 (defvar pop3-read-point nil)
 (defvar pop3-debug nil)
 
 (defvar pop3-read-point nil)
 (defvar pop3-debug nil)
 

-;; Borrowed from nnheader-accept-process-output in nnheader.el.
-(defvar pop3-read-timeout
-  (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
-                   (symbol-name system-type))
-      ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
-      ;;
-      ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS.
-      ;;
-      ;; There should probably be a runtime test to determine the timing
-      ;; resolution, or a primitive to report it.  I don't know off-hand
-      ;; what's possible.  Perhaps better, maybe the Windows/DOS primitive
-      ;; could round up non-zero timeouts to a minimum of 1.0?
-      1.0
-    0.1)
-  "How long pop3 should wait between checking for the end of output.
+;; 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.")
 Shorter values mean quicker response, but are more CPU intensive.")

-
-;; Borrowed from nnheader-accept-process-output in nnheader.el.
-(defun pop3-accept-process-output (process)
-  (accept-process-output
-   process
-   (truncate pop3-read-timeout)
-   (truncate (* (- pop3-read-timeout
-                  (truncate pop3-read-timeout))
-               1000))))
+    (defun pop3-accept-process-output (process)
+      (accept-process-output
+       process
+       (truncate pop3-read-timeout)
+       (truncate (* (- pop3-read-timeout
+                      (truncate pop3-read-timeout))
+                   1000))))))

 
 (defun pop3-movemail (&optional crashbox)
   "Transfer contents of a maildrop to the specified CRASHBOX."
 
 (defun pop3-movemail (&optional crashbox)
   "Transfer contents of a maildrop to the specified CRASHBOX."


@@ -138,6 +141,7 @@ Shorter values mean quicker response, but are more CPU intensive.")
         (crashbuf (get-buffer-create " *pop3-retr*"))
         (n 1)
         message-count
         (crashbuf (get-buffer-create " *pop3-retr*"))
         (n 1)
         message-count

+        message-sizes

         (pop3-password pop3-password))
     ;; for debugging only
     (if pop3-debug (switch-to-buffer (process-buffer process)))
         (pop3-password pop3-password))
     ;; for debugging only
     (if pop3-debug (switch-to-buffer (process-buffer process)))


@@ -152,10 +156,18 @@ Shorter values mean quicker response, but are more CPU intensive.")
           (pop3-pass process))
          (t (error "Invalid POP3 authentication scheme")))
     (setq message-count (car (pop3-stat process)))
           (pop3-pass process))
          (t (error "Invalid POP3 authentication scheme")))
     (setq message-count (car (pop3-stat process)))

+    (when (and pop3-display-message-size-flag
+              (> message-count 0))
+      (setq message-sizes (pop3-list process)))

     (unwind-protect
        (while (<= n message-count)
     (unwind-protect
        (while (<= n message-count)

-         (message "Retrieving message %d of %d from %s..."
-                  n message-count pop3-mailhost)
+         (if pop3-display-message-size-flag
+             (message "Retrieving message %d of %d from %s... (%.1fk)"
+                      n message-count pop3-mailhost
+                      (/ (cdr (assoc n message-sizes))
+                         1024.0))
+           (message "Retrieving message %d of %d from %s..."
+                    n message-count pop3-mailhost))      

          (pop3-retr process n crashbuf)
          (save-excursion
            (set-buffer crashbuf)
          (pop3-retr process n crashbuf)
          (save-excursion
            (set-buffer crashbuf)


@@ -169,7 +181,7 @@ Shorter values mean quicker response, but are more CPU intensive.")
           (unless pop3-leave-mail-on-server
             (pop3-dele process n))
          (setq n (+ 1 n))
           (unless pop3-leave-mail-on-server
             (pop3-dele process n))
          (setq n (+ 1 n))

-         (if pop3-debug (sit-for 1) (sit-for 0.1))) ; why?
+         (pop3-accept-process-output process))

       (when (and pop3-leave-mail-on-server
                 (> n 1))
        (message "pop3.el doesn't support UIDL.  Setting `pop3-leave-mail-on-server'
       (when (and pop3-leave-mail-on-server
                 (> n 1))
        (message "pop3.el doesn't support UIDL.  Setting `pop3-leave-mail-on-server'


@@ -454,8 +466,28 @@ If NOW, use that time instead."
     ))
 
 (defun pop3-list (process &optional msg)
     ))
 
 (defun pop3-list (process &optional msg)

-  "Scan listing of available messages.
-This function currently does nothing.")
+  "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs.
+Otherwise, return the size of the message-id MSG"
+  (pop3-send-command process (if msg 
+                                (format "LIST %d" msg)
+                              "LIST"))
+  (let ((response (pop3-read-response process t)))
+    (if msg
+       (string-to-number (nth 2 (split-string response " ")))
+      (let ((start pop3-read-point) end)
+       (save-excursion
+         (set-buffer (process-buffer process))
+         (while (not (re-search-forward "^\\.\r\n" nil t))
+           (pop3-accept-process-output process)
+           (goto-char start))
+         (setq pop3-read-point (point-marker))
+         (goto-char (match-beginning 0))
+         (setq end (point-marker))
+         (mapcar #'(lambda (s) (let ((split (split-string s " ")))
+                                 (cons (string-to-number (nth 0 split))
+                                       (string-to-number (nth 1 split)))))
+                 (delete "" (split-string (buffer-substring start end)
+                                          "\r\n"))))))))

 
 (defun pop3-retr (process msg crashbuf)
   "Retrieve message-id MSG to buffer CRASHBUF."
 
 (defun pop3-retr (process msg crashbuf)
   "Retrieve message-id MSG to buffer CRASHBUF."


@@ -611,5 +643,4 @@ and close the connection."
 
 (provide 'pop3)
 
 
 (provide 'pop3)
 

-;; arch-tag: 2facc142-1d74-498e-82af-4659b64cac12

 ;;; pop3.el ends here
 ;;; pop3.el ends here