+1999-02-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <t-ichi@po.shiojiri.ne.jp>
* lisp/gnus-offline.el: Rewrite to work with pGnus v0.74 based T-gnus.
;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: news
;; This file is part of GNU Emacs.
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.
(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.
;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: news
;; This file is part of GNU Emacs.
(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
(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)
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))
(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.
"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.")
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)
(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)
;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
(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)
projects / elisp / gnus.git- / commitdiff