+(defun nntp-find-group-and-number ()
+ (save-excursion
+ (save-restriction
+ (set-buffer nntp-server-buffer)
+ (narrow-to-region (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (goto-char (point-min))
+ ;; We first find the number by looking at the status line.
+ (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
+ (string-to-int
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ group newsgroups xref)
+ (and number (zerop number) (setq number nil))
+ ;; Then we find the group name.
+ (setq group
+ (cond
+ ;; 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 (mail-fetch-field "newsgroups"))
+ (not (string-match "," newsgroups)))
+ newsgroups)
+ ;; If there is more than one group in the Newsgroups
+ ;; header, then the Xref header should be filled out.
+ ;; We hazard a guess that the group that has this
+ ;; article number in the Xref header is the one we are
+ ;; looking for. This might very well be wrong if this
+ ;; article happens to have the same number in several
+ ;; groups, but that's life.
+ ((and (setq xref (mail-fetch-field "xref"))
+ number
+ (string-match (format "\\([^ :]+\\):%d" number) xref))
+ (substring xref (match-beginning 1) (match-end 1)))
+ (t "")))
+ (when (string-match "\r" group)
+ (setq group (substring group 0 (match-beginning 0))))
+ (cons group number)))))
+
+(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
+ (erase-buffer)
+ (cond
+
+ ;; This server does not talk NOV.
+ ((not nntp-server-xover)
+ nil)
+
+ ;; We don't care about gaps.
+ ((or (not nntp-nov-gap)
+ fetch-old)
+ (nntp-send-xover-command
+ (if fetch-old
+ (if (numberp fetch-old)
+ (max 1 (- (car articles) fetch-old))
+ 1)
+ (car articles))
+ (nntp-last-element articles) 'wait)
+
+ (goto-char (point-min))
+ (when (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)
+ (when (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
+ ;; just send them off as fast as we can. That means that we have
+ ;; to count the number of responses we get back to find out when we
+ ;; have gotten all we asked for.
+ ((numberp nntp-nov-gap)
+ (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
+ ;; won't know that until we try.
+ (while (and nntp-server-xover articles)
+ (setq first (car articles))
+ ;; Search forward until we find a gap, or until we run out of
+ ;; articles.
+ (while (and (cdr articles)
+ (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
+ (setq articles (cdr articles)))
+
+ (when (nntp-send-xover-command first (car articles))
+ (setq articles (cdr articles)
+ count (1+ 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)))
+ (accept-process-output)
+ ;; On some Emacs versions the preceding function has
+ ;; a tendency to change the buffer. Perhaps. It's
+ ;; quite difficult to reproduce, because it only
+ ;; seems to happen once in a blue moon.
+ (set-buffer buf)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (accept-process-output)
+ (set-buffer buf)))))
+
+ (when nntp-server-xover
+ ;; Wait for the reply from the final command.
+ (goto-char (point-max))
+ (re-search-backward "^[0-9][0-9][0-9] " nil t)
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response)))
+
+ ;; We remove any "." lines and status lines.
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (delete-char -1))
+ (goto-char (point-min))
+ (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")))))
+
+ nntp-server-xover)
+
+(defun nntp-send-xover-command (beg end &optional wait-for-reply)
+ "Send the XOVER command to the server."
+ (let ((range (format "%d-%d" (or beg 1) (or end beg 1))))
+ (if (stringp nntp-server-xover)
+ ;; If `nntp-server-xover' is a string, then we just send this
+ ;; command.
+ (if wait-for-reply
+ (nntp-send-command "^\\.\r?\n" nntp-server-xover range)
+ ;; We do not wait for the reply.
+ (nntp-send-strings-to-server nntp-server-xover range))
+ (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?\n" (car commands) range)
+ (save-excursion
+ (set-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
+ ;; servers give back simple lines with just the
+ ;; article number. How... helpful.
+ (progn
+ (forward-line 1)
+ (looking-at "[0-9]+\t...")) ; More text after number.
+ (setq nntp-server-xover (car commands))))
+ (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-server-xover))))
+