+(defun gnus-cache-possibly-alter-active (group active)
+ "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
+ (when gnus-cache-active-hashtb
+ (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
+ (when cache-active
+ (when (< (car cache-active) (car active))
+ (setcar active (car cache-active)))
+ (when (> (cdr cache-active) (cdr active))
+ (setcdr active (cdr cache-active)))))))
+
+(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
+ "Retrieve the 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-headers articles group fetch-old))
+ (let ((uncached-articles (gnus-sorted-intersection
+ (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))
+ (when uncached-articles
+ (setq type (and articles
+ (gnus-retrieve-headers
+ uncached-articles group fetch-old)))))
+ (gnus-cache-save-buffers)
+ ;; Then we insert the cached headers.
+ (save-excursion
+ (cond
+ ((not (file-exists-p cache-file))
+ ;; There are no cached headers.
+ type)
+ ((null type)
+ ;; There were no uncached headers (or retrieval was
+ ;; unsuccessful), so we use the cached headers exclusively.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-file-contents cache-file)
+ 'nov)
+ ((eq type 'nov)
+ ;; We have both cached and uncached NOV headers, so we
+ ;; braid them.
+ (gnus-cache-braid-nov group cached)
+ type)
+ (t
+ ;; We braid HEADs.
+ (gnus-cache-braid-heads group (gnus-sorted-intersection
+ cached articles))
+ type)))))))
+
+(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.
+Returns the list of articles entered."
+ (interactive "P")
+ (let ((articles (gnus-summary-work-articles n))
+ article out)
+ (while (setq article (pop articles))
+ (gnus-summary-remove-process-mark article)
+ (if (natnump article)
+ (when (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ nil nil nil t)
+ (push article out))
+ (gnus-message 2 "Can't cache article %d" article))
+ (gnus-summary-update-secondary-mark article))
+ (gnus-summary-next-subject 1)
+ (gnus-summary-position-point)
+ (nreverse out)))
+
+(defun gnus-cache-remove-article (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)
+ (let ((articles (gnus-summary-work-articles n))
+ 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)
+ (push article out))
+ (gnus-summary-update-secondary-mark article))
+ (gnus-summary-next-subject 1)
+ (gnus-summary-position-point)
+ (nreverse out)))
+
+(defun gnus-cached-article-p (article)
+ "Say whether ARTICLE is cached in the current group."
+ (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) '<))
+ (gnus-verbose (max 6 gnus-verbose)))
+ (unless cached
+ (gnus-message 3 "No cached articles for this group"))
+ (while cached
+ (gnus-summary-goto-subject (pop cached) t))))
+
+(defalias 'gnus-summary-limit-include-cached
+ 'gnus-summary-insert-cached-articles)
+
+;;; Internal functions.
+
+(defun gnus-cache-change-buffer (group)
+ (and gnus-cache-buffer
+ ;; See if the current group's overview cache has been loaded.
+ (or (string= group (car gnus-cache-buffer))
+ ;; Another overview cache is current, save it.
+ (gnus-cache-save-buffers)))
+ ;; if gnus-cache buffer is nil, create it
+ (unless gnus-cache-buffer
+ ;; Create cache buffer
+ (save-excursion
+ (setq gnus-cache-buffer
+ (cons group
+ (set-buffer (get-buffer-create " *gnus-cache-overview*"))))
+ (buffer-disable-undo (current-buffer))
+ ;; Insert the contents of this group's cache overview.
+ (erase-buffer)
+ (let ((file (gnus-cache-file-name group ".overview")))
+ (when (file-exists-p file)
+ (nnheader-insert-file-contents file)))
+ ;; We have a fresh (empty/just loaded) buffer,
+ ;; mark it as unmodified to save a redundant write later.
+ (set-buffer-modified-p nil))))
+
+;; Return whether an article is a member of a class.
+(defun gnus-cache-member-of-class (class ticked dormant unread)
+ (or (and ticked (memq 'ticked class))
+ (and dormant (memq 'dormant class))
+ (and unread (memq 'unread class))
+ (and (not unread) (not ticked) (not dormant) (memq 'read class))))
+
+(defun gnus-cache-file-name (group article)
+ (concat (file-name-as-directory gnus-cache-directory)
+ (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))
+ (if (stringp article) article (int-to-string article))))
+
+(defun gnus-cache-update-article (group article)
+ "If ARTICLE is in the cache, remove it and re-enter it."
+ (gnus-cache-change-buffer group)
+ (when (gnus-cache-possibly-remove-article article nil nil nil t)
+ (let ((gnus-use-cache nil))
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article (gnus-summary-article-header article)
+ nil nil nil t))))
+
+(defun gnus-cache-possibly-remove-article (article ticked dormant unread
+ &optional force)
+ "Possibly remove ARTICLE from the cache."
+ (let ((group gnus-newsgroup-name)
+ (number article)
+ file)
+ ;; If this is a virtual group, we find the real group.
+ (when (gnus-virtual-group-p group)
+ (let ((result (nnvirtual-find-group-art
+ (gnus-group-real-name group) article)))
+ (setq group (car result)
+ number (cdr result))))
+ (setq file (gnus-cache-file-name group number))
+ (when (and (file-exists-p file)
+ (or force
+ (gnus-cache-member-of-class
+ gnus-cache-remove-articles ticked dormant unread)))
+ (save-excursion
+ (delete-file file)
+ (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))
+ (progn (forward-line 1) (point)))))
+ (setq gnus-newsgroup-cached
+ (delq article gnus-newsgroup-cached))
+ (gnus-summary-update-secondary-mark article)
+ t)))
+