Importing Oort Gnus v0.03.

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

diff --git a/lisp/pop3.el b/lisp/pop3.el
index 02630b5..d12f861 100644 (file)
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -1,12 +1,11 @@
 ;;; 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>
 ;; Maintainer: FSF
 ;; Keywords: mail
-;; Version: 1.3s
 
 ;; This file is part of GNU Emacs.
 
@@ -38,8 +37,6 @@
 
 (require 'mail-utils)
 
-(defconst pop3-version "1.3s")
-
 (defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)
   "*POP3 maildrop.")
 (defvar pop3-mailhost (or (getenv "MAILHOST") nil)
@@ -61,9 +58,6 @@ values are 'apop.")
   "Timestamp returned when initially connected to the POP server.
 Used for APOP authentication.")
 
-(defvar pop3-movemail-file-coding-system nil
-  "Coding system for the crashbox made by `pop3-movemail'.")
-
 (defvar pop3-read-point nil)
 (defvar pop3-debug nil)
 
@@ -96,7 +90,7 @@ Used for APOP authentication.")
          (pop3-retr process n crashbuf)
          (save-excursion
            (set-buffer crashbuf)
-           (let ((coding-system-for-write pop3-movemail-file-coding-system))
+           (let ((coding-system-for-write 'binary))
              (write-region (point-min) (point-max) crashbox t 'nomesg))
            (set-buffer (process-buffer process))
            (while (> (buffer-size) 5000)
@@ -112,6 +106,28 @@ Used for APOP authentication.")
     )
   t)
 
+(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,9 +211,31 @@ Return the response string if optional second argument is non-nil."
       (forward-char)))
   (set-marker end nil))
 
+(eval-when-compile (defvar parse-time-months))
+
+;; Copied from message-make-date.
+(defun pop3-make-date (&optional now)
+  "Make a valid date header.
+If NOW, use that time instead."
+  (require 'parse-time)
+  (let* ((now (or now (current-time)))
+        (zone (nth 8 (decode-time now)))
+        (sign "+"))
+    (when (< zone 0)
+      (setq sign "-")
+      (setq zone (- zone)))
+    (concat
+     (format-time-string "%d" now)
+     ;; The month name of the %b spec is locale-specific.  Pfff.
+     (format " %s "
+            (capitalize (car (rassoc (nth 4 (decode-time now))
+                                     parse-time-months))))
+     (format-time-string "%Y %H:%M:%S " now)
+     ;; We do all of this because XEmacs doesn't have the %z spec.
+     (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
+
 (defun pop3-munge-message-separator (start end)
   "Check to see if a message separator exists.  If not, generate one."
-  (if (not (fboundp 'message-make-date)) (autoload 'message-make-date "message"))
   (save-excursion
     (save-restriction
       (narrow-to-region start end)
@@ -208,7 +246,7 @@ Return the response string if optional second argument is non-nil."
                   ))
          (let ((from (mail-strip-quoted-names (mail-fetch-field "From")))
                (date (split-string (or (mail-fetch-field "Date")
-                                       (message-make-date))
+                                       (pop3-make-date))
                                    " "))
                (From_))
            ;; sample date formats I have seen
@@ -234,7 +272,10 @@ Return the response string if optional second argument is non-nil."
                                  (substring From_ (match-end 0)))))
            (goto-char (point-min))
            (insert From_)
-           (re-search-forward "\n\n")
+           (if (search-forward "\n\n" nil t)
+               nil
+             (goto-char (point-max))
+             (insert "\n"))
            (narrow-to-region (point) (point-max))
            (let ((size (- (point-max) (point-min))))
              (goto-char (point-min))
@@ -277,19 +318,21 @@ Return the response string if optional second argument is non-nil."
 
 ;; TRANSACTION STATE
 
-(defvar pop3-md5-program "md5"
-  "*Program to encode its input in MD5.")
-
-(defun pop3-md5 (string)
-  (with-temp-buffer
-    (insert string)
-    (call-process-region (point-min) (point-max)
-                        (or shell-file-name "/bin/sh")
-                        t (current-buffer) nil
-                        "-c" pop3-md5-program)
-    ;; The meaningful output is the first 32 characters.
-    ;; Don't return the newline that follows them!
-    (buffer-substring (point-min) (+ (point-min) 32))))
+(eval-and-compile
+  (if (fboundp 'md5)
+      (defalias 'pop3-md5 'md5)
+    (defvar pop3-md5-program "md5"
+      "*Program to encode its input in MD5.")
+
+    (defun pop3-md5 (string)
+      (with-temp-buffer
+       (insert string)
+       (call-process-region (point-min) (point-max)
+                            pop3-md5-program
+                            t (current-buffer) nil)
+       ;; The meaningful output is the first 32 characters.
+       ;; Don't return the newline that follows them!
+       (buffer-substring 1 33)))))
 
 (defun pop3-stat (process)
   "Return the number of messages in the maildrop and the maildrop's size."