emacs: lisp/gnus/gnus-cache.el comparison

comparison lisp/gnus/gnus-cache.el @ 82951:0fde48feb604

Import Gnus 5.10 from the v5_10 branch of the Gnus repository.

author	Andreas Schwab <schwab@suse.de>
date	Thu, 22 Jul 2004 16:45:51 +0000
parents	695cf19ef79e
children	c5e16264557d cce1c0ee76ee

comparison

equal deleted inserted replaced

-:8bbd2323fbf2
+:0fde48feb604
 ;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
 ;;        Free Software Foundation, Inc.
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 (require 'gnus)
 (require 'gnus-int)
 (require 'gnus-range)
 (require 'gnus-start)
 (eval-when-compile
+(if (not (fboundp 'gnus-agent-load-alist))
+(defun gnus-agent-load-alist (group)))
 (require 'gnus-sum))
 (defcustom gnus-cache-active-file
 (expand-file-name "active" gnus-cache-directory)
 "*The cache active file."
 	  (setq group (car result)
 		number (cdr result))))
 (when (and number
 		 (> number 0)		; Reffed article.
 		 (or force
-(and (or (not gnus-cacheable-groups)
+		     (and (gnus-cache-fully-p group)
-(string-match gnus-cacheable-groups group))
-(or (not gnus-uncacheable-groups)
-			      (not (string-match
-				    gnus-uncacheable-groups group)))
 			  (gnus-cache-member-of-class
 			   gnus-cache-enter-articles ticked dormant unread)))
 		 (not (file-exists-p (setq file (gnus-cache-file-name
 						 group number)))))
 	;; Possibly create the cache directory.
 		  (gnus-article-decode-hook nil))
 	      (gnus-request-article-this-buffer number group))
 	    (when (> (buffer-size) 0)
 	      (let ((coding-system-for-write gnus-cache-coding-system))
 		(gnus-write-buffer file))
-	      (setq headers (nnheader-parse-head t))
+	      (nnheader-remove-body)
+	      (setq headers (nnheader-parse-naked-head))
 	      (mail-header-set-number headers number)
 	      (gnus-cache-change-buffer group)
 	      (set-buffer (cdr gnus-cache-buffer))
 	      (goto-char (point-max))
 	      (forward-line -1)
 		(forward-line 1))
 	      (beginning-of-line)
 	      (nnheader-insert-nov headers)
 	      ;; Update the active info.
 	      (set-buffer gnus-summary-buffer)
-	      (gnus-cache-update-active group number)
+	      (gnus-cache-possibly-update-active group (cons number number))
-	      (push article gnus-newsgroup-cached)
+	      (setq gnus-newsgroup-cached
+		    (gnus-add-to-sorted-list gnus-newsgroup-cached article))
 	      (gnus-summary-update-secondary-mark article))
 	    t))))))
 (defun gnus-cache-enter-remove-article (article)
 "Mark ARTICLE for later possible removal."
 	    (gnus-cache-possibly-remove-articles-1)))))
 (setq gnus-cache-removable-articles nil)))
 (defun gnus-cache-possibly-remove-articles-1 ()
 "Possibly remove some of the removable articles."
-(unless (eq gnus-use-cache 'passive)
+(when (gnus-cache-fully-p gnus-newsgroup-name)
 (let ((articles gnus-cache-removable-articles)
 	  (cache-articles gnus-newsgroup-cached)
 	  article)
 (gnus-cache-change-buffer gnus-newsgroup-name)
 (while articles
 (if (not cached)
 	;; No cached articles here, so we just retrieve them
 	;; the normal way.
 	(let ((gnus-use-cache nil))
 	  (gnus-retrieve-headers articles group fetch-old))
-(let ((uncached-articles (gnus-sorted-intersection
+(let ((uncached-articles (gnus-sorted-difference articles cached))
-				(gnus-sorted-complement articles cached)
-				articles))
 	    (cache-file (gnus-cache-file-name group ".overview"))
 	    type)
 	;; We first retrieve all the headers that we don't have in
 	;; the cache.
 	(let ((gnus-use-cache nil))
 (gnus-summary-remove-process-mark article)
 (if (natnump article)
 	  (when (gnus-cache-possibly-enter-article
 		 gnus-newsgroup-name article
 		 nil nil nil t)
+(setq gnus-newsgroup-undownloaded (delq article gnus-newsgroup-undownloaded))
 	    (push article out))
 	(gnus-message 2 "Can't cache article %d" article))
+(gnus-summary-update-download-mark article)
 (gnus-summary-update-secondary-mark article))
 (gnus-summary-next-subject 1)
 (gnus-summary-position-point)
 (nreverse out)))
-(defun gnus-cache-remove-article (n)
+(defun gnus-cache-remove-article (&optional n)
 "Remove the next N articles from the cache.
 If not given a prefix, use the process marked articles instead.
 Returns the list of articles removed."
 (interactive "P")
 (gnus-cache-change-buffer gnus-newsgroup-name)
 	article out)
 (while articles
 (setq article (pop articles))
 (gnus-summary-remove-process-mark article)
 (when (gnus-cache-possibly-remove-article article nil nil nil t)
+(when gnus-newsgroup-agentized
+(let ((alist (gnus-agent-load-alist gnus-newsgroup-name)))
+(unless (cdr (assoc article alist))
+(setq gnus-newsgroup-undownloaded
+(gnus-add-to-sorted-list
+gnus-newsgroup-undownloaded article)))))
 	(push article out))
+(gnus-summary-update-download-mark article)
 (gnus-summary-update-secondary-mark article))
 (gnus-summary-next-subject 1)
 (gnus-summary-position-point)
 (nreverse out)))
 (memq article gnus-newsgroup-cached))
 (defun gnus-summary-insert-cached-articles ()
 "Insert all the articles cached for this group into the current buffer."
 (interactive)
-(let ((cached (sort (copy-sequence gnus-newsgroup-cached) '>))
+(let ((gnus-verbose (max 6 gnus-verbose)))
-	(gnus-verbose (max 6 gnus-verbose)))
+(if (not gnus-newsgroup-cached)
-(unless cached
+	(gnus-message 3 "No cached articles for this group")
-(gnus-message 3 "No cached articles for this group"))
+(gnus-summary-goto-subjects gnus-newsgroup-cached))))
-(while cached
-(gnus-summary-goto-subject (pop cached) t))))
+(defun gnus-summary-limit-include-cached ()
+"Limit the summary buffer to articles that are cached."
-(defalias 'gnus-summary-limit-include-cached
+(interactive)
-'gnus-summary-insert-cached-articles)
+(let ((gnus-verbose (max 6 gnus-verbose)))
+(if gnus-newsgroup-cached
+	(progn
+	  (gnus-summary-limit gnus-newsgroup-cached)
+	  (gnus-summary-position-point))
+(gnus-message 3 "No cached articles for this group"))))
 ;;; Internal functions.
 (defun gnus-cache-change-buffer (group)
 (and gnus-cache-buffer
 	(let ((group (nnheader-replace-duplicate-chars-in-string
 		      (nnheader-replace-chars-in-string group ?/ ?_)
 		      ?. ?_)))
 	  ;; Translate the first colon into a slash.
 	  (when (string-match ":" group)
-	    (aset group (match-beginning 0) ?/))
+		  (setq group (concat (substring group 0 (match-beginning 0))
+				      "/" (substring group (match-end 0)))))
 	  (nnheader-replace-chars-in-string group ?. ?/)))
 t)
 gnus-cache-directory))))
 (defun gnus-cache-update-article (group article)
 	(set-buffer (cdr gnus-cache-buffer))
 	(goto-char (point-min))
 	(when (or (looking-at (concat (int-to-string number) "\t"))
 		  (search-forward (concat "\n" (int-to-string number) "\t")
 				  (point-max) t))
-	  (delete-region (progn (beginning-of-line) (point))
+	  (gnus-delete-line)))
-			 (progn (forward-line 1) (point)))))
+(unless (setq gnus-newsgroup-cached
-(setq gnus-newsgroup-cached
+		    (delq article gnus-newsgroup-cached))
-	    (delq article gnus-newsgroup-cached))
+	(gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb)
+	(setq gnus-cache-active-altered t))
 (gnus-summary-update-secondary-mark article)
 t)))
 (defun gnus-cache-articles-in-group (group)
 "Return a sorted list of cached articles in GROUP."
 (setq articles
 	    (sort (mapcar (lambda (name) (string-to-int name))
 			  (directory-files dir nil "^[0-9]+$" t))
 		  '<))
 ;; Update the cache active file, just to synch more.
-(when articles
+(if articles
-	(gnus-cache-update-active group (car articles) t)
+	  (progn
-	(gnus-cache-update-active group (car (last articles))))
+	    (gnus-cache-update-active group (car articles) t)
+	    (gnus-cache-update-active group (car (last articles))))
+	(when (gnus-gethash group gnus-cache-active-hashtb)
+	  (gnus-sethash group nil gnus-cache-active-hashtb)
+	  (setq gnus-cache-active-altered t)))
 articles)))
 (defun gnus-cache-braid-nov (group cached &optional file)
 (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
 	beg end)
 (while cached
 (while (and (not (eobp))
 		  (< (read (current-buffer)) (car cached)))
 	(forward-line 1))
 (beginning-of-line)
-(save-excursion
+(set-buffer cache-buf)
-	(set-buffer cache-buf)
+(if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
-	(if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
+			  nil t)
-			    nil t)
+	  (setq beg (gnus-point-at-bol)
-	    (setq beg (progn (beginning-of-line) (point))
+		end (progn (end-of-line) (point)))
-		  end (progn (end-of-line) (point)))
+	(setq beg nil))
-	  (setq beg nil)))
+(set-buffer nntp-server-buffer)
 (when beg
 	(insert-buffer-substring cache-buf beg end)
 	(insert "\n"))
 (setq cached (cdr cached)))
 (kill-buffer cache-buf)))
 		  (< (progn (goto-char (match-beginning 1))
 			    (read (current-buffer)))
 		     (car cached)))
 	(search-forward "\n.\n" nil 'move))
 (beginning-of-line)
-(save-excursion
+(set-buffer cache-buf)
-	(set-buffer cache-buf)
+(erase-buffer)
-	(erase-buffer)
+(let ((coding-system-for-read
-	(let ((coding-system-for-read
+	     gnus-cache-coding-system))
-	       gnus-cache-coding-system))
+	(insert-file-contents (gnus-cache-file-name group (car cached))))
-	  (insert-file-contents (gnus-cache-file-name group (car cached))))
+(goto-char (point-min))
-	(goto-char (point-min))
+(insert "220 ")
-	(insert "220 ")
+(princ (car cached) (current-buffer))
-	(princ (car cached) (current-buffer))
+(insert " Article retrieved.\n")
-	(insert " Article retrieved.\n")
+(search-forward "\n\n" nil 'move)
-	(search-forward "\n\n" nil 'move)
+(delete-region (point) (point-max))
-	(delete-region (point) (point-max))
+(forward-char -1)
-	(forward-char -1)
+(insert ".")
-	(insert "."))
+(set-buffer nntp-server-buffer)
 (insert-buffer-substring cache-buf)
 (setq cached (cdr cached)))
 (kill-buffer cache-buf)))
 ;;;###autoload
 		 gnus-cache-active-altered))
 (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb t)
 ;; Mark the active hashtb as unaltered.
 (setq gnus-cache-active-altered nil)))
+(defun gnus-cache-possibly-update-active (group active)
+"Update active info bounds of GROUP with ACTIVE if necessary.
+The update is performed if ACTIVE contains a higher or lower bound
+than the current."
+(let ((lower t) (higher t))
+(if gnus-cache-active-hashtb
+	(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
+	  (when cache-active
+	    (unless (< (car active) (car cache-active))
+	      (setq lower nil))
+	    (unless (> (cdr active) (cdr cache-active))
+	      (setq higher nil))))
+(gnus-cache-read-active))
+(when lower
+(gnus-cache-update-active group (car active) t))
+(when higher
+(gnus-cache-update-active group (cdr active)))))
 (defun gnus-cache-update-active (group number &optional low)
 "Update the upper bound of the active info of GROUP to NUMBER.
 If LOW, update the lower bound instead."
 (let ((active (gnus-gethash group gnus-cache-active-hashtb)))
 (if (null active)
 	 nums alphs)
 (when top
 (gnus-message 5 "Generating the cache active file...")
 (setq gnus-cache-active-hashtb (gnus-make-hashtable 123)))
 (when (string-match "^\\(nn[^_]+\\)_" group)
-(setq group (replace-match "\\1:" t t group)))
+(setq group (replace-match "\\1:" t nil group)))
 ;; Separate articles from all other files and directories.
 (while files
 (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
 	  (push (string-to-int (file-name-nondirectory (pop files))) nums)
 	(push (pop files) alphs)))
 (defun gnus-cache-generate-nov-databases (dir)
 "Generate NOV files recursively starting in DIR."
 (interactive (list gnus-cache-directory))
 (gnus-cache-close)
 (let ((nnml-generate-active-function 'identity))
-(nnml-generate-nov-databases-1 dir)))
+(nnml-generate-nov-databases-1 dir))
+(gnus-cache-open))
 (defun gnus-cache-move-cache (dir)
 "Move the cache tree to somewhere else."
 (interactive "FMove the cache tree to: ")
 (rename-file gnus-cache-directory dir))
+(defun gnus-cache-fully-p (&optional group)
+"Returns non-nil if the cache should be fully used.
+If GROUP is non-nil, also cater to `gnus-cacheable-groups' and
+`gnus-uncacheable-groups'."
+(and gnus-use-cache
+(not (eq gnus-use-cache 'passive))
+(if (null group)
+	   t
+	 (and (or (not gnus-cacheable-groups)
+		  (string-match gnus-cacheable-groups group))
+	      (or (not gnus-uncacheable-groups)
+		  (not (string-match gnus-uncacheable-groups group)))))))
 (provide 'gnus-cache)
 ;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
 ;;; gnus-cache.el ends here

Mercurial > emacs

comparison lisp/gnus/gnus-cache.el @ 82951:0fde48feb604