X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnntp.el;h=6038511e21df5a5148d03a084a3e5635e8b3d7b4;hp=0a381fc09177d56085a620fba1f38d607bf2438a;hb=678fba408e193656d533efeecdb1203fce8ed4be;hpb=34e6ef9901f0a79f6f723eb942731e154c0933b4 diff --git a/lisp/nntp.el b/lisp/nntp.el index 0a381fc09..6038511e2 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -79,7 +79,7 @@ telnets to a remote system, logs in and does the same") (defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp") "*Parameters to `nntp-open-login'. -That function may be used as `nntp-open-server-function'. In that +That function may be used as `nntp-open-connection-function'. In that case, this list will be used as the parameter list given to rsh.") (defvoo nntp-rlogin-user-name nil @@ -87,7 +87,7 @@ case, this list will be used as the parameter list given to rsh.") (defvoo nntp-telnet-parameters '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp") "*Parameters to `nntp-open-telnet'. -That function may be used as `nntp-open-server-function'. In that +That function may be used as `nntp-open-connection-function'. In that case, this list will be executed as a command after logging in via telnet.") @@ -159,6 +159,7 @@ server there that you can connect to. See also `nntp-open-connection-function'" (defvoo nntp-status-string "") (defconst nntp-version "nntp 5.0") (defvoo nntp-inhibit-erase nil) +(defvoo nntp-inhibit-output nil) (defvoo nntp-server-xover 'try) (defvoo nntp-server-list-active-group 'try) @@ -239,9 +240,7 @@ server there that you can connect to. See also `nntp-open-connection-function'" ;; Now all of replies are received. Fold continuation lines. (nnheader-fold-continuation-lines) ;; Remove all "\r"'s. - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t)) + (nnheader-strip-cr) (copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'headers)))) @@ -307,12 +306,94 @@ server there that you can connect to. See also `nntp-open-connection-function'" (copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'active)))) +(deffoo nntp-retrieve-articles (articles &optional group server) + (nntp-possibly-change-group group server) + (save-excursion + (let ((number (length articles)) + (count 0) + (received 0) + (last-point (point-min)) + (buf (nntp-find-connection-buffer nntp-server-buffer)) + (nntp-inhibit-erase t) + (map (apply 'vector articles)) + (point 1) + article alist) + (set-buffer buf) + (erase-buffer) + ;; Send HEAD command. + (while (setq article (pop articles)) + (nntp-send-command + nil + "ARTICLE" (if (numberp article) + (int-to-string article) + ;; `articles' is either a list of article numbers + ;; or a list of article IDs. + article)) + (incf count) + ;; Every 400 requests we have to read the stream in + ;; order to avoid deadlocks. + (when (or (null articles) ;All requests have been sent. + (zerop (% count nntp-maximum-request))) + (nntp-accept-response) + (while (progn + (progn + (set-buffer buf) + (goto-char last-point)) + ;; Count replies. + (while (nntp-next-result-arrived-p) + (aset map received (cons (aref map received) (point))) + (incf received)) + (setq last-point (point)) + (< received count)) + ;; If number of headers is greater than 100, give + ;; informative messages. + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (zerop (% received 20)) + (message "NNTP: Receiving articles... %d%%" + (/ (* received 100) number))) + (nntp-accept-response)))) + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (message "NNTP: Receiving headers...done")) + + ;; Now we have all the responses. We go through the results, + ;; washes it and copies it over to the server buffer. + (set-buffer nntp-server-buffer) + (erase-buffer) + (mapcar + (lambda (entry) + (narrow-to-region + (setq point (goto-char (point-max))) + (progn + (insert-buffer-substring buf last-point (cdr entry)) + (point-max))) + (nntp-decode-text) + (widen) + (cons (car entry) point)) + map)))) + +(defun nntp-next-result-arrived-p () + (let ((point (point))) + (cond + ((looking-at "2") + (if (re-search-forward "\n.\r?\n" nil t) + t + (goto-char point) + nil)) + ((looking-at "[34]") + (forward-line 1) + t) + (t + nil)))) + (defun nntp-try-list-active (group) (nntp-list-active-group group) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) - (cond ((looking-at "5[0-9]+") + (cond ((or (eobp) + (looking-at "5[0-9]+")) (setq nntp-server-list-active-group nil)) (t (setq nntp-server-list-active-group t))))) @@ -394,7 +475,8 @@ server there that you can connect to. See also `nntp-open-connection-function'" (while (setq process (pop nntp-connection-list)) (when (memq (process-status process) '(open run)) (set-process-sentinel process nil) - (nntp-send-string process "QUIT")) + (ignore-errors + (nntp-send-string process "QUIT"))) (when (buffer-name (process-buffer process)) (kill-buffer (process-buffer process)))))) @@ -447,7 +529,7 @@ This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." (nntp-send-command "^.*\r?\n" "AUTHINFO USER" - (read-string "NNTP (%s) user name: " nntp-address)) + (read-string (format "NNTP (%s) user name: " nntp-address))) (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" (nnmail-read-passwd "NNTP (%s) password: " nntp-address))) @@ -459,30 +541,27 @@ It will prompt for a password." (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" - (read-string "NNTP (%s) password: " nntp-address))) + (nnmail-read-passwd (format "NNTP (%s) password: " nntp-address)))) (defun nntp-send-authinfo-from-file () "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." (when (file-exists-p "~/.nntp-authinfo") - (save-excursion - (set-buffer (get-buffer-create " *authinfo*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) + (nnheader-temp-write nil (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (progn (end-of-line) (point)))) - (kill-buffer (current-buffer))))) + (buffer-substring (point) (progn (end-of-line) (point))))))) ;;; Internal functions. (defun nntp-send-command (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." - (unless nnheader-callback-function + (when (and (not nnheader-callback-function) + (not nntp-inhibit-output)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer))) @@ -500,7 +579,8 @@ It will prompt for a password." (defun nntp-send-command-and-decode (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." - (unless nnheader-callback-function + (when (and (not nnheader-callback-function) + (not nntp-inhibit-output)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer))) @@ -511,7 +591,8 @@ It will prompt for a password." (defun nntp-send-buffer (wait-for) "Send the current buffer to server and wait until WAIT-FOR returns." - (unless nnheader-callback-function + (when (and (not nnheader-callback-function) + (not nntp-inhibit-output)) (save-excursion (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) (erase-buffer))) @@ -571,24 +652,22 @@ It will prompt for a password." (run-hooks 'nntp-prepare-server-hook) (let* ((pbuffer (nntp-make-process-buffer buffer)) (process - (condition-case () - (funcall - nntp-open-connection-function pbuffer) - (error nil)))) + (ignore-errors + (funcall nntp-open-connection-function pbuffer)))) (when process (process-kill-without-query process) - (nntp-wait-for process "^.*\n" buffer) + (nntp-wait-for process "^.*\n" buffer nil t) (if (memq (process-status process) '(open run)) (prog1 - (caar (push (list process buffer nil) - nntp-connection-alist)) + (caar (push (list process buffer nil) nntp-connection-alist)) (push process nntp-connection-list) (save-excursion - (set-buffer nntp-server-buffer) - (nntp-read-server-type) - (run-hooks 'nntp-server-opened-hook) (set-buffer pbuffer) - (erase-buffer))) + (nntp-read-server-type) + (erase-buffer) + (set-buffer nntp-server-buffer) + (let ((nnheader-callback-function nil)) + (run-hooks 'nntp-server-opened-hook)))) (when (buffer-name (process-buffer process)) (kill-buffer (process-buffer process))) nil)))) @@ -684,7 +763,7 @@ It will prompt for a password." "Send STRING to PROCESS." (process-send-string process (concat string nntp-end-of-line))) -(defun nntp-wait-for (process wait-for buffer &optional decode) +(defun nntp-wait-for (process wait-for buffer &optional decode discard) "Wait for WAIT-FOR to arrive from PROCESS." (save-excursion (set-buffer (process-buffer process)) @@ -706,16 +785,24 @@ It will prompt for a password." (nntp-accept-process-output process) (goto-char (point-max))) (nntp-decode-text (not decode)) - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (insert-buffer-substring (process-buffer process)) - t)) - (erase-buffer)))) + (unless discard + (save-excursion + (set-buffer buffer) + (goto-char (point-max)) + (insert-buffer-substring (process-buffer process)) + ;; Nix out "nntp reading...." message. + (message "") + t))) + (unless discard + (erase-buffer))))) (defun nntp-snarf-error-message () "Save the error message in the current buffer." - (setq nntp-status-string (buffer-string))) + (let ((message (buffer-string))) + (while (string-match "[\r\n]+" message) + (setq message (replace-match " " t t message))) + (nnheader-report 'nntp message) + message)) (defun nntp-accept-process-output (process) "Wait for output from PROCESS and message some dots." @@ -732,24 +819,29 @@ It will prompt for a password." (nntp-accept-process-output (nntp-find-connection nntp-server-buffer))) (defun nntp-possibly-change-group (group server &optional connectionless) - (when server - (or (nntp-server-opened server) - (nntp-open-server server nil connectionless))) + (let ((nnheader-callback-function nil)) + (when server + (or (nntp-server-opened server) + (nntp-open-server server nil connectionless))) - (unless connectionless - (or (nntp-find-connection nntp-server-buffer) - (nntp-open-connection nntp-server-buffer))) + (unless connectionless + (or (nntp-find-connection nntp-server-buffer) + (nntp-open-connection nntp-server-buffer)))) (when group (let ((entry (nntp-find-connection-entry nntp-server-buffer))) (when (not (equal group (caddr entry))) - (nntp-request-group group) - (erase-buffer))))) + (save-excursion + (set-buffer (process-buffer (car entry))) + (erase-buffer) + (nntp-send-string (car entry) (concat "GROUP " group)) + (nntp-wait-for-string "^2.*\n") + (setcar (cddr entry) group) + (erase-buffer)))))) (defun nntp-decode-text (&optional cr-only) "Decode the text in the current buffer." (goto-char (point-min)) - ;; Remove \R's. (while (search-forward "\r" nil t) (delete-char -1)) (unless cr-only @@ -887,7 +979,8 @@ It will prompt for a password." ;; If `nntp-server-xover' is a string, then we just send this ;; command. (if wait-for-reply - (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range) + (nntp-send-command-nodelete + "\r?\n\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)) (let ((commands nntp-xover-commands))