-- don't sync with chaos-1_12.
;;; 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 <larsi@gnus.org>
-;; 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.
;;; 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 <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: news
;; This file is part of GNU Emacs.
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)))
(setq heads nil)))))
gnus-newsgroup-dependencies)))
+;; The following macros and functions were written by Felix Lee
+;; <flee@cse.psu.edu>.
+
+(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)
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))
;; 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.
(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.
"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
(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)
;;; 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 <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
'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))
projects / elisp / gnus.git- / commitdiff