(defun nntp-record-command (string)
"Record the command STRING."
- (save-excursion
- (set-buffer (get-buffer-create "*nntp-log*"))
+ (with-current-buffer (get-buffer-create "*nntp-log*")
(goto-char (point-max))
(let ((time (current-time)))
(insert (format-time-string "%Y%m%dT%H%M%S" time)
(defsubst 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))
+ (with-current-buffer (process-buffer process)
(goto-char (point-min))
(while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
(setq nntp-process-response response)))
(nntp-decode-text (not decode))
(unless discard
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(goto-char (point-max))
(nntp-insert-buffer-substring (process-buffer process))
;; Nix out "nntp reading...." message.
nntp-open-connection-function
nntp-open-connection-functions-never-echo-commands))
(nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(goto-char pos)
(if (looking-at (regexp-quote command))
(delete-region pos (progn (forward-line 1)
;; If nothing to wait for, still remove possibly echo'ed commands
(unless wait-for
(nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(goto-char pos)
(if (looking-at (regexp-quote command))
(delete-region pos (progn (forward-line 1)
;; If nothing to wait for, still remove possibly echo'ed commands
(unless wait-for
(nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(goto-char pos)
(if (looking-at (regexp-quote command))
(delete-region pos (progn (forward-line 1) (point-at-bol))))
(nntp-erase-buffer
(nntp-find-connection-buffer nntp-server-buffer)))
(nntp-encode-text)
- (mm-with-unibyte-current-buffer
- ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
- (process-send-region (nntp-find-connection nntp-server-buffer)
- (point-min) (point-max)))
+ ;; Make sure we did not forget to encode some of the content.
+ (assert (save-excursion (goto-char (point-min))
+ (not (re-search-forward "[^\000-\377]" nil t))))
+ (mm-disable-multibyte)
+ (process-send-region (nntp-find-connection nntp-server-buffer)
+ (point-min) (point-max))
(nntp-retrieve-data
nil nntp-address nntp-port-number nntp-server-buffer
wait-for nnheader-callback-function))
(defvar nntp-with-open-group-internal nil)
(defvar nntp-report-n nil))
+(defun nntp-with-open-group-function (-group -server -connectionless -bodyfun)
+ "Protect against servers that don't like clients that keep idle connections opens.
+The problem being that these servers may either close a connection or
+simply ignore any further requests on a connection. Closed
+connections are not detected until `accept-process-output' has updated
+the `process-status'. Dropped connections are not detected until the
+connection timeouts (which may be several minutes) or
+`nntp-connection-timeout' has expired. When these occur
+`nntp-with-open-group', opens a new connection then re-issues the NNTP
+command whose response triggered the error."
+ (letf ((nntp-report-n (symbol-function 'nntp-report))
+ ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
+ (nntp-with-open-group-internal nil))
+ (while (catch 'nntp-with-open-group-error
+ ;; Open the connection to the server
+ ;; NOTE: Existing connections are NOT tested.
+ (nntp-possibly-change-group -group -server -connectionless)
+
+ (let ((-timer
+ (and nntp-connection-timeout
+ (run-at-time
+ nntp-connection-timeout nil
+ (lambda ()
+ (let* ((-process (nntp-find-connection
+ nntp-server-buffer))
+ (-buffer (and -process
+ (process-buffer -process))))
+ ;; When I an able to identify the
+ ;; connection to the server AND I've
+ ;; received NO reponse for
+ ;; nntp-connection-timeout seconds.
+ (when (and -buffer (eq 0 (buffer-size -buffer)))
+ ;; Close the connection. Take no
+ ;; other action as the accept input
+ ;; code will handle the closed
+ ;; connection.
+ (nntp-kill-buffer -buffer))))))))
+ (unwind-protect
+ (setq nntp-with-open-group-internal
+ (condition-case nil
+ (funcall -bodyfun)
+ (quit
+ (unless debug-on-quit
+ (nntp-close-server))
+ (signal 'quit nil))))
+ (when -timer
+ (nnheader-cancel-timer -timer)))
+ nil))
+ (setf (symbol-function 'nntp-report) nntp-report-n))
+ nntp-with-open-group-internal))
+
(defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
"Protect against servers that don't like clients that keep idle connections opens.
The problem being that these servers may either close a connection or
simply ignore any further requests on a connection. Closed
-connections are not detected until accept-process-output has updated
-the process-status. Dropped connections are not detected until the
+connections are not detected until `accept-process-output' has updated
+the `process-status'. Dropped connections are not detected until the
connection timeouts (which may be several minutes) or
-nntp-connection-timeout has expired. When these occur
-nntp-with-open-group, opens a new connection then re-issues the NNTP
+`nntp-connection-timeout' has expired. When these occur
+`nntp-with-open-group', opens a new connection then re-issues the NNTP
command whose response triggered the error."
+ (declare (indent 2) (debug (form form [&optional symbolp] def-body)))
(when (and (listp connectionless)
(not (eq connectionless nil)))
(setq forms (cons connectionless forms)
connectionless nil))
- `(letf ((nntp-report-n (symbol-function 'nntp-report))
- ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
- (nntp-with-open-group-internal nil))
- (while (catch 'nntp-with-open-group-error
- ;; Open the connection to the server
- ;; NOTE: Existing connections are NOT tested.
- (nntp-possibly-change-group ,group ,server ,connectionless)
-
- (let ((timer
- (and nntp-connection-timeout
- (run-at-time
- nntp-connection-timeout nil
- '(lambda ()
- (let ((process (nntp-find-connection
- nntp-server-buffer))
- (buffer (and process
- (process-buffer process))))
- ;; When I am able to identify the
- ;; connection to the server AND I've
- ;; received NO reponse for
- ;; nntp-connection-timeout seconds.
- (when (and buffer (eq 0 (buffer-size buffer)))
- ;; Close the connection. Take no
- ;; other action as the accept input
- ;; code will handle the closed
- ;; connection.
- (nntp-kill-buffer buffer))))))))
- (unwind-protect
- (setq nntp-with-open-group-internal
- (condition-case nil
- (progn ,@forms)
- (quit
- (unless debug-on-quit
- (nntp-close-server))
- (signal 'quit nil))))
- (when timer
- (nnheader-cancel-timer timer)))
- nil))
- (setf (symbol-function 'nntp-report) nntp-report-n))
- nntp-with-open-group-internal))
+ `(nntp-with-open-group-function ,group ,server ,connectionless (lambda () ,@forms)))
(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
"Retrieve the headers of ARTICLES."
(nntp-with-open-group
group server
- (save-excursion
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+ (with-current-buffer (nntp-find-connection-buffer nntp-server-buffer)
(erase-buffer)
(if (and (not gnus-nov-is-evil)
(not nntp-nov-is-evil)
(defun nntp-try-list-active (group)
(nntp-list-active-group group)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(goto-char (point-min))
(cond ((or (eobp)
(looking-at "5[0-9]+"))
(if (numberp article) (int-to-string article) article))
(if (and buffer
(not (equal buffer nntp-server-buffer)))
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(copy-to-buffer buffer (point-min) (point-max))
(nntp-find-group-and-number group))
(nntp-find-group-and-number group)))))
(deffoo nntp-request-newgroups (date &optional server)
(nntp-with-open-group
nil server
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(let* ((time (date-to-time date))
(ls (- (cadr time) (nth 8 (decode-time time)))))
(cond ((< ls 0)
(defun nntp-make-process-buffer (buffer)
"Create a new, fresh buffer usable for nntp process connections."
- (save-excursion
- (set-buffer
- (generate-new-buffer
- (format " *server %s %s %s*"
- nntp-address nntp-port-number
- (gnus-buffer-exists-p buffer))))
+ (with-current-buffer
+ (generate-new-buffer
+ (format " *server %s %s %s*"
+ nntp-address nntp-port-number
+ (gnus-buffer-exists-p buffer)))
(mm-disable-multibyte)
(set (make-local-variable 'after-change-functions) nil)
(set (make-local-variable 'nntp-process-wait-for) nil)
(prog1
(caar (push (list process buffer nil) nntp-connection-alist))
(push process nntp-connection-list)
- (save-excursion
- (set-buffer pbuffer)
+ (with-current-buffer pbuffer
(nntp-read-server-type)
(erase-buffer)
(set-buffer nntp-server-buffer)
?s nntp-address
?p nntp-port-number)))))
(gnus-set-process-query-on-exit-flag proc nil)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(let ((nntp-connection-alist (list proc buffer nil)))
(nntp-wait-for-string "^\r*20[01]"))
(beginning-of-line)
(defun nntp-open-tls-stream (buffer)
(let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
(gnus-set-process-query-on-exit-flag proc nil)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(let ((nntp-connection-alist (list proc buffer nil)))
(nntp-wait-for-string "^\r*20[01]"))
(beginning-of-line)
(funcall (cadr entry)))))))
(defun nntp-async-wait (process wait-for buffer decode callback)
- (save-excursion
- (set-buffer (process-buffer process))
+ (with-current-buffer (process-buffer process)
(unless nntp-inside-change-function
(erase-buffer))
(setq nntp-process-wait-for wait-for
(setq after-change-functions '(nntp-after-change-function)))))
(defun nntp-async-trigger (process)
- (save-excursion
- (set-buffer (process-buffer process))
+ (with-current-buffer (process-buffer process)
(when nntp-process-callback
;; do we have an error message?
(goto-char nntp-process-start-point)
(let ((buf (current-buffer))
(start nntp-process-start-point)
(decode nntp-process-decode))
- (save-excursion
- (set-buffer nntp-process-to-buffer)
+ (with-current-buffer nntp-process-to-buffer
(goto-char (point-max))
(save-restriction
(narrow-to-region (point) (point))
(cond ((not entry)
(nntp-report "Server closed connection"))
((not (equal group (caddr entry)))
- (save-excursion
- (set-buffer (process-buffer (car entry)))
+ (with-current-buffer (process-buffer (car entry))
(erase-buffer)
(nntp-send-command "^[245].*\n" "GROUP" group)
(setcar (cddr entry) group)
;; We try them all until we get at positive response.
(while (and commands (eq nntp-server-xover 'try))
(nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(goto-char (point-min))
(and (looking-at "[23]") ; No error message.
;; We also have to look at the lines. Some buggy
(defun nntp-find-group-and-number (&optional group)
(save-excursion
(save-restriction
+ ;; FIXME: This is REALLY FISHY: set-buffer after save-restriction?!?
(set-buffer nntp-server-buffer)
(narrow-to-region (goto-char (point-min))
(or (search-forward "\n\n" nil t) (point-max)))
(defun nntp-open-telnet-stream (buffer)
"Open a nntp connection by telnet'ing the news server.
+`nntp-open-via-netcat' is recommended in place of this function
+because it is more reliable.
Please refer to the following variables to customize the connection:
- `nntp-pre-command',
(and nntp-pre-command
(push nntp-pre-command command))
(setq proc (apply 'start-process "nntpd" buffer command))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(nntp-wait-for-string "^\r*20[01]")
(beginning-of-line)
(delete-region (point-min) (point))
"Open a connection to an nntp server through an intermediate host.
First rlogin to the remote host, and then telnet the real news server
from there.
+`nntp-open-via-rlogin-and-netcat' is recommended in place of this function
+because it is more reliable.
Please refer to the following variables to customize the connection:
- `nntp-pre-command',
(and nntp-pre-command
(push nntp-pre-command command))
(setq proc (apply 'start-process "nntpd" buffer command))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(nntp-wait-for-string "^r?telnet")
(process-send-string proc (concat "open " nntp-address
" " nntp-port-number "\n"))
- `nntp-address',
- `nntp-port-number',
- `nntp-end-of-line'."
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(erase-buffer)
(let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
(case-fold-search t)
(provide 'nntp)
-;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
+;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
;;; nntp.el ends here
projects / emacs.git / commitdiff