(autoload 'news-reply-mode "rnewspost")
(autoload 'nnmail-request-post-buffer "nnmail")
(autoload 'cancel-timer "timer")
- (autoload 'telnet "telnet")
- (autoload 'telnet-send-input "telnet")
+ (autoload 'telnet "telnet" nil t)
+ (autoload 'telnet-send-input "telnet" nil t)
(autoload 'timezone-parse-date "timezone"))
(defvar nntp-server-hook nil
(defvar nntp-server-opened-hook nil
"*Hook used for sending commands to the server at startup.
-The default value is `nntp-send-mode-reader', whick makes an innd
+The default value is `nntp-send-mode-reader', which makes an innd
server spawn an nnrpd server. Another useful function to put in this
hook might be `nntp-send-authinfo', which will prompt for a password
to allow posting from the server. Note that this is only necessary to
-do on servers that use strict access control.") (add-hook
-'nntp-server-opened-hook 'nntp-send-mode-reader)
+do on servers that use strict access control.")
+(add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)
(defvar nntp-open-server-function 'nntp-open-network-stream
"*Function used for connecting to a remote system.
(defvar nntp-async-buffer nil)
(defvar nntp-async-articles nil)
(defvar nntp-async-fetched nil)
+(defvar nntp-async-group-alist nil)
+
\f
(defvar nntp-current-server nil)
'(nntp-async-buffer nil)
'(nntp-async-articles nil)
'(nntp-async-fetched nil)
+ '(nntp-async-group-alist nil)
'(nntp-server-process nil)
'(nntp-status-string nil)
'(nntp-server-xover try)
'(nntp-server-list-active-group try)
- '(nntp-timeout-servers nil)
'(nntp-current-group "")))
\f
-;;; Interface funtions.
+;;; Interface functions.
(defun nntp-retrieve-headers (sequence &optional newsgroup server)
"Retrieve the headers to the articles in SEQUENCE."
(if (or (null sequence) ;All requests have been sent.
(zerop (% count nntp-maximum-request)))
(progn
- (accept-process-output)
+ (nntp-accept-response)
(while (progn
(goto-char last-point)
;; Count replies.
(if (looking-at "^[23]")
(while (progn
(goto-char (- (point-max) 3))
- (not (looking-at "^\\.\r?$")))
+ (not (looking-at "^\\.\r?\n")))
(nntp-accept-response)))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
- (message "NNTP: Receiving headers... done"))
+ (message "NNTP: Receiving headers...done"))
;; Now all of replies are received.
(setq received number)
(last-point (point-min))
(command (if nntp-server-list-active-group
"LIST ACTIVE" "GROUP")))
- (while groups
- (nntp-send-strings-to-server command (car groups))
- (setq groups (cdr groups))
- (setq count (1+ count))
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (if (or (null groups) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (progn
- (accept-process-output)
+ (while groups
+ (nntp-send-strings-to-server command (car groups))
+ (setq groups (cdr groups))
+ (setq count (1+ count))
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (if (or (null groups) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (progn
+ (nntp-accept-response)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (nntp-accept-response)))))
+
+ ;; Wait for the reply from the final command.
+ (if nntp-server-list-active-group
+ (progn
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (if (looking-at "^[23]")
(while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (setq received (1+ received)))
- (setq last-point (point))
- (< received count))
+ (goto-char (- (point-max) 3))
+ (not (looking-at "^\\.\r?\n")))
(nntp-accept-response)))))
- ;; Wait for the reply from the final command.
- (if nntp-server-list-active-group
- (progn
- (goto-char (point-max))
- (re-search-backward "^[0-9]" nil t)
- (if (looking-at "^[23]")
- (while (progn
- (goto-char (- (point-max) 3))
- (not (looking-at "^\\.\r?$")))
- (nntp-accept-response)))))
-
- ;; Now all replies are received. We remove CRs.
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (replace-match ""))
+ ;; Now all replies are received. We remove CRs.
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
- (if nntp-server-list-active-group
- (progn
- ;; We have read active entries, so we just delete the
- ;; superfluos gunk.
- (goto-char (point-min))
- (while (re-search-forward "^[\\.234]" nil t)
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
- 'active)
- 'group))))
+ (if nntp-server-list-active-group
+ (progn
+ ;; We have read active entries, so we just delete the
+ ;; superfluos gunk.
+ (goto-char (point-min))
+ (while (re-search-forward "^[.2-5]" nil t)
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ 'active)
+ 'group))))
(defun nntp-open-server (server &optional defs)
(nnheader-init-server-buffer)
(setq nntp-current-server server)
(or (nntp-server-opened server)
(progn
- (if (member server nntp-timeout-servers)
+ (if (member nntp-address nntp-timeout-servers)
nil
(run-hooks 'nntp-prepare-server-hook)
- (nntp-open-server-semi-internal nntp-address))))))
+ (nntp-open-server-semi-internal nntp-address nntp-port-number))))))
(defun nntp-close-server (&optional server)
"Close connection to SERVER."
;; We cannot send QUIT command unless the process is running.
(if (nntp-server-opened)
(nntp-send-command nil "QUIT")))
- (nntp-close-server-internal server)))
+ (nntp-close-server-internal server)
+ (setq nntp-timeout-servers (delete server nntp-timeout-servers))))
-(fset 'nntp-request-quit (symbol-function 'nntp-close-server))
+(defalias 'nntp-request-quit (symbol-function 'nntp-close-server))
(defun nntp-request-close ()
"Close all server connections."
(delete-process nntp-async-process)
(and (get-buffer nntp-async-buffer)
(kill-buffer nntp-async-buffer))))
+ (while nntp-async-group-alist
+ (and (nth 3 (car nntp-async-group-alist))
+ (delete-process (nth 3 (car nntp-async-group-alist))))
+ (setq nntp-async-group-alist (cdr nntp-async-group-alist)))
(while nntp-server-alist
(and
(setq proc (nth 1 (assq 'nntp-server-process (car nntp-server-alist))))
(buffer-name proc)
(kill-buffer proc))
(setq nntp-server-alist (cdr nntp-server-alist)))
- (setq nntp-current-server nil)))
+ (setq nntp-current-server nil
+ nntp-timeout-servers nil
+ nntp-async-group-alist nil)))
(defun nntp-server-opened (&optional server)
"Say whether a connection to SERVER has been opened."
nntp-status-string))
(substring nntp-status-string (match-beginning 1) (match-end 1))
;; Empty message if nothing.
- nntp-status-string))
+ (or nntp-status-string "")))
(defun nntp-request-article (id &optional newsgroup server buffer)
"Request article ID (message-id or number)."
(art (or (and (numberp id) (int-to-string id)) id)))
;; If NEmacs, end of message may look like: "\256\215" (".^M")
(prog1
- (nntp-send-command "^\\.\r?$" "ARTICLE" art)
+ (nntp-send-command "^\\.\r?\n" "ARTICLE" art)
(nntp-decode-text)
(and nntp-async-articles (nntp-async-fetch-articles id)))))
(if buffer (set-process-buffer
(prog1
;; If NEmacs, end of message may look like: "\256\215" (".^M")
(nntp-send-command
- "^\\.\r?$" "BODY" (or (and (numberp id) (int-to-string id)) id))
+ "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id))
(nntp-decode-text)))
(defun nntp-request-head (id &optional newsgroup server)
(nntp-possibly-change-server newsgroup server)
(prog1
(nntp-send-command
- "^\\.\r?$" "HEAD" (or (and (numberp id) (int-to-string id)) id))
+ "^\\.\r?\n" "HEAD" (or (and (numberp id) (int-to-string id)) id))
(nntp-decode-text)))
(defun nntp-request-stat (id &optional newsgroup server)
"Request STAT of article ID (message-id or number)."
(nntp-possibly-change-server newsgroup server)
(nntp-send-command
- "^[23].*\r?$" "STAT" (or (and (numberp id) (int-to-string id)) id)))
+ "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id)))
(defun nntp-request-group (group &optional server dont-check)
"Select GROUP."
- (nntp-send-command "^.*\r?$" "GROUP" group)
+ (nntp-send-command "^.*\r?\n" "GROUP" group)
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(looking-at "[23]")))
(defun nntp-request-asynchronous (group &optional server articles)
+ (and nntp-async-articles (nntp-async-request-group group))
(and
nntp-async-number
(if (not (or (nntp-async-server-opened)
t)))
(defun nntp-list-active-group (group &optional server)
- (nntp-send-command "^.*\r?$" "LIST ACTIVE" group))
+ (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group))
(defun nntp-request-group-description (group &optional server)
"Get description of GROUP."
(if (nntp-possibly-change-server nil server)
(prog1
- (nntp-send-command "^.*\r?$" "XGTITLE" group)
+ (nntp-send-command "^.*\r?\n" "XGTITLE" group)
(nntp-decode-text))))
(defun nntp-close-group (group &optional server)
+ (setq nntp-current-group nil)
t)
(defun nntp-request-list (&optional server)
"List active groups."
(nntp-possibly-change-server nil server)
(prog1
- (nntp-send-command "^\\.\r?$" "LIST")
+ (nntp-send-command "^\\.\r?\n" "LIST")
(nntp-decode-text)))
(defun nntp-request-list-newsgroups (&optional server)
"List groups."
(nntp-possibly-change-server nil server)
(prog1
- (nntp-send-command "^\\.\r?$" "LIST NEWSGROUPS")
+ (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS")
(nntp-decode-text)))
(defun nntp-request-newgroups (date &optional server)
(substring
(aref date 3) 3 5) (substring (aref date 3) 6 8))))
(prog1
- (nntp-send-command "^\\.\r?$" "NEWGROUPS" time-string)
+ (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
(nntp-decode-text))))
(defun nntp-request-list-distributions (&optional server)
"List distributions."
(nntp-possibly-change-server nil server)
(prog1
- (nntp-send-command "^\\.\r?$" "LIST DISTRIBUTIONS")
+ (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS")
(nntp-decode-text)))
(defun nntp-request-last (&optional newsgroup server)
"Decrease the current article pointer."
(nntp-possibly-change-server newsgroup server)
- (nntp-send-command "^[23].*\r?$" "LAST"))
+ (nntp-send-command "^[23].*\r?\n" "LAST"))
(defun nntp-request-next (&optional newsgroup server)
"Advance the current article pointer."
(nntp-possibly-change-server newsgroup server)
- (nntp-send-command "^[23].*\r?$" "NEXT"))
+ (nntp-send-command "^[23].*\r?\n" "NEXT"))
(defun nntp-request-post (&optional server)
"Post the current buffer."
(nntp-possibly-change-server nil server)
- (if (nntp-send-command "^[23].*\r?$" "POST")
+ (if (nntp-send-command "^[23].*\r?\n" "POST")
(progn
(nntp-encode-text)
(nntp-send-region-to-server (point-min) (point-max))
;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
;; appended to end of the status message.
- (nntp-wait-for-response "^[23].*$"))))
+ (nntp-wait-for-response "^[23].*\n"))))
(defun nntp-request-post-buffer
(post group subject header article-buffer info follow-to respect-poster)
(goto-char (point-min))
(narrow-to-region (point-min)
(progn (search-forward "\n\n") (point)))
- (setq from (header-from header))
- (setq date (header-date header))
+ (setq from (mail-header-from header))
+ (setq date (mail-header-date header))
(and from
(let ((stop-pos
(string-match " *at \\| *@ \\| *(\\| *<" from)))
message-of
(concat (if stop-pos (substring from 0 stop-pos) from)
"'s message of " date))))
- (setq subject (or subject (header-subject header)))
+ (setq subject (or subject (mail-header-subject header)))
(or (string-match "^[Rr][Ee]:" subject)
(setq subject (concat "Re: " subject)))
(setq followup-to (mail-fetch-field "followup-to"))
(if (or (null respect-poster) ;Ignore followup-to: field.
(string-equal "" followup-to) ;Bogus header.
- (string-equal "poster" followup-to)) ;Poster
+ (string-equal "poster" followup-to);Poster
+ (and (eq respect-poster 'ask)
+ followup-to
+ (y-or-n-p (concat "Followup to "
+ followup-to "? "))))
(setq followup-to nil))
(setq newsgroups
(or follow-to followup-to (mail-fetch-field "newsgroups")))
- (setq references (header-references header))
+ (setq references (mail-header-references header))
(setq distribution (mail-fetch-field "distribution"))
;; Remove bogus distribution.
(and (stringp distribution)
(string-match "world" distribution)
(setq distribution nil))
- (setq message-id (header-id header))
+ (setq message-id (mail-header-id header))
(widen))
(setq news-reply-yank-from from)
(setq news-reply-yank-message-id message-id)
(insert (car (car newsgroups)) ": "
(cdr (car newsgroups)) "\n")
(setq newsgroups (cdr newsgroups)))))
- ;; Fold long references line to follow RFC1036.
- (mail-position-on-field "References")
- (let ((begin (- (point) (length "References: ")))
- (fill-column 79)
- (fill-prefix "\t"))
- (if references (insert references))
- (if (and references message-id) (insert " "))
- (if message-id (insert message-id))
- ;; The region must end with a newline to fill the region
- ;; without inserting extra newline.
- (fill-region-as-paragraph begin (1+ (point))))
+ (nnheader-insert-references references message-id)
(if distribution
(progn
(mail-position-on-field "Distribution")
This function is supposed to be called from `nntp-server-opened-hook'.
It will make innd servers spawn an nnrpd process to allow actual article
reading."
- (nntp-send-command "^.*\r?$" "MODE READER"))
+ (nntp-send-command "^.*\r?\n" "MODE READER"))
(defun nntp-send-authinfo ()
"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."
- (nntp-send-command "^.*\r?$" "AUTHINFO USER" (user-login-name))
- (nntp-send-command "^.*\r?$" "AUTHINFO PASS" (read-string "NNTP password: ")))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" (read-string "NNTP password: ")))
(defun nntp-default-sentinel (proc status)
"Default sentinel function for NNTP server process."
;; Delete `.' at end of the buffer (end of text mark).
(goto-char (point-max))
(forward-line -1)
- (if (looking-at "^\\.$")
+ (if (looking-at "^\\.\n")
(delete-region (point) (progn (forward-line 1) (point))))
;; Replace `..' at beginning of line with `.'.
(goto-char (point-min))
;; We don't care about gaps.
((not nntp-nov-gap)
- (nntp-send-xover-command (car sequence) (nntp-last-element sequence)))
+ (nntp-send-xover-command
+ (car sequence) (nntp-last-element sequence) 'wait)
+
+ (goto-char (point-min))
+ (if (looking-at "[1-5][0-9][0-9] ")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
+ (goto-char (point-max))
+ (forward-line -1)
+ (if (looking-at "\\.")
+ (delete-region (point) (progn (forward-line 1) (point)))))
;; We do it the hard way. For each gap, an XOVER command is sent
;; to the server. We do not wait for a reply from the server, we
(let ((count 0)
(received 0)
(last-point (point-min))
+ (buf (current-buffer))
first)
;; We have to check `nntp-server-xover'. If it gets set to nil,
;; that means that the server does not understand XOVER, but we
(< (- (nth 1 sequence) (car sequence)) nntp-nov-gap))
(setq sequence (cdr sequence)))
- (nntp-send-xover-command first (car sequence))
+ (if (not (nntp-send-xover-command first (car sequence)))
+ ()
(setq sequence (cdr sequence)
count (1+ count))
;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks.
- (if (or (null sequence) ;All requests have been sent.
+ (if (or (null sequence) ;All requests have been sent.
(zerop (% count nntp-maximum-request)))
(progn
(accept-process-output)
+ ;; On some Emacs versions the preceding function has
+ ;; a tendency to change the buffer. Perhaps. It's
+ ;; quite difficult to reporduce, because it only
+ ;; seems to happen once in a blue moon.
+ (set-buffer buf)
(while (progn
(goto-char last-point)
;; Count replies.
(setq received (1+ received)))
(setq last-point (point))
(< received count))
- (nntp-accept-response)))))
+ (accept-process-output)
+ (set-buffer buf))))))
(if (not nntp-server-xover)
()
(re-search-backward "^[0-9][0-9][0-9] " nil t)
(if (looking-at "^[23]")
(while (progn
- (goto-char (- (point-max) 3))
- (not (looking-at "^\\.\r?$")))
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n")))
(nntp-accept-response)))
;; We remove any "." lines and status lines.
(while (search-forward "\r" nil t)
(delete-char -1))
(goto-char (point-min))
- (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] "))
+ (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")))))
- nntp-server-xover))))
+ nntp-server-xover)
-(defun nntp-send-xover-command (beg end)
+(defun nntp-send-xover-command (beg end &optional wait-for-reply)
(let ((range (format "%d-%d" beg end)))
(if (stringp nntp-server-xover)
;; If `nntp-server-xover' is a string, then we just send this
- ;; command. We do not wait for the reply.
- (nntp-send-strings-to-server nntp-server-xover range)
+ ;; command.
+ (if wait-for-reply
+ (nntp-send-command "^\\.\r?\n" nntp-server-xover range)
+ ;; We do not wait for the reply.
+ (progn
+ (nntp-send-strings-to-server nntp-server-xover range)
+ t))
(let ((commands nntp-xover-commands))
;; `nntp-xover-commands' is a list of possible XOVER commands.
;; We try them all until we get at positive response.
(while (and commands (eq nntp-server-xover 'try))
- (nntp-send-command "^\\.\r?$" (car commands) range)
+ (nntp-send-command "^\\.\r?\n" (car commands) range)
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(setq commands (cdr commands)))
;; If none of the commands worked, we disable XOVER.
(if (eq nntp-server-xover 'try)
- (setq nntp-server-xover nil))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq nntp-server-xover nil)))
nntp-server-xover))))
(defun nntp-send-strings-to-server (&rest strings)
"Send list of STRINGS to news server as command and its arguments."
- (let ((cmd (concat (mapconcat (lambda (s) s) strings " ") "\r\n")))
+ (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n")))
;; We open the nntp server if it is down.
(or (nntp-server-opened nntp-current-server)
- (progn
- (nntp-close-server nntp-address)
- (nntp-open-server nntp-address))
+ (nntp-open-server nntp-current-server)
(error (nntp-status-message)))
;; Send the strings.
(process-send-string nntp-server-process cmd)))
(status nil)
(timer
(and nntp-connection-timeout
- (run-at-time nntp-connection-timeout
- nil 'nntp-kill-connection server))))
- (setq nntp-status-string "")
- (message "nntp: Connecting to server on %s..." server)
- (cond ((and server (nntp-open-server-internal server service))
- (setq nntp-address server)
- (setq status
- (condition-case nil
- (nntp-wait-for-response "^[23].*\r?$" 'slow)
- (error nil)
- (quit nil)))
- (or status (nntp-close-server-internal server))
- (and nntp-server-process
- (progn
- (set-process-sentinel
- nntp-server-process 'nntp-default-sentinel)
- ;; You can send commands at startup like AUTHINFO here.
- ;; Added by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
- (run-hooks 'nntp-server-opened-hook))))
- ((null server)
- (setq nntp-status-string "NNTP server is not specified.")))
- (and timer (cancel-timer timer))
- (message "")
- (or status
- (setq nntp-current-server nil))
- status))
+ (cond
+ ((fboundp 'run-at-time)
+ (run-at-time nntp-connection-timeout
+ nil 'nntp-kill-connection server))
+ ((fboundp 'start-itimer)
+ ;; Not sure if this will work or not, only one way to
+ ;; find out
+ (eval '(start-itimer "nntp-timeout"
+ (lambda ()
+ (nntp-kill-connection server))
+ nntp-connection-timeout nil)))))))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (setq nntp-status-string "")
+ (message "nntp: Connecting to server on %s..." server)
+ (cond ((and server (nntp-open-server-internal server service))
+ (setq nntp-address server)
+ (setq status
+ (condition-case nil
+ (nntp-wait-for-response "^[23].*\r?\n" 'slow)
+ (error nil)
+ (quit nil)))
+ (or status (nntp-close-server-internal server))
+ (and nntp-server-process
+ (progn
+ (set-process-sentinel
+ nntp-server-process 'nntp-default-sentinel)
+ ;; You can send commands at startup like AUTHINFO here.
+ ;; Added by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
+ (run-hooks 'nntp-server-opened-hook))))
+ ((null server)
+ (setq nntp-status-string "NNTP server is not specified."))
+ (t ; We couldn't open the server.
+ (setq nntp-status-string
+ (buffer-substring (point-min) (point-max)))
+ (setq nntp-timeout-servers (cons server nntp-timeout-servers))))
+ (and timer (cancel-timer timer))
+ (message "")
+ (or status
+ (setq nntp-current-server nil
+ nntp-async-number nil))
+ status)))
(defun nntp-open-server-internal (server &optional service)
"Open connection to news server on SERVER by SERVICE (default is nntp)."
nntp-server-process)))))
(defun nntp-open-network-stream (server)
- (open-network-stream "nntpd" nntp-server-buffer server nntp-port-number))
+ (open-network-stream
+ "nntpd" nntp-server-buffer server nntp-port-number))
(defun nntp-open-rlogin (server)
(let ((proc (start-process "nntpd" nntp-server-buffer "rsh" server)))
- (process-send-string proc (mapconcat (lambda (s) s) nntp-rlogin-parameters
+ (process-send-string proc (mapconcat 'identity nntp-rlogin-parameters
" "))
(process-send-string proc "\n")))
-(defun nntp-telnet-to-machine
+(defun nntp-telnet-to-machine ()
(let (b)
(telnet "localhost")
(goto-char (point-min))
;; accept-process-output is called.
;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
;; This is a copy of `nntp-default-sentinel'.
- (if (or (not nntp-server-process)
- (not (memq (process-status nntp-server-process) '(open run))))
- (error "nntp: Process connection closed; %s" (nntp-status-message))
- (if nntp-buggy-select
- (progn
- ;; We cannot use `accept-process-output'.
- ;; Fujitsu UTS requires messages during sleep-for. I don't know why.
- (message "NNTP: Reading...")
- (sleep-for 1)
- (message ""))
- (condition-case errorcode
- (accept-process-output nntp-server-process)
- (error
- (cond ((string-equal "select error: Invalid argument"
- (nth 1 errorcode))
- ;; Ignore select error.
- nil)
- (t
- (signal (car errorcode) (cdr errorcode)))))))))
+ (let ((buf (current-buffer)))
+ (prog1
+ (if (or (not nntp-server-process)
+ (not (memq (process-status nntp-server-process) '(open run))))
+ (error "nntp: Process connection closed; %s" (nntp-status-message))
+ (if nntp-buggy-select
+ (progn
+ ;; We cannot use `accept-process-output'.
+ ;; Fujitsu UTS requires messages during sleep-for.
+ ;; I don't know why.
+ (message "NNTP: Reading...")
+ (sleep-for 1)
+ (message ""))
+ (condition-case errorcode
+ (accept-process-output nntp-server-process)
+ (error
+ (cond ((string-equal "select error: Invalid argument"
+ (nth 1 errorcode))
+ ;; Ignore select error.
+ nil)
+ (t
+ (signal (car errorcode) (cdr errorcode))))))))
+ (set-buffer buf))))
(defun nntp-last-element (list)
"Return last element of LIST."
(setq articles (cdr articles))))))
(defun nntp-async-send-strings (&rest strings)
- (let ((cmd (concat (mapconcat (lambda (s) s) strings " ") "\r\n")))
+ (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n")))
(or (nntp-async-server-opened)
(nntp-async-open-server)
(error (nntp-status-message)))
(process-send-string nntp-async-process cmd)))
+(defun nntp-async-request-group (group)
+ (if (equal group nntp-current-group)
+ ()
+ (let ((asyncs (assoc group nntp-async-group-alist)))
+ ;; A new group has been selected, so we push the current state
+ ;; of async articles on an alist, and pull the old state off.
+ (setq nntp-async-group-alist
+ (cons (list nntp-current-group
+ nntp-async-articles nntp-async-fetched
+ nntp-async-process)
+ (delq asyncs nntp-async-group-alist)))
+ (setq nntp-current-group group)
+ (and asyncs
+ (progn
+ (setq nntp-async-articles (nth 1 asyncs))
+ (setq nntp-async-fetched (nth 2 asyncs))
+ (setq nntp-async-process (nth 3 asyncs)))))))
+
(provide 'nntp)
;;; nntp.el ends here
projects / gnus / blobdiff