From 27908e0ccbf1b911937499027aea90255d234f44 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 1 Feb 1999 01:23:42 +0000 Subject: [PATCH] * Sync up with chaos-1_12 branch. See ChangeLog for more details. --- ChangeLog | 54 +++++++++++++++ lisp/gnus-cache.el | 92 ++++++++++++++++++++++++- lisp/gnus-int.el | 6 +- lisp/gnus-sum.el | 68 ++++++------------- lisp/gnus.el | 2 +- lisp/nnheader.el | 188 +++++++++++++++++++++++++++++++++++++++++++++++++++- lisp/nnmh.el | 125 ++-------------------------------- 7 files changed, 362 insertions(+), 173 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7d94c84..c325222 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,57 @@ +1999-02-01 Katsumi Yamaoka + + * lisp/gnus-sum.el (gnus-nov-parse-extra): Abolished. + (gnus-nov-parse-line): Use `char-after' instead of `following-char' + ; use `nnheader-nov-parse-extra' instead of `gnus-nov-parse-extra'. + +1999-01-31 MORIOKA Tomohiko + + * lisp/gnus-sum.el: Abolish macro `gnus-nov-read-integer', + `gnus-nov-skip-field' and `gnus-nov-field'. + (gnus-nov-parse-line): Use `nnheader-nov-field' and + `nnheader-nov-read-integer' instead of `gnus-nov-field' and + `gnus-nov-read-integer'. + (gnus-get-newsgroup-headers-xover): Use + `gnus-retrieve-parsed-headers'. + + * lisp/gnus-cache.el (gnus-cache-retrieve-parsed-headers): Use + `gnus-cache-braid-headers', + `nnheader-get-newsgroup-headers-xover*' and + `nnheader-retrieve-headers-from-directory*' instead of + `gnus-get-newsgroup-headers-xover', `gnus-cache-braid-parsed-nov' + nor `gnus-cache-braid-parsed-heads'; abolish function + `gnus-cache-braid-parsed-nov' and `gnus-cache-braid-parsed-nov'. + (gnus-cache-braid-headers): New function. + + * lisp/nnheader.el (nnheader-nov-read-integer): Use + `(search-forward "\t" eol 'move)' instead of `(forward-char 1)' as + same as `gnus-nov-read-integer'. + (nnheader-retrieve-headers-from-directory*): New function. + (nnheader-retrieve-headers-from-directory): Use + `nnheader-retrieve-headers-from-directory*'. + (nnheader-get-newsgroup-headers-xover*): New function. + +1999-01-30 MORIOKA Tomohiko + + * lisp/nnmh.el (nnmh-retrieve-parsed-headers): Use + `nnheader-retrieve-headers-from-directory'. + + * lisp/nnheader.el (nnheader-retrieve-headers-from-directory): New + function. + +1999-01-29 MORIOKA Tomohiko + + * lisp/gnus.el (gnus-version): Modify for SEMI 1.13. + + * lisp/gnus-int.el (gnus-retrieve-parsed-headers): Use + `gnus-cache-retrieve-parsed-headers' instead of + `gnus-cache-retrieve-headers'. + + * lisp/gnus-cache.el (gnus-cache-retrieve-parsed-headers): New + function. + (gnus-cache-braid-parsed-nov): New function. + (gnus-cache-braid-parsed-heads): New function. + 1999-01-30 Tatsuya Ichikawa * lisp/gnus-offline.el: Rewrite to work with pGnus v0.74 based T-gnus. diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 033033f..caadb8a 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -2,7 +2,8 @@ ;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Tatsuya Ichikawa +;; Tatsuya Ichikawa +;; MORIOKA Tomohiko ;; Keywords: news ;; This file is part of GNU Emacs. @@ -320,6 +321,65 @@ it's not cached." cached articles)) type))))))) +(defun gnus-cache-retrieve-parsed-headers (articles group &optional fetch-old + dependencies force-new) + "Retrieve the parsed-headers for ARTICLES in GROUP." + (let ((cached + (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) + (if (not cached) + ;; No cached articles here, so we just retrieve them + ;; the normal way. + (let ((gnus-use-cache nil)) + (gnus-retrieve-parsed-headers articles group fetch-old + dependencies force-new)) + (let ((uncached-articles (gnus-sorted-intersection + (gnus-sorted-complement articles cached) + articles)) + (cache-file (gnus-cache-file-name group ".overview"))) + (gnus-cache-braid-headers + ;; We first retrieve all the headers that we don't have in + ;; the cache. + (prog1 + (let ((gnus-use-cache nil)) + (when uncached-articles + (and articles + (gnus-retrieve-parsed-headers + uncached-articles group fetch-old + dependencies)) + )) + (gnus-cache-save-buffers)) + ;; Then we insert the cached headers. + (cond ((not (file-exists-p cache-file)) + ;; There are no cached headers. + ) + ((eq gnus-headers-retrieved-by 'nov) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (nnheader-insert-file-contents cache-file) + (nnheader-get-newsgroup-headers-xover* + articles nil dependencies group) + )) + (t + ;; We braid HEADs. + (nnheader-retrieve-headers-from-directory* + cached + (expand-file-name + (file-name-as-directory + (nnheader-translate-file-chars + (if (gnus-use-long-file-name 'not-cache) + group + (let ((group + (nnheader-replace-chars-in-string group ?/ ?_))) + ;; Translate the first colon into a slash. + (when (string-match ":" group) + (aset group (match-beginning 0) ?/)) + (nnheader-replace-chars-in-string group ?. ?/))) + t)) + gnus-cache-directory) + dependencies) + ))) + )))) + (defun gnus-cache-enter-article (&optional n) "Enter the next N articles into the cache. If not given a prefix, use the process marked articles instead. @@ -539,6 +599,36 @@ Returns the list of articles removed." (setq cached (cdr cached))) (kill-buffer cache-buf))) +(defun gnus-cache-braid-headers (headers cached-headers) + (if cached-headers + (if headers + (let (cached-header hrest nhrest) + (nconc (catch 'tag + (while cached-headers + (setq cached-header (car cached-headers)) + (if (< (mail-header-number cached-header) + (mail-header-number (car headers))) + (throw 'tag (nreverse cached-headers)) + (setq hrest headers + nhrest (cdr hrest)) + (while (and nhrest + (> (mail-header-number cached-header) + (mail-header-number (car nhrest)))) + (setq hrest nhrest + nhrest (cdr nhrest)) + ) + ;;(if nhrest + (setcdr hrest (cons cached-header nhrest)) + ;; (setq headers + ;; (nconc headers (list cached-header))) + ;; (throw 'tag nil) + ;;) + ) + (setq cached-headers (cdr cached-headers)))) + headers)) + (nreverse cached-headers)) + headers)) + ;;;###autoload (defun gnus-jog-cache () "Go through all groups and put the articles into the cache. diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 78836fa..5231a58 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko ;; Keywords: news ;; This file is part of GNU Emacs. @@ -305,8 +306,9 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (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)) + (setq headers + (gnus-cache-retrieve-parsed-headers articles group fetch-old + dependencies force-new)) (let ((func (gnus-get-function gnus-command-method 'retrieve-parsed-headers 'no-error))) (if func diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index ac32c3f..3ca7ab6 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -3122,31 +3122,6 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) -(defmacro gnus-nov-read-integer () - '(prog1 - (if (eq (char-after) ?\t) - 0 - (let ((num (ignore-errors (read buffer)))) - (if (numberp num) num 0))) - (unless (eobp) - (search-forward "\t" eol 'move)))) - -(defmacro gnus-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro gnus-nov-field () - '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) - -(defmacro gnus-nov-parse-extra () - '(let (out string) - (while (not (memq (char-after) '(?\n nil))) - (setq string (gnus-nov-field)) - (when (string-match "^\\([^ :]+\\): " string) - (push (cons (intern (match-string 1 string)) - (substring string (match-end 0))) - out))) - out)) - ;; This function has to be called with point after the article number ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) @@ -3155,28 +3130,23 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." header) ;; overview: [num subject from date id refs chars lines misc] - (unwind-protect - (progn - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (make-full-mail-header - number ; number - (gnus-nov-field) ; subject - (gnus-nov-field) ; from - (gnus-nov-field) ; date - (or (gnus-nov-field) - (nnheader-generate-fake-message-id)) ; id - (gnus-nov-field) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (unless (eq (char-after) ?\n) - (gnus-nov-field)) ; misc - (gnus-nov-parse-extra)))) ; extra - - (widen)) + (unless (eobp) + (forward-char)) + + (setq header + (make-full-mail-header + number ; number + (nnheader-nov-field) ; subject + (nnheader-nov-field) ; from + (nnheader-nov-field) ; date + (or (nnheader-nov-field) ; id + (nnheader-generate-fake-message-id)) + (nnheader-nov-field) ; refs + (nnheader-nov-read-integer) ; chars + (nnheader-nov-read-integer) ; lines + (unless (eq (char-after) ?\n) + (nnheader-nov-field)) ; misc + (nnheader-nov-parse-extra))) ; extra (when gnus-alter-header-function (funcall gnus-alter-header-function header)) @@ -4700,8 +4670,8 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (let ((gnus-nov-is-evil t)) (nconc (nreverse headers) - (when (gnus-retrieve-headers sequence group) - (gnus-get-newsgroup-headers)))))))) + (gnus-retrieve-parsed-headers sequence group) + )))))) (defun gnus-article-get-xrefs () "Fill in the Xref value in `gnus-current-headers', if necessary. diff --git a/lisp/gnus.el b/lisp/gnus.el index 1c2e3e5..8cb4cbe 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -276,7 +276,7 @@ is restarted, and sometimes reloaded." "Product name of the original version of Gnus.") (defconst gnus-version - (format "%s %s (based on %s v%s ; for SEMI 1.12, FLIM 1.12)" + (format "%s %s (based on %s v%s ; for SEMI 1.12/1.13, FLIM 1.12)" gnus-product-name gnus-version-number gnus-original-product-name gnus-original-version-number) "Version string for this version of gnus.") diff --git a/lisp/nnheader.el b/lisp/nnheader.el index aa3d6bd..858bbde 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -298,7 +298,8 @@ on your system, you could say something like: 0 (let ((num (ignore-errors (read (current-buffer))))) (if (numberp num) num 0))) - (or (eobp) (forward-char 1)))) + (unless (eobp) + (search-forward "\t" eol 'move)))) (defmacro nnheader-nov-parse-extra () '(let (out string) @@ -423,6 +424,191 @@ the line could be found." (beginning-of-line) (eq num article))) +(defun nnheader-retrieve-headers-from-directory* (articles + directory dependencies + &optional + fetch-old force-new large + backend) + (with-temp-buffer + (let* ((file nil) + (number (length articles)) + (count 0) + (pathname-coding-system 'binary) + (case-fold-search t) + (cur (current-buffer)) + article + headers header id end ref in-reply-to lines chars ctype) + ;; We don't support fetching by Message-ID. + (if (stringp (car articles)) + 'headers + (while articles + (when (and (file-exists-p + (setq file (expand-file-name + (int-to-string + (setq article (pop articles))) + directory))) + (not (file-directory-p file))) + (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 "%s: Receiving headers... %d%%" + backend + (/ (* count 100) number)))) + + (when large + (nnheader-message 5 "%s: Receiving headers...done" backend)) + + headers)))) + +(defun nnheader-retrieve-headers-from-directory (articles + directory dependencies + &optional + fetch-old force-new large + backend) + (cons 'header + (nreverse (nnheader-retrieve-headers-from-directory* + articles directory dependencies + fetch-old force-new large backend)))) + +(defun nnheader-get-newsgroup-headers-xover* (sequence + &optional + force-new dependencies + group) + "Parse the news overview data in the server buffer, and return a +list of headers that match SEQUENCE (see `nntp-retrieve-headers')." + ;; Get the Xref when the users reads the articles since most/some + ;; NNTP servers do not include Xrefs when using XOVER. + ;; (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) + (let ((cur nntp-server-buffer) + number headers header) + (save-excursion + (set-buffer nntp-server-buffer) + ;; Allow the user to mangle the headers before parsing them. + (gnus-run-hooks 'gnus-parse-headers-hook) + (goto-char (point-min)) + (while (not (eobp)) + (condition-case () + (while (and sequence (not (eobp))) + (setq number (read cur)) + (while (and sequence + (< (car sequence) number)) + (setq sequence (cdr sequence))) + (and sequence + (eq number (car sequence)) + (progn + (setq sequence (cdr sequence)) + (setq header (inline + (gnus-nov-parse-line + number dependencies force-new)))) + (push header headers)) + (forward-line 1)) + (error + (gnus-error 4 "Strange nov line (%d)" + (count-lines (point-min) (point))))) + (forward-line 1)) + ;; A common bug in inn is that if you have posted an article and + ;; then retrieves the active file, it will answer correctly -- + ;; the new article is included. However, a NOV entry for the + ;; article may not have been generated yet, so this may fail. + ;; We work around this problem by retrieving the last few + ;; headers using HEAD. + headers))) + ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index cda525c..d9f107d 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -2,7 +2,8 @@ ;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA +;; MORIOKA Tomohiko ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -132,124 +133,10 @@ (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)) - )))) + (nnheader-retrieve-headers-from-directory + articles nnmh-current-directory dependencies + fetch-old force-new large "nnmh") + ))) (deffoo nnmh-open-server (server &optional defs) (nnoo-change-server 'nnmh server defs) -- 1.7.10.4