Importing Oort Gnus v0.06.

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

diff --git a/lisp/nntp.el b/lisp/nntp.el
index 3e57e1e..92560b6 100644 (file)
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -389,42 +389,52 @@ noticing asynchronous data.")
       (set-buffer nntp-server-buffer)
       (erase-buffer)))
   (let* ((command (mapconcat 'identity strings " "))
-        (buffer (process-buffer (nntp-find-connection nntp-server-buffer)))
-        (pos (with-current-buffer buffer (point))))
-    (prog1
-       (nntp-retrieve-data command
-                           nntp-address nntp-port-number nntp-server-buffer
-                           wait-for nnheader-callback-function)
-      ;; If nothing to wait for, still remove possibly echo'ed commands
-      (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))))
-         )))
-    ))
+        (process (nntp-find-connection nntp-server-buffer))
+        (buffer (and process (process-buffer process)))
+        (pos (and buffer (with-current-buffer buffer (point)))))
+    (if process
+       (prog1
+           (nntp-retrieve-data command
+                               nntp-address nntp-port-number
+                               nntp-server-buffer
+                               wait-for nnheader-callback-function)
+         ;; If nothing to wait for, still remove possibly echo'ed commands
+         (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))))
+             )))
+      (nnheader-report 'nntp "Couldn't open connection to %s."
+                      nntp-address))))
 
 (defun nntp-send-command-nodelete (wait-for &rest strings)
   "Send STRINGS to server and wait until WAIT-FOR returns."
   (let* ((command (mapconcat 'identity strings " "))
-        (buffer (process-buffer (nntp-find-connection nntp-server-buffer)))
-        (pos (with-current-buffer buffer (point))))
-    (prog1
-       (nntp-retrieve-data command
-                           nntp-address nntp-port-number nntp-server-buffer
-                           wait-for nnheader-callback-function)
-      ;; If nothing to wait for, still remove possibly echo'ed commands
-      (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))))
-         )))
-    ))
+        (process (nntp-find-connection nntp-server-buffer))
+        (buffer (and process (process-buffer process)))
+        (pos (and buffer (with-current-buffer buffer (point)))))
+    (if process
+       (prog1
+           (nntp-retrieve-data command
+                               nntp-address nntp-port-number
+                               nntp-server-buffer
+                               wait-for nnheader-callback-function)
+         ;; If nothing to wait for, still remove possibly echo'ed commands
+         (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))))
+             )))
+      (nnheader-report 'nntp "Couldn't open connection to %s."
+                      nntp-address))))
 
 (defun nntp-send-command-and-decode (wait-for &rest strings)
   "Send STRINGS to server and wait until WAIT-FOR returns."
@@ -434,22 +444,26 @@ noticing asynchronous data.")
       (set-buffer nntp-server-buffer)
       (erase-buffer)))
   (let* ((command (mapconcat 'identity strings " "))
-        (buffer (process-buffer (nntp-find-connection nntp-server-buffer)))
-        (pos (with-current-buffer buffer (point))))
-    (prog1
-       (nntp-retrieve-data command
-                           nntp-address nntp-port-number nntp-server-buffer
-                           wait-for nnheader-callback-function t)
-      ;; If nothing to wait for, still remove possibly echo'ed commands
-      (unless wait-for
-       (nntp-accept-response)
-       (save-excursion
+        (process (nntp-find-connection nntp-server-buffer))
+        (buffer (and process (process-buffer process)))
+        (pos (and buffer (with-current-buffer buffer (point)))))
+    (if process
+       (prog1
+           (nntp-retrieve-data command
+                               nntp-address nntp-port-number
+                               nntp-server-buffer
+                               wait-for nnheader-callback-function t)
+         ;; If nothing to wait for, still remove possibly echo'ed commands
+         (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))))
          )))
-    ))
+      (nnheader-report 'nntp "Couldn't open connection to %s."
+                      nntp-address))))
 
 
 (defun nntp-send-buffer (wait-for)
@@ -577,6 +591,10 @@ noticing asynchronous data.")
              (command (if nntp-server-list-active-group
                           "LIST ACTIVE" "GROUP")))
          (while groups
+           ;; Timeout may have killed the buffer.
+           (unless (gnus-buffer-live-p buf)
+             (nnheader-report 'nntp "Connection to %s is closed." server)
+             (throw 'done nil))
            ;; Send the command to the server.
            (nntp-send-command nil command (pop groups))
            (incf count)
@@ -1394,7 +1412,7 @@ password contained in '~/.nntp-authinfo'."
                   ;; If there is only one group in the Newsgroups
                   ;; header, then it seems quite likely that this
                   ;; article comes from that group, I'd say.
-                  ((and (setq newsgroups 
+                  ((and (setq newsgroups
                               (mail-fetch-field "newsgroups"))
                         (not (string-match "," newsgroups)))
                    newsgroups)
@@ -1408,20 +1426,20 @@ password contained in '~/.nntp-authinfo'."
                   ;; life.
                   ((and (setq xref (mail-fetch-field "xref"))
                         number
-                        (string-match 
+                        (string-match
                          (format "\\([^ :]+\\):%d" number) xref))
                    (match-string 1 xref))
                   (t "")))
          (cond
           ((and (setq xref (mail-fetch-field "xref"))
-                (string-match 
+                (string-match
                  (if group
                      (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")
                    "\\([^ :]+\\):\\([0-9]+\\)")
                  xref))
            (setq group (match-string 1 xref)
                  number (string-to-int (match-string 2 xref))))
-          ((and (setq newsgroups 
+          ((and (setq newsgroups
                       (mail-fetch-field "newsgroups"))
                 (not (string-match "," newsgroups)))
            (setq group newsgroups))