From: yamaoka Date: Tue, 26 Jan 1999 03:43:47 +0000 (+0000) Subject: * nnmh.el (nnmh-retrieve-parsed-headers): Bind `in-reply-to' and `cur' as X-Git-Tag: pgnus-ichikawa-199901261900~3 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=2e3886a9dbfb821a8af27ead05316d64d097c122;p=elisp%2Fgnus.git- * nnmh.el (nnmh-retrieve-parsed-headers): Bind `in-reply-to' and `cur' as temporary variables. ;; Stolen from the latest chaos-1_12 branch. * gnus-sum.el (gnus-article-sort-by-author): fixed. * gnus-int.el (gnus-retrieve-parsed-headers): Add new optional arguments `dependencies' and `force-new'; new implementation; call `retrieve-parsed-headers' if it is found. * nnmh.el (nnmh-retrieve-parsed-headers): New function. * gnus-sum.el (gnus-select-newsgroup): Use `gnus-retrieve-parsed-headers' instead of `gnus-retrieve-headers' and `gnus-get-newsgroup-headers-xover' or `gnus-get-newsgroup-headers'. * gnus-int.el (gnus-retrieve-parsed-headers): New function. --- diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 7fdadc8..78836fa 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -293,6 +293,42 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." 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))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 36be196..3e3be19 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -4011,20 +4011,14 @@ If SELECT-ARTICLES, only select those articles from 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. diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 07609d6..cda525c 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -113,6 +113,144 @@ ;; (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))