*** empty log message ***

[gnus] / lisp / pop3.el

diff --git a/lisp/pop3.el b/lisp/pop3.el
index f7c9867..1380949 100644 (file)
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -4,7 +4,7 @@
 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
 ;; Keywords: mail, pop3
-;; Version: 1.2
+;; Version: 1.3e
 
 ;; This file is part of GNU Emacs.
 
@@ -37,6 +37,8 @@
 (require 'mail-utils)
 (provide 'pop3)
 
+(defconst pop3-version "1.3c")
+
 (defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil)
   "*POP3 maildrop.")
 (defvar pop3-mailhost (or (getenv "MAILHOST") nil)
@@ -50,8 +52,9 @@
   "*Password to use when connecting to POP server.")
 
 (defvar pop3-authentication-scheme 'pass
-  "*POP3 authentication scheme.  Defaults to 'pass, for the standard
-USER/PASS authentication.  Other valid values are 'apop.")
+  "*POP3 authentication scheme.
+Defaults to 'pass, for the standard USER/PASS authentication.  Other valid
+values are 'apop.")
 
 (defvar pop3-timestamp nil
   "Timestamp returned when initially connected to the POP server.
@@ -79,17 +82,22 @@ Used for APOP authentication.")
     (while (<= n message-count)
       (message (format "Retrieving message %d of %d from %s..."
                       n message-count pop3-mailhost))
-      (sit-for 0)
       (pop3-retr process n crashbuf)
       (save-excursion
        (set-buffer crashbuf)
-       (append-to-file (point-min) (point-max) crashbox))
+       (append-to-file (point-min) (point-max) crashbox)
+       (set-buffer (process-buffer process))
+       (while (> (buffer-size) 5000)
+         (goto-char (point-min))
+         (forward-line 50)
+         (delete-region (point-min) (point))))
       (pop3-dele process n)
-      (setq n (+ 1 n)))
+      (setq n (+ 1 n))
+      (if pop3-debug (sit-for 1) (sit-for 0.1))
+      )
     (pop3-quit process)
     (kill-buffer crashbuf)
     )
-  (sit-for 0)
   )
 
 (defun pop3-open-server (mailhost port)
@@ -140,7 +148,7 @@ Return the response string if optional second argument is non-nil."
       (set-buffer (process-buffer process))
       (goto-char pop3-read-point)
       (while (not (search-forward "\r\n" nil t))
-       (accept-process-output process)
+       (accept-process-output process 3)
        (goto-char pop3-read-point))
       (setq match-end (point))
       (goto-char pop3-read-point)
@@ -221,7 +229,7 @@ Return the response string if optional second argument is non-nil."
                                 (nth 1 date) (nth 0 date)
                                 (nth 3 date) (nth 2 date)))
                        ))
-           (setq From_ (format "From %s  %s\n" from date))
+           (setq From_ (format "\nFrom %s  %s\n" from date))
            (while (string-match "," From_)
              (setq From_ (concat (substring From_ 0 (match-beginning 0))
                                  (substring From_ (match-end 0)))))
@@ -271,8 +279,7 @@ Return the response string if optional second argument is non-nil."
 ;; TRANSACTION STATE
 
 (defun pop3-stat (process)
-  "Return a list of the number of messages in the maildrop and the size
-of the maildrop."
+  "Return the number of messages in the maildrop and the maildrop's size."
   (pop3-send-command process "STAT")
   (let ((response (pop3-read-response process t)))
     (list (string-to-int (nth 1 (pop3-string-to-list response)))
@@ -284,17 +291,30 @@ of the maildrop."
 This function currently does nothing.")
 
 (defun pop3-retr (process msg crashbuf)
-  "Retrieve message-id MSG from the server and place the contents in
-buffer CRASHBUF."
+  "Retrieve message-id MSG to buffer CRASHBUF."
   (pop3-send-command process (format "RETR %s" msg))
   (pop3-read-response process)
   (let ((start pop3-read-point) end)
     (save-excursion
       (set-buffer (process-buffer process))
       (while (not (re-search-forward "^\\.\r\n" nil t))
-       (accept-process-output process)
+       (accept-process-output process 3)
+       ;; bill@att.com ... to save wear and tear on the heap
+       (if (> (buffer-size)  20000) (sleep-for 1))
+       (if (> (buffer-size)  50000) (sleep-for 1))
+       (if (> (buffer-size) 100000) (sleep-for 1))
+       (if (> (buffer-size) 200000) (sleep-for 1))
+       (if (> (buffer-size) 500000) (sleep-for 1))
+       ;; bill@att.com
        (goto-char start))
       (setq pop3-read-point (point-marker))
+;; this code does not seem to work for some POP servers...
+;; and I cannot figure out why not.
+;      (goto-char (match-beginning 0))
+;      (backward-char 2)
+;      (if (not (looking-at "\r\n"))
+;        (insert "\r\n"))
+;      (re-search-forward "\\.\r\n")
       (goto-char (match-beginning 0))
       (setq end (point-marker))
       (pop3-clean-region start end)
@@ -331,8 +351,9 @@ buffer CRASHBUF."
 ;; UPDATE
 
 (defun pop3-quit (process)
-  "Tell server to remove all messages marked as deleted, unlock the
-maildrop, and close the connection."
+  "Close connection to POP3 server.
+Tell server to remove all messages marked as deleted, unlock the maildrop,
+and close the connection."
   (pop3-send-command process "QUIT")
   (pop3-read-response process t)
   (if process