This commit was generated by cvs2svn to compensate for changes in r8000,

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

diff --git a/lisp/pop3.el b/lisp/pop3.el
index c19a77f..a07b805 100644 (file)
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -1,10 +1,10 @@
 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
 
-;; Copyright (C) 1996-1999 Free Software Foundation, Inc.
+;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc.
 
 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
 ;; Keywords: mail, pop3
-;; Version: 1.3s
+;; Version: 1.3m+
 
 ;; This file is part of GNU Emacs.
 
@@ -37,7 +37,7 @@
 (require 'mail-utils)
 (provide 'pop3)
 
-(defconst pop3-version "1.3s")
+(defconst pop3-version "1.3m+")
 
 (defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)
   "*POP3 maildrop.")
@@ -85,50 +85,45 @@ Used for APOP authentication.")
           (pop3-pass process))
          (t (error "Invalid POP3 authentication scheme.")))
     (setq message-count (car (pop3-stat process)))
-    (unwind-protect
-       (while (<= n message-count)
-         (message (format "Retrieving message %d of %d from %s..."
-                          n message-count pop3-mailhost))
-         (pop3-retr process n crashbuf)
-         (save-excursion
-           (set-buffer crashbuf)
-           (write-region (point-min) (point-max) crashbox t 'nomesg)
-           (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))
-         (if pop3-debug (sit-for 1) (sit-for 0.1))
-         )
-      (pop3-quit process))
+    (while (<= n message-count)
+      (message (format "Retrieving message %d of %d from %s..."
+                      n message-count pop3-mailhost))
+      (pop3-retr process n crashbuf)
+      (save-excursion
+       (set-buffer crashbuf)
+       (write-region-as-binary (point-min) (point-max) crashbox 'append)
+       (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))
+      (if pop3-debug (sit-for 1) (sit-for 0.1))
+      )
+    (pop3-quit process)
     (kill-buffer crashbuf)
     )
-  t)
+  )
 
 (defun pop3-open-server (mailhost port)
   "Open TCP connection to MAILHOST.
 Returns the process associated with the connection."
   (let ((process-buffer
         (get-buffer-create (format "trace of POP session to %s" mailhost)))
-       (process)
-       (coding-system-for-read 'binary)   ;; because FSF Emacs 20 and
-       (coding-system-for-write 'binary)  ;; XEmacs 20 & 21 are st00pid
-    )
+       (process))
     (save-excursion
       (set-buffer process-buffer)
       (erase-buffer)
       (setq pop3-read-point (point-min))
       )
     (setq process
-         (open-network-stream "POP" process-buffer mailhost port))
+         (open-network-stream-as-binary "POP" process-buffer mailhost port))
     (let ((response (pop3-read-response process t)))
       (setq pop3-timestamp
            (substring response (or (string-match "<" response) 0)
                       (+ 1 (or (string-match ">" response) -1)))))
-    process
-    ))
+    process))
 
 ;; Support functions
 
@@ -146,7 +141,8 @@ Returns the process associated with the connection."
 ;;      (insert command "\r\n"))
     (setq pop3-read-point (point))
     (goto-char (point-max))
-    (process-send-string process (concat command "\r\n"))
+    (process-send-string process command)
+    (process-send-string process "\r\n")
     )
 
 (defun pop3-read-response (process &optional return)
@@ -163,7 +159,7 @@ Return the response string if optional second argument is non-nil."
       (setq match-end (point))
       (goto-char pop3-read-point)
       (if (looking-at "-ERR")
-         (signal 'error (list (buffer-substring (point) (- match-end 2))))
+         (error (buffer-substring (point) (- match-end 2)))
        (if (not (looking-at "+OK"))
            (progn (setq pop3-read-point match-end) nil)
          (setq pop3-read-point match-end)
@@ -191,10 +187,12 @@ Return the response string if optional second argument is non-nil."
 (defvar pop3-read-passwd nil)
 (defun pop3-read-passwd (prompt)
   (if (not pop3-read-passwd)
-      (if (load "passwd" t)
+      (if (functionp 'read-passwd)
          (setq pop3-read-passwd 'read-passwd)
-       (autoload 'ange-ftp-read-passwd "ange-ftp")
-       (setq pop3-read-passwd 'ange-ftp-read-passwd)))
+       (if (load "passwd" t)
+           (setq pop3-read-passwd 'read-passwd)
+         (autoload 'ange-ftp-read-passwd "ange-ftp")
+         (setq pop3-read-passwd 'ange-ftp-read-passwd))))
   (funcall pop3-read-passwd prompt))
 
 (defun pop3-clean-region (start end)
@@ -246,15 +244,7 @@ Return the response string if optional second argument is non-nil."
              (setq From_ (concat (substring From_ 0 (match-beginning 0))
                                  (substring From_ (match-end 0)))))
            (goto-char (point-min))
-           (insert From_)
-           (re-search-forward "\n\n")
-           (narrow-to-region (point) (point-max))
-           (let ((size (- (point-max) (point-min))))
-             (goto-char (point-min))
-             (widen)
-             (forward-line -1)
-             (insert (format "Content-Length: %s\n" size)))
-           )))))
+           (insert From_))))))
 
 ;; The Command Set