From: yamaoka Date: Mon, 1 Feb 1999 22:37:20 +0000 (+0000) Subject: * {gnus-cache,gnus-int,gnus-sum,gnus,nnheader,nnmh}.el: Undo the last changes X-Git-Tag: semi-gnus-6_10_3~3 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c079b16e7754ce1f29c6ba7fd176763a0af79c53;p=elisp%2Fgnus.git- * {gnus-cache,gnus-int,gnus-sum,gnus,nnheader,nnmh}.el: Undo the last changes -- don't sync with chaos-1_12. --- diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 7cbef0b..7f48584 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,8 +1,7 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko ;; Keywords: news ;; This file is part of GNU Emacs. @@ -323,65 +322,6 @@ 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. @@ -604,36 +544,6 @@ 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 c3f0dde..8143d0d 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,8 +1,7 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko ;; Keywords: news ;; This file is part of GNU Emacs. @@ -285,43 +284,6 @@ 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 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 - (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 21e525c..54d4130 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -3022,6 +3022,24 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) +;; The following macros and functions were written by Felix Lee +;; . + +(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))) + ;; 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) @@ -3030,22 +3048,27 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." header) ;; overview: [num subject from date id refs chars lines misc] - (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 (= (char-after) ?\n) - (nnheader-nov-field)))) ; 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 (= (char-after) ?\n) + (gnus-nov-field))))) ; misc + + (widen)) (when gnus-alter-header-function (funcall gnus-alter-header-function header)) @@ -3873,14 +3896,20 @@ 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 - (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))) + (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-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) ;; Kludge to avoid having cached articles nixed out in virtual groups. @@ -4524,8 +4553,8 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (let ((gnus-nov-is-evil t)) (nconc (nreverse headers) - (gnus-retrieve-parsed-headers sequence group) - )))))) + (when (gnus-retrieve-headers sequence group) + (gnus-get-newsgroup-headers)))))))) (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 0d02f6c..3b12369 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -257,8 +257,8 @@ is restarted, and sometimes reloaded." "Version number for this version of gnus.") (defconst gnus-version - (format "%s %s (based on Gnus 5.6.45; for SEMI 1.12/1.13, FLIM 1.12)" - gnus-product-name gnus-version-number) + (format "%s %s (based on Gnus 5.6.45; for SEMI 1.12, FLIM 1.12)" + gnus-product-name gnus-version-number) "Version string for this version of gnus.") (defcustom gnus-inhibit-startup-message nil diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 1665517..744333b 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -376,191 +376,6 @@ 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 47e1aad..462c60a 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -1,9 +1,8 @@ ;;; nnmh.el --- mhspool access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; MORIOKA Tomohiko +;; Masanobu UMEDA ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -113,29 +112,6 @@ '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) - (nnmh-possibly-change-directory newsgroup server) - ;; We don't support fetching by Message-ID. - (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) (when (not (file-exists-p nnmh-directory))