comparison lisp/gnus/gnus-cache.el @ 85712:a3c27999decb

Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Revision: [e-mail]/emacs--devo--0--patch-911

85711:b6f5dc84b2e1

;;; Code:

(eval-when-compile (require 'cl))

(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)

(defvar gnus-cache-removable-articles nil)
(defvar gnus-cache-buffer nil)
(defvar gnus-cache-active-hashtb nil)
(defvar gnus-cache-active-altered nil)

(eval-and-compile
  (autoload 'nnml-generate-nov-databases-1 "nnml")
  (autoload 'nnvirtual-find-group-art "nnvirtual"))

	  (if (> (buffer-size) 0)
	      ;; Non-empty overview, write it to a file.
	      (let ((coding-system-for-write
		     gnus-cache-overview-coding-system))
		(gnus-write-buffer overview-file))
	    ;; Empty overview file, remove it
	    (when (file-exists-p overview-file)
	      (delete-file overview-file))
	    ;; If possible, remove group's cache subdirectory.
	    (condition-case nil
		;; FIXME: we can detect the error type and warn the user
		;; of any inconsistencies (articles w/o nov entries?).
		;; for now, just be conservative...delete only if safe -- sj
		(delete-directory (file-name-directory overview-file))
	      (error nil)))))
      ;; Kill the buffer -- it's either unmodified or saved.
      (gnus-kill-buffer buffer)
      (setq gnus-cache-buffer nil))))

(defun gnus-cache-possibly-enter-article
  (group article ticked dormant unread &optional force)
  (when (and (or force (not (eq gnus-use-cache 'passive)))
	     (numberp article)
	     (> article 0))		; This might be a dummy article.
    (let ((number article) file headers)
      ;; 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)

	    (let ((gnus-use-cache nil)
		  (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))
	      (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)
	      (while (condition-case ()

    (setq gnus-cache-removable-articles nil)))

(defun gnus-cache-possibly-remove-articles-1 ()
  "Possibly remove some of the removable articles."
  (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
	(when (memq (setq article (pop articles)) cache-articles)
	  ;; The article was in the cache, so we see whether we are
	  ;; supposed to remove it from the cache.
	  (gnus-cache-possibly-remove-article
	   article (memq article gnus-newsgroup-marked)
	   (memq article gnus-newsgroup-dormant)

    (gnus-cache-save-buffers)))

(defun gnus-cache-request-article (article group)
  "Retrieve ARTICLE in GROUP from the cache."
  (let ((file (gnus-cache-file-name group article))
	(buffer-read-only nil))
    (when (file-exists-p file)
      (erase-buffer)
      (gnus-kill-all-overlays)
      (let ((coding-system-for-read gnus-cache-coding-system))
	(insert-file-contents file))

	;; the normal way.
	(let ((gnus-use-cache nil))
	  (gnus-retrieve-headers articles group fetch-old))
      (let ((uncached-articles (gnus-sorted-difference articles cached))
	    (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

(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
		 nil nil nil t)

  "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)
        (when gnus-newsgroup-agentized
          (let ((alist (gnus-agent-load-alist gnus-newsgroup-name)))
            (unless (cdr (assoc article alist))

	    (cons group
		  (set-buffer (gnus-get-buffer-create
			       " *gnus-cache-overview*"))))
      ;; 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))))

  (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)
  (setq group (gnus-group-decoded-name group))
  (expand-file-name
   (if (stringp article) article (int-to-string article))
   (file-name-as-directory
    (expand-file-name
     (nnheader-translate-file-chars

(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)

    (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))
	  (gnus-delete-line)))
      (unless (setq 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."
  (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
	articles)
    (when (file-exists-p dir)
      (setq articles
	    (sort (mapcar (lambda (name) (string-to-number name))
			  (directory-files dir nil "^[0-9]+$" t))
		  '<))

	beg end)
    (gnus-cache-save-buffers)
    (save-excursion
      (set-buffer cache-buf)
      (erase-buffer)
      (let ((coding-system-for-read
	     gnus-cache-overview-coding-system))
	(insert-file-contents
	 (or file (gnus-cache-file-name group ".overview"))))
      (goto-char (point-min))
      (insert "\n")
      (goto-char (point-min)))

	(forward-line 1))
      (beginning-of-line)
      (set-buffer cache-buf)
      (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
			  nil t)
	  (setq beg (gnus-point-at-bol)
		end (progn (end-of-line) (point)))
	(setq beg nil))
      (set-buffer nntp-server-buffer)
      (when beg
	(insert-buffer-substring cache-buf beg end)

      (setq cached (cdr cached)))
    (kill-buffer cache-buf)))

(defun gnus-cache-braid-heads (group cached)
  (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
    (save-excursion
      (set-buffer cache-buf)
      (erase-buffer))
    (set-buffer nntp-server-buffer)
    (goto-char (point-min))
    (while cached
      (while (and (not (eobp))
		  (looking-at "2.. +\\([0-9]+\\) ")
		  (< (progn (goto-char (match-beginning 1))
			    (read (current-buffer)))
		     (car cached)))
	(search-forward "\n.\n" nil 'move))
      (beginning-of-line)
      (set-buffer cache-buf)
      (erase-buffer)
      (let ((coding-system-for-read
	     gnus-cache-coding-system))
	(insert-file-contents (gnus-cache-file-name group (car cached))))
      (goto-char (point-min))
      (insert "220 ")
      (princ (car cached) (current-buffer))
      (insert " Article retrieved.\n")
      (search-forward "\n\n" nil 'move)
      (delete-region (point) (point-max))
      (forward-char -1)
      (insert ".")
      (set-buffer nntp-server-buffer)
      (insert-buffer-substring cache-buf)
      (setq cached (cdr cached)))
    (kill-buffer cache-buf)))

;;;###autoload
(defun gnus-jog-cache ()
  "Go through all groups and put the articles into the cache.

(defun gnus-cache-generate-active (&optional directory)
  "Generate the cache active file."
  (interactive)
  (let* ((top (null directory))
	 (directory (expand-file-name (or directory gnus-cache-directory)))
	 (files (directory-files directory 'full))
	 (group
	  (if top
	      ""
	    (string-match

      (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
	  (push (string-to-number (file-name-nondirectory (pop files))) nums)
	(push (pop files) alphs)))
    ;; If we have nums, then this is probably a valid group.
    (when (setq nums (sort nums '<))
      (gnus-sethash group (cons (car nums) (gnus-last-element nums))
		    gnus-cache-active-hashtb))
    ;; Go through all the other files.
    (while alphs
      (when (and (file-directory-p (car alphs))
		 (not (string-match "^\\."
				    (file-name-nondirectory (car alphs)))))
	;; We descend directories.
	(gnus-cache-generate-active (car alphs)))
      (setq alphs (cdr alphs)))
    ;; Write the new active file.
    (when top
      (gnus-cache-write-active t)
      (gnus-message 5 "Generating the cache active file...done"))))

  "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))
  (gnus-cache-open))

(defun gnus-cache-move-cache (dir)
  "Move the cache tree to somewhere else."
  (interactive "FMove the cache tree to: ")

Always updates the cache, even when disabled, as the old cache
files would corrupt Gnus when the cache was next enabled.  It
depends on the caller to determine whether group renaming is
supported."
  (let ((old-dir (gnus-cache-file-name old-group ""))
	(new-dir (gnus-cache-file-name new-group "")))
    (gnus-rename-file old-dir new-dir t))

  (let ((no-save gnus-cache-active-hashtb))
    (unless gnus-cache-active-hashtb
      (gnus-cache-read-active))
    (let* ((old-group-hash-value

  "Delete GROUP from the cache.
Always updates the cache, even when disabled, as the old cache
files would corrupt gnus when the cache was next enabled.
Depends upon the caller to determine whether group deletion is
supported."
  (let ((dir (gnus-cache-file-name group "")))
    (gnus-delete-directory dir))

  (let ((no-save gnus-cache-active-hashtb))
    (unless gnus-cache-active-hashtb
      (gnus-cache-read-active))
    (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb)))

      (if no-save
	  (setq gnus-cache-active-altered group-hash-value)
	(gnus-cache-write-active group-hash-value)))))

(provide 'gnus-cache)

;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
;;; gnus-cache.el ends here

85712:a3c27999decb

;;; Code:

(eval-when-compile (require 'cl))

(require 'gnus)
(eval-when-compile
  (unless (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)

(defvar gnus-cache-removable-articles nil)
(defvar gnus-cache-buffer nil)
(defvar gnus-cache-active-hashtb nil)
(defvar gnus-cache-active-altered nil)
(defvar gnus-cache-total-fetched-hashtb nil)

(eval-and-compile
  (autoload 'nnml-generate-nov-databases-1 "nnml")
  (autoload 'nnvirtual-find-group-art "nnvirtual"))

	  (if (> (buffer-size) 0)
	      ;; Non-empty overview, write it to a file.
	      (let ((coding-system-for-write
		     gnus-cache-overview-coding-system))
		(gnus-write-buffer overview-file))
	    (let ((file-name-coding-system nnmail-pathname-coding-system))
	      ;; Empty overview file, remove it
	      (when (file-exists-p overview-file)
		(delete-file overview-file))
	      ;; If possible, remove group's cache subdirectory.
	      (condition-case nil
		  ;; FIXME: we can detect the error type and warn the user
		  ;; of any inconsistencies (articles w/o nov entries?).
		  ;; for now, just be conservative...delete only if safe -- sj
		  (delete-directory (file-name-directory overview-file))
		(error))))

	  (gnus-cache-update-overview-total-fetched-for
	   (car gnus-cache-buffer) overview-file)))
      ;; Kill the buffer -- it's either unmodified or saved.
      (gnus-kill-buffer buffer)
      (setq gnus-cache-buffer nil))))

(defun gnus-cache-possibly-enter-article
  (group article ticked dormant unread &optional force)
  (when (and (or force (not (eq gnus-use-cache 'passive)))
	     (numberp article)
	     (> article 0))		; This might be a dummy article.
    (let ((number article)
	  file headers lines-chars
	  (file-name-coding-system nnmail-pathname-coding-system))
      ;; 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)

	    (let ((gnus-use-cache nil)
		  (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)
		(gnus-cache-update-file-total-fetched-for group file))
	      (setq lines-chars (nnheader-get-lines-and-char))
	      (nnheader-remove-body)
	      (setq headers (nnheader-parse-naked-head))
	      (mail-header-set-number headers number)
	      (mail-header-set-lines headers (car lines-chars))
	      (mail-header-set-chars headers (cadr lines-chars))
	      (gnus-cache-change-buffer group)
	      (set-buffer (cdr gnus-cache-buffer))
	      (goto-char (point-max))
	      (forward-line -1)
	      (while (condition-case ()

    (setq gnus-cache-removable-articles nil)))

(defun gnus-cache-possibly-remove-articles-1 ()
  "Possibly remove some of the removable articles."
  (when (gnus-cache-fully-p gnus-newsgroup-name)
    (let ((cache-articles gnus-newsgroup-cached))
      (gnus-cache-change-buffer gnus-newsgroup-name)
      (dolist (article gnus-cache-removable-articles)
	(when (memq article cache-articles)
	  ;; The article was in the cache, so we see whether we are
	  ;; supposed to remove it from the cache.
	  (gnus-cache-possibly-remove-article
	   article (memq article gnus-newsgroup-marked)
	   (memq article gnus-newsgroup-dormant)

    (gnus-cache-save-buffers)))

(defun gnus-cache-request-article (article group)
  "Retrieve ARTICLE in GROUP from the cache."
  (let ((file (gnus-cache-file-name group article))
	(buffer-read-only nil)
	(file-name-coding-system nnmail-pathname-coding-system))
    (when (file-exists-p file)
      (erase-buffer)
      (gnus-kill-all-overlays)
      (let ((coding-system-for-read gnus-cache-coding-system))
	(insert-file-contents file))

	;; the normal way.
	(let ((gnus-use-cache nil))
	  (gnus-retrieve-headers articles group fetch-old))
      (let ((uncached-articles (gnus-sorted-difference articles cached))
	    (cache-file (gnus-cache-file-name group ".overview"))
	    type
	    (file-name-coding-system nnmail-pathname-coding-system))
	;; 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

(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 (out)
    (dolist (article (gnus-summary-work-articles n))
      (gnus-summary-remove-process-mark article)
      (if (natnump article)
	  (when (gnus-cache-possibly-enter-article
		 gnus-newsgroup-name article
		 nil nil nil t)

  "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 (out)
    (dolist (article (gnus-summary-work-articles n))
      (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))

	    (cons group
		  (set-buffer (gnus-get-buffer-create
			       " *gnus-cache-overview*"))))
      ;; Insert the contents of this group's cache overview.
      (erase-buffer)
      (let ((file (gnus-cache-file-name group ".overview"))
	    (file-name-coding-system nnmail-pathname-coding-system))
	(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))))

  (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))))

(defvar gnus-cache-decoded-group-names nil
  "Alist of original group names and decoded group names.
Decoding is done according to `gnus-group-name-charset-method-alist'
or `gnus-group-name-charset-group-alist'.")

(defvar gnus-cache-unified-group-names nil
  "Alist of unified decoded group names and original group names.
A group name is decoded according to
`gnus-group-name-charset-method-alist' or
`gnus-group-name-charset-group-alist' first, and is encoded and
decoded again according to `nnmail-pathname-coding-system',
`file-name-coding-system', or `default-file-name-coding-system'.

It is used when asking for a original group name from a cache
directory name, in which non-ASCII characters might have been unified
into the ones of a certain charset particularly if the `utf-8' coding
system for example was used.")

(defun gnus-cache-decoded-group-name (group)
  "Return a decoded group name of GROUP."
  (or (cdr (assoc group gnus-cache-decoded-group-names))
      (let ((decoded (gnus-group-decoded-name group))
	    (coding (or nnmail-pathname-coding-system
			(and (boundp 'file-name-coding-system)
			     file-name-coding-system)
			(and (boundp 'default-file-name-coding-system)
			     default-file-name-coding-system))))
	(push (cons group decoded) gnus-cache-decoded-group-names)
	(push (cons (mm-decode-coding-string
		     (mm-encode-coding-string decoded coding)
		     coding)
		    group)
	      gnus-cache-unified-group-names)
	decoded)))

(defun gnus-cache-file-name (group article)
  (setq group (gnus-cache-decoded-group-name group))
  (expand-file-name
   (if (stringp article) article (int-to-string article))
   (file-name-as-directory
    (expand-file-name
     (nnheader-translate-file-chars

(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
	(file-name-coding-system nnmail-pathname-coding-system))
    ;; 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)

    (when (and (file-exists-p file)
	       (or force
		   (gnus-cache-member-of-class
		    gnus-cache-remove-articles ticked dormant unread)))
      (save-excursion
	(gnus-cache-update-file-total-fetched-for group file t)
	(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))
	    (gnus-delete-line)))
      (unless (setq 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."
  (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
	articles
	(file-name-coding-system nnmail-pathname-coding-system))
    (when (file-exists-p dir)
      (setq articles
	    (sort (mapcar (lambda (name) (string-to-number name))
			  (directory-files dir nil "^[0-9]+$" t))
		  '<))

	beg end)
    (gnus-cache-save-buffers)
    (save-excursion
      (set-buffer cache-buf)
      (erase-buffer)
      (let ((coding-system-for-read gnus-cache-overview-coding-system)
	    (file-name-coding-system nnmail-pathname-coding-system))
	(insert-file-contents
	 (or file (gnus-cache-file-name group ".overview"))))
      (goto-char (point-min))
      (insert "\n")
      (goto-char (point-min)))

	(forward-line 1))
      (beginning-of-line)
      (set-buffer cache-buf)
      (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
			  nil t)
	  (setq beg (point-at-bol)
		end (progn (end-of-line) (point)))
	(setq beg nil))
      (set-buffer nntp-server-buffer)
      (when beg
	(insert-buffer-substring cache-buf beg end)

      (setq cached (cdr cached)))
    (kill-buffer cache-buf)))

(defun gnus-cache-braid-heads (group cached)
  (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
    (with-current-buffer cache-buf
      (erase-buffer))
    (set-buffer nntp-server-buffer)
    (goto-char (point-min))
    (dolist (entry cached)
      (while (and (not (eobp))
		  (looking-at "2.. +\\([0-9]+\\) ")
		  (< (progn (goto-char (match-beginning 1))
			    (read (current-buffer)))
		     entry))
	(search-forward "\n.\n" nil 'move))
      (beginning-of-line)
      (set-buffer cache-buf)
      (erase-buffer)
      (let ((coding-system-for-read gnus-cache-coding-system)
	    (file-name-coding-system nnmail-pathname-coding-system))
	(insert-file-contents (gnus-cache-file-name group entry)))
      (goto-char (point-min))
      (insert "220 ")
      (princ (car cached) (current-buffer))
      (insert " Article retrieved.\n")
      (search-forward "\n\n" nil 'move)
      (delete-region (point) (point-max))
      (forward-char -1)
      (insert ".")
      (set-buffer nntp-server-buffer)
      (insert-buffer-substring cache-buf))
    (kill-buffer cache-buf)))

;;;###autoload
(defun gnus-jog-cache ()
  "Go through all groups and put the articles into the cache.

(defun gnus-cache-generate-active (&optional directory)
  "Generate the cache active file."
  (interactive)
  (let* ((top (null directory))
	 (directory (expand-file-name (or directory gnus-cache-directory)))
	 (file-name-coding-system nnmail-pathname-coding-system)
	 (files (directory-files directory 'full))
	 (group
	  (if top
	      ""
	    (string-match

      (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
	  (push (string-to-number (file-name-nondirectory (pop files))) nums)
	(push (pop files) alphs)))
    ;; If we have nums, then this is probably a valid group.
    (when (setq nums (sort nums '<))
      ;; Use non-decoded group name.
      ;; FIXME: this is kind of a workaround.  The active file should
      ;; be updated at the time articles are cached.  It will make
      ;; `gnus-cache-unified-group-names' needless.
      (gnus-sethash (or (cdr (assoc group gnus-cache-unified-group-names))
			group)
		    (cons (car nums) (gnus-last-element nums))
		    gnus-cache-active-hashtb))
    ;; Go through all the other files.
    (dolist (file alphs)
      (when (and (file-directory-p file)
		 (not (string-match "^\\."
				    (file-name-nondirectory file))))
	;; We descend directories.
	(gnus-cache-generate-active file)))
    ;; Write the new active file.
    (when top
      (gnus-cache-write-active t)
      (gnus-message 5 "Generating the cache active file...done"))))

  "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))

  (setq gnus-cache-total-fetched-hashtb nil)

  (gnus-cache-open))

(defun gnus-cache-move-cache (dir)
  "Move the cache tree to somewhere else."
  (interactive "FMove the cache tree to: ")

Always updates the cache, even when disabled, as the old cache
files would corrupt Gnus when the cache was next enabled.  It
depends on the caller to determine whether group renaming is
supported."
  (let ((old-dir (gnus-cache-file-name old-group ""))
	(new-dir (gnus-cache-file-name new-group ""))
	(file-name-coding-system nnmail-pathname-coding-system))
    (gnus-rename-file old-dir new-dir t))

  (gnus-cache-rename-group-total-fetched-for old-group new-group)

  (let ((no-save gnus-cache-active-hashtb))
    (unless gnus-cache-active-hashtb
      (gnus-cache-read-active))
    (let* ((old-group-hash-value

  "Delete GROUP from the cache.
Always updates the cache, even when disabled, as the old cache
files would corrupt gnus when the cache was next enabled.
Depends upon the caller to determine whether group deletion is
supported."
  (let ((dir (gnus-cache-file-name group ""))
	(file-name-coding-system nnmail-pathname-coding-system))
    (gnus-delete-directory dir))

  (gnus-cache-delete-group-total-fetched-for group)

  (let ((no-save gnus-cache-active-hashtb))
    (unless gnus-cache-active-hashtb
      (gnus-cache-read-active))
    (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb)))

      (if no-save
	  (setq gnus-cache-active-altered group-hash-value)
	(gnus-cache-write-active group-hash-value)))))

(defvar gnus-cache-inhibit-update-total-fetched-for nil)
(defvar gnus-cache-need-update-total-fetched-for nil)

(defmacro gnus-cache-with-refreshed-group (group &rest body)
  `(prog1 (let ((gnus-cache-inhibit-update-total-fetched-for t))
	    ,@body)
     (when (and gnus-cache-need-update-total-fetched-for
		(not gnus-cache-inhibit-update-total-fetched-for))
	(save-excursion
	  (set-buffer gnus-group-buffer)
	  (setq gnus-cache-need-update-total-fetched-for nil)
	  (gnus-group-update-group ,group t)))))

(defun gnus-cache-update-file-total-fetched-for (group file &optional subtract)
  (when gnus-cache-total-fetched-hashtb
    (gnus-cache-with-refreshed-group
     group
     (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
		       (gnus-sethash group (make-vector 2 0)
				     gnus-cache-total-fetched-hashtb)))
	    size)

       (if file
	   (setq size (or (nth 7 (file-attributes file)) 0))
	 (let* ((file-name-coding-system nnmail-pathname-coding-system)
		(files (directory-files (gnus-cache-file-name group "")
					t nil t))
		file attrs)
	   (setq size 0.0)
	   (while (setq file (pop files))
	     (setq attrs (file-attributes file))
	     (unless (nth 0 attrs)
	       (incf size (float (nth 7 attrs)))))))	     

       (setq gnus-cache-need-update-total-fetched-for t)

       (incf (nth 1 entry) (if subtract (- size) size))))))

(defun gnus-cache-update-overview-total-fetched-for (group file)
  (when gnus-cache-total-fetched-hashtb
    (gnus-cache-with-refreshed-group
     group
     (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
		       (gnus-sethash group (make-list 2 0) 
				     gnus-cache-total-fetched-hashtb)))
	    (file-name-coding-system nnmail-pathname-coding-system)
	    (size (or (nth 7 (file-attributes 
			      (or file
				  (gnus-cache-file-name group ".overview"))))
		      0)))
       (setq gnus-cache-need-update-total-fetched-for t)
       (setf (nth 0 entry) size)))))

(defun gnus-cache-rename-group-total-fetched-for (old-group new-group)
  "Record of disk space used by OLD-GROUP now associated with NEW-GROUP."
  (when gnus-cache-total-fetched-hashtb
    (let ((entry (gnus-gethash old-group gnus-cache-total-fetched-hashtb)))
      (gnus-sethash new-group entry gnus-cache-total-fetched-hashtb)
      (gnus-sethash old-group nil gnus-cache-total-fetched-hashtb))))

(defun gnus-cache-delete-group-total-fetched-for (group)
  "Delete record of disk space used by GROUP being deleted."
  (when gnus-cache-total-fetched-hashtb
      (gnus-sethash group nil gnus-cache-total-fetched-hashtb)))

(defun gnus-cache-total-fetched-for (group &optional no-inhibit)
  "Get total disk space used by the cache for the specified GROUP."
  (unless (equal group "dummy.group")
    (unless gnus-cache-total-fetched-hashtb
      (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024)))

    (let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb)))
      (if entry
	  (apply '+ entry)
	(let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit)))
	  (+ 
	   (gnus-cache-update-overview-total-fetched-for group nil)
	   (gnus-cache-update-file-total-fetched-for     group nil)))))))

(provide 'gnus-cache)

;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
;;; gnus-cache.el ends here