Synch to No Gnus 200402270146.

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

diff --git a/lisp/nntp.el b/lisp/nntp.el
index 62a6b16..e29bcd7 100644 (file)
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -28,7 +28,6 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
 
 (require 'nnheader)
 (require 'nnoo)
@@ -175,8 +174,8 @@ If non-nil, there will be no prompt for a login name.")
 This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
 
 (defvoo nntp-large-newsgroup 50
-  "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
+  "*The number of articles which indicates a large newsgroup.
+If the number of articles is greater than the value, verbose
 messages will be shown to indicate the current status.")
 
 (defvoo nntp-maximum-request 400
@@ -387,6 +386,11 @@ be restored and the command retried."
     (kill-buffer buffer)
     (nnheader-init-server-buffer)))
 
+(defun nntp-erase-buffer (buffer)
+  "Erase contents of BUFFER."
+  (with-current-buffer buffer
+    (erase-buffer)))
+
 (defsubst nntp-find-connection (buffer)
   "Find the connection delivering to BUFFER."
   (let ((alist nntp-connection-alist)
@@ -421,9 +425,7 @@ be restored and the command retried."
     (if process
         (progn
           (unless (or nntp-inhibit-erase nnheader-callback-function)
-            (save-excursion
-              (set-buffer (process-buffer process))
-              (erase-buffer)))
+           (nntp-erase-buffer (process-buffer process)))
           (condition-case err
               (progn
                 (when command
@@ -450,9 +452,7 @@ be restored and the command retried."
   "Send STRINGS to server and wait until WAIT-FOR returns."
   (when (and (not nnheader-callback-function)
             (not nntp-inhibit-output))
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (erase-buffer)))
+    (nntp-erase-buffer nntp-server-buffer))
   (let* ((command (mapconcat 'identity strings " "))
         (process (nntp-find-connection nntp-server-buffer))
         (buffer (and process (process-buffer process)))
@@ -475,8 +475,7 @@ be restored and the command retried."
              (goto-char pos)
              (if (looking-at (regexp-quote command))
                  (delete-region pos (progn (forward-line 1)
-                                           (gnus-point-at-bol))))
-             )))
+                                           (point-at-bol)))))))
       (nnheader-report 'nntp "Couldn't open connection to %s."
                       nntp-address))))
 
@@ -500,7 +499,7 @@ be restored and the command retried."
              (goto-char pos)
              (if (looking-at (regexp-quote command))
                  (delete-region pos (progn (forward-line 1)
-                                           (gnus-point-at-bol))))
+                                           (point-at-bol))))
              )))
       (nnheader-report 'nntp "Couldn't open connection to %s."
                       nntp-address))))
@@ -509,9 +508,7 @@ be restored and the command retried."
   "Send STRINGS to server and wait until WAIT-FOR returns."
   (when (and (not nnheader-callback-function)
             (not nntp-inhibit-output))
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (erase-buffer)))
+    (nntp-erase-buffer nntp-server-buffer))
   (let* ((command (mapconcat 'identity strings " "))
         (process (nntp-find-connection nntp-server-buffer))
         (buffer (and process (process-buffer process)))
@@ -526,11 +523,11 @@ be restored and the command retried."
          (unless wait-for
            (nntp-accept-response)
            (save-excursion
-         (set-buffer buffer)
-         (goto-char pos)
-         (if (looking-at (regexp-quote command))
-             (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
-         )))
+             (set-buffer buffer)
+             (goto-char pos)
+             (if (looking-at (regexp-quote command))
+                 (delete-region pos (progn (forward-line 1) (point-at-bol))))
+             )))
       (nnheader-report 'nntp "Couldn't open connection to %s."
                       nntp-address))))
 
@@ -538,15 +535,14 @@ be restored and the command retried."
   "Send the current buffer to server and wait until WAIT-FOR returns."
   (when (and (not nnheader-callback-function)
             (not nntp-inhibit-output))
-    (save-excursion
-      (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
-      (erase-buffer)))
+    (nntp-erase-buffer
+     (nntp-find-connection-buffer nntp-server-buffer)))
   (nntp-encode-text)
   (let ((multibyte (and (boundp 'enable-multibyte-characters)
                        (symbol-value 'enable-multibyte-characters))))
     (unwind-protect
        ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
-       (let (default-enable-multibyte-characters mc-flag)
+       (let (default-enable-multibyte-characters)
          ;; `set-buffer-multibyte' will be provided by APEL for all Emacsen.
          (set-buffer-multibyte nil)
          (process-send-region (nntp-find-connection nntp-server-buffer)
@@ -608,7 +604,7 @@ command whose response triggered the error."
 
              (let ((timer
                     (and nntp-connection-timeout
-                         (nnheader-run-at-time
+                         (run-at-time
                           nntp-connection-timeout nil
                           '(lambda ()
                              (let ((process (nntp-find-connection
@@ -710,8 +706,7 @@ command whose response triggered the error."
      (catch 'done
        (save-excursion
          ;; Erase nntp-server-buffer before nntp-inhibit-erase.
-         (set-buffer nntp-server-buffer)
-         (erase-buffer)
+        (nntp-erase-buffer nntp-server-buffer)
          (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
          ;; The first time this is run, this variable is `try'.  So we
          ;; try.
@@ -1131,7 +1126,7 @@ password contained in '~/.nntp-authinfo'."
       (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
       (nntp-send-command
        "^2.*\r?\n" "AUTHINFO PASS"
-       (buffer-substring (point) (gnus-point-at-eol))))))
+       (buffer-substring (point) (point-at-eol))))))
 
 ;;; Internal functions.
 
@@ -1141,9 +1136,7 @@ password contained in '~/.nntp-authinfo'."
     (funcall nntp-authinfo-function)
     ;; We have to re-send the function that was interrupted by
     ;; the authinfo request.
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (erase-buffer))
+    (nntp-erase-buffer nntp-server-buffer)
     (nntp-send-string process last)))
 
 (defun nntp-make-process-buffer (buffer)
@@ -1168,7 +1161,7 @@ password contained in '~/.nntp-authinfo'."
   (let* ((pbuffer (nntp-make-process-buffer buffer))
         (timer
          (and nntp-connection-timeout
-              (nnheader-run-at-time
+              (run-at-time
                nntp-connection-timeout nil
                `(lambda ()
                   (nntp-kill-buffer ,pbuffer)))))
@@ -1208,6 +1201,10 @@ password contained in '~/.nntp-authinfo'."
   (open-network-stream-as-binary
    "nntpd" buffer nntp-address nntp-port-number))
 
+(autoload 'format-spec "format")
+(autoload 'format-spec-make "format")
+(autoload 'open-tls-stream "tls")
+
 (defun nntp-open-ssl-stream (buffer)
   (let* ((process-connection-type nil)
         (proc (as-binary-process
@@ -1273,7 +1270,7 @@ password contained in '~/.nntp-authinfo'."
   ;; doesn't trigger after-change-functions.
   (unless nntp-async-timer
     (setq nntp-async-timer
-         (nnheader-run-at-time 1 1 'nntp-async-timer-handler)))
+         (run-at-time 1 1 'nntp-async-timer-handler)))
   (add-to-list 'nntp-async-process-list process))
 
 (defun nntp-async-timer-handler ()
@@ -1401,9 +1398,7 @@ password contained in '~/.nntp-authinfo'."
                (nntp-send-command "^[245].*\n" "GROUP" group)
                (setcar (cddr entry) group)
                (erase-buffer)
-               (save-excursion
-                 (set-buffer nntp-server-buffer)
-                 (erase-buffer))))))))
+              (nntp-erase-buffer nntp-server-buffer)))))))
 
 (defun nntp-decode-text (&optional cr-only)
   "Decode the text in the current buffer."
@@ -1487,8 +1482,7 @@ password contained in '~/.nntp-authinfo'."
          in-process-buffer-p
          (buf nntp-server-buffer)
          (process-buffer (nntp-find-connection-buffer nntp-server-buffer))
-         first
-          last)
+         first last status)
       ;; We have to check `nntp-server-xover'.  If it gets set to nil,
       ;; that means that the server does not understand XOVER, but we
       ;; won't know that until we try.
@@ -1522,15 +1516,22 @@ password contained in '~/.nntp-authinfo'."
            (while (progn
                     (goto-char (or last-point (point-min)))
                     ;; Count replies.
-                    (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)
-                      (incf received))
+                    (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
+                                              nil t)
+                      (incf received)
+                      (setq status (match-string 1))
+                      (if (string-match "^[45]" status)
+                          (setq status 'error)
+                        (setq status 'ok)))
                     (setq last-point (point))
                     (or (< received count)
-                        ;; I haven't started reading the final response
-                         (progn
-                           (goto-char (point-max))
-                           (forward-line -1)
-                           (not (looking-at "^\\.\r?\n")))))
+                        (if (eq status 'error)
+                            nil
+                          ;; I haven't started reading the final response
+                          (progn
+                            (goto-char (point-max))
+                            (forward-line -1)
+                            (not (looking-at "^\\.\r?\n"))))))
              ;; I haven't read the end of the final response
              (nntp-accept-response)
              (set-buffer process-buffer))))
@@ -1606,10 +1607,8 @@ password contained in '~/.nntp-authinfo'."
          (setq commands (cdr commands)))
        ;; If none of the commands worked, we disable XOVER.
        (when (eq nntp-server-xover 'try)
-         (save-excursion
-           (set-buffer nntp-server-buffer)
-           (erase-buffer)
-           (setq nntp-server-xover nil)))
+         (nntp-erase-buffer nntp-server-buffer)
+         (setq nntp-server-xover nil))
         nntp-server-xover))))
 
 (defun nntp-find-group-and-number (&optional group)