articles (gnus-group-real-name group)
(nth 1 gnus-command-method) fetch-old))))
+(defun gnus-retrieve-parsed-headers (articles group &optional fetch-old
+ dependencies force-new)
+ "Request parsed-headers for ARTICLES in GROUP.
+If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
+ (unless dependencies
+ (setq dependencies
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)))
+ (let ((gnus-command-method (gnus-find-method-for-group group))
+ headers)
+ (if (and gnus-use-cache (numberp (car articles)))
+ (setq gnus-headers-retrieved-by
+ (gnus-cache-retrieve-headers articles group fetch-old))
+ (let ((func (gnus-get-function gnus-command-method
+ 'retrieve-parsed-headers 'no-error)))
+ (if func
+ (setq headers (funcall func articles dependencies
+ (gnus-group-real-name group)
+ (nth 1 gnus-command-method) fetch-old
+ force-new)
+ gnus-headers-retrieved-by (car headers)
+ headers (cdr headers))
+ (setq gnus-headers-retrieved-by
+ (funcall
+ (gnus-get-function gnus-command-method 'retrieve-headers)
+ articles (gnus-group-real-name group)
+ (nth 1 gnus-command-method) fetch-old))
+ )))
+ (or headers
+ (if (eq gnus-headers-retrieved-by 'nov)
+ (gnus-get-newsgroup-headers-xover
+ articles nil dependencies gnus-newsgroup-name t)
+ (gnus-get-newsgroup-headers dependencies)))
+ ))
+
(defun gnus-retrieve-articles (articles group)
"Request ARTICLES in GROUP."
(let ((gnus-command-method (gnus-find-method-for-group group)))
;; Retrieve the headers and read them in.
(gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
(setq gnus-newsgroup-headers
- (if (eq 'nov
- (setq gnus-headers-retrieved-by
- (gnus-retrieve-headers
- articles gnus-newsgroup-name
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers))))
- (gnus-get-newsgroup-headers-xover
- articles nil nil gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers)))
+ (gnus-retrieve-parsed-headers
+ articles gnus-newsgroup-name
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers)))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
;; Kludge to avoid having cached articles nixed out in virtual groups.
;; (nnheader-fold-continuation-lines)
'headers))))
+(deffoo nnmh-retrieve-parsed-headers (articles
+ dependencies
+ &optional newsgroup server fetch-old
+ force-new)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let* ((file nil)
+ (number (length articles))
+ (large (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)))
+ (count 0)
+ (pathname-coding-system 'binary)
+ (case-fold-search t)
+ ;;beg
+ article
+ headers header id end ref lines chars ctype in-reply-to
+ (cur (current-buffer)))
+ (nnmh-possibly-change-directory newsgroup server)
+ ;; We don't support fetching by Message-ID.
+ (if (stringp (car articles))
+ 'headers
+ (while articles
+ (when (and (file-exists-p
+ (setq file (concat (file-name-as-directory
+ nnmh-current-directory)
+ (int-to-string
+ (setq article (pop articles))))))
+ (not (file-directory-p file)))
+ ;;(insert (format "221 %d Article retrieved.\n" article))
+ ;;(setq beg (point))
+ (erase-buffer)
+ (nnheader-insert-head file)
+ (save-restriction
+ (std11-narrow-to-header)
+ (setq
+ header
+ (make-full-mail-header
+ ;; Number.
+ article
+ ;; Subject.
+ (or (std11-fetch-field "Subject")
+ "(none)")
+ ;; From.
+ (or (std11-fetch-field "From")
+ "(nobody)")
+ ;; Date.
+ (or (std11-fetch-field "Date")
+ "")
+ ;; Message-ID.
+ (progn
+ (goto-char (point-min))
+ (setq id (if (re-search-forward
+ "^Message-ID: *\\(<[^\n\t> ]+>\\)" nil t)
+ ;; We do it this way to make sure the Message-ID
+ ;; is (somewhat) syntactically valid.
+ (buffer-substring (match-beginning 1)
+ (match-end 1))
+ ;; If there was no message-id, we just fake one
+ ;; to make subsequent routines simpler.
+ (nnheader-generate-fake-message-id))))
+ ;; References.
+ (progn
+ (goto-char (point-min))
+ (if (search-forward "\nReferences: " nil t)
+ (progn
+ (setq end (point))
+ (prog1
+ (buffer-substring (match-end 0) (std11-field-end))
+ (setq ref
+ (buffer-substring
+ (progn
+ ;; (end-of-line)
+ (search-backward ">" end t)
+ (1+ (point)))
+ (progn
+ (search-backward "<" end t)
+ (point))))))
+ ;; Get the references from the in-reply-to header if there
+ ;; were no references and the in-reply-to header looks
+ ;; promising.
+ (if (and (search-forward "\nIn-Reply-To: " nil t)
+ (setq in-reply-to
+ (buffer-substring (match-end 0)
+ (std11-field-end)))
+ (string-match "<[^>]+>" in-reply-to))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^>]+>"
+ in-reply-to (match-end 0))
+ (setq ref2
+ (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2)))
+ ref)
+ (setq ref nil))))
+ ;; Chars.
+ (progn
+ (goto-char (point-min))
+ (if (search-forward "\nChars: " nil t)
+ (if (numberp (setq chars (ignore-errors (read cur))))
+ chars 0)
+ 0))
+ ;; Lines.
+ (progn
+ (goto-char (point-min))
+ (if (search-forward "\nLines: " nil t)
+ (if (numberp (setq lines (ignore-errors (read cur))))
+ lines 0)
+ 0))
+ ;; Xref.
+ (std11-fetch-field "Xref")
+ ))
+ (goto-char (point-min))
+ (if (setq ctype (std11-fetch-field "Content-Type"))
+ (mime-entity-set-content-type-internal
+ header (mime-parse-Content-Type ctype)))
+ )
+ (when (setq header
+ (gnus-dependencies-add-header
+ header dependencies force-new))
+ (push header headers))
+ )
+ (setq count (1+ count))
+
+ (and large
+ (zerop (% count 20))
+ (nnheader-message 5 "nnmh: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (when large
+ (nnheader-message 5 "nnmh: Receiving headers...done"))
+
+ ;; (nnheader-fold-continuation-lines)
+ (cons 'header (nreverse headers))
+ ))))
+
(deffoo nnmh-open-server (server &optional defs)
(nnoo-change-server 'nnmh server defs)
(when (not (file-exists-p nnmh-directory))
projects / elisp / gnus.git- / commitdiff