From a7a4c7af0f2abf79b7af407c3f0cecaa9c394877 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 1 Feb 1999 09:04:52 +0000 Subject: [PATCH] * gnus.el (gnus-version-number): Update to 6.10.3. * gnus-start.el (gnus-read-active-file): Eliminate duplicated select methods. * Sync up with chaos-1_12. See ../ChangeLog for more details. --- lisp/gnus-cache.el | 92 ++++++++++++++++++++++++- lisp/gnus-int.el | 40 ++++++++++- lisp/gnus-start.el | 42 ++++++----- lisp/gnus-sum.el | 87 ++++++++--------------- lisp/gnus.el | 6 +- lisp/nnheader.el | 195 ++++++++++++++++++++++++++++++++++++++++++++++++++-- lisp/nnmh.el | 28 +++++++- 7 files changed, 399 insertions(+), 91 deletions(-) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 7f48584..7cbef0b 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,7 +1,8 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko ;; Keywords: news ;; This file is part of GNU Emacs. @@ -322,6 +323,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. @@ -544,6 +604,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 8143d0d..c3f0dde 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,7 +1,8 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. +;; 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. @@ -284,6 +285,43 @@ 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-start.el b/lisp/gnus-start.el index 9a5aa09..e2e30d8 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1632,30 +1632,30 @@ newsgroup." (defun gnus-read-active-file (&optional force not-native) (gnus-group-set-mode-line) (let ((methods - (append - (if (and (not not-native) - (gnus-check-server gnus-select-method)) - ;; The native server is available. - (cons gnus-select-method gnus-secondary-select-methods) - ;; The native server is down, so we just do the - ;; secondary ones. - gnus-secondary-select-methods) - ;; Also read from the archive server. - (when (gnus-archive-server-wanted-p) - (list "archive")))) - list-type) + (mapcar + (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m)) + (append + (if (and (not not-native) + (gnus-check-server gnus-select-method)) + ;; The native server is available. + (cons gnus-select-method gnus-secondary-select-methods) + ;; The native server is down, so we just do the + ;; secondary ones. + gnus-secondary-select-methods) + ;; Also read from the archive server. + (when (gnus-archive-server-wanted-p) + (list "archive"))))) + method where mesg list-type) (setq gnus-have-read-active-file nil) (save-excursion (set-buffer nntp-server-buffer) - (while methods - (let* ((method (if (stringp (car methods)) - (gnus-server-get-method nil (car methods)) - (car methods))) - (where (nth 1 method)) - (mesg (format "Reading active file%s via %s..." + (while (setq method (pop methods)) + (unless (member method methods) + (setq where (nth 1 method) + mesg (format "Reading active file%s via %s..." (if (and where (not (zerop (length where)))) (concat " from " where) "") - (car method)))) + (car method))) (gnus-message 5 mesg) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. @@ -1702,9 +1702,7 @@ newsgroup." (gnus-active-to-gnus-format method gnus-active-hashtb nil t) ;; We mark this active file as read. (push method gnus-have-read-active-file) - (gnus-message 5 "%sdone" mesg)))))) - (setq methods (cdr methods)))))) - + (gnus-message 5 "%sdone" mesg)))))))))) (defun gnus-ignored-newsgroups-has-to-p () "Non-nil iff gnus-ignored-newsgroups includes \"^to\\\\.\" as an element." diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 1378a78..21e525c 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,5 @@ ;;; gnus-sum.el --- summary mode commands for Semi-gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -3022,24 +3022,6 @@ 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) @@ -3048,27 +3030,22 @@ 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 (= (following-char) ?\n) - (gnus-nov-field))))) ; misc - - (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 (= (char-after) ?\n) + (nnheader-nov-field)))) ; misc (when gnus-alter-header-function (funcall gnus-alter-header-function header)) @@ -3454,11 +3431,11 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp - (let ((addr (mime-read-field 'From h1))) + (let ((addr (car (mime-read-field 'From h1)))) (or (std11-full-name-string addr) (std11-address-string addr) "")) - (let ((addr (mime-read-field 'From h2))) + (let ((addr (car (mime-read-field 'From h2)))) (or (std11-full-name-string addr) (std11-address-string addr) "")) @@ -3896,20 +3873,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. @@ -4553,8 +4524,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 2cf74d8..0d02f6c 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -253,12 +253,12 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "Semi-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.2" +(defconst gnus-version-number "6.10.3" "Version number for this version of gnus.") (defconst gnus-version - (format "%s %s (based on Gnus 5.6.45; for SEMI 1.12, FLIM 1.12)" - gnus-product-name gnus-version-number) + (format "%s %s (based on Gnus 5.6.45; for SEMI 1.12/1.13, 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 6b7f496..1665517 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,5 +1,5 @@ ;;; nnheader.el --- header access macros for Semi-gnus and its backends -;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -52,7 +52,7 @@ (defvar nnheader-file-name-translation-alist nil "*Alist that says how to translate characters in file names. -For instance, if \":\" is illegal as a file character in file names +For instance, if \":\" is invalid as a file character in file names on your system, you could say something like: \(setq nnheader-file-name-translation-alist '((?: . ?_)))") @@ -269,7 +269,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)))) (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) @@ -375,6 +376,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) @@ -449,7 +635,8 @@ the line could be found." (defun nnheader-insert-references (references message-id) "Insert a References header based on REFERENCES and MESSAGE-ID." (if (and (not references) (not message-id)) - () ; This is illegal, but not all articles have Message-IDs. + ; This is invalid, but not all articles have Message-IDs. + () (mail-position-on-field "References") (let ((begin (save-excursion (beginning-of-line) (point))) (fill-column 78) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 462c60a..47e1aad 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -1,8 +1,9 @@ ;;; nnmh.el --- mhspool access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. +;; 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. @@ -112,6 +113,29 @@ '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)) -- 1.7.10.4