comparison lisp/gnus/gnus-cache.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; gnus-cache.el --- cache interface for Gnus
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
;;        Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; Keywords: news

;; This file is part of GNU Emacs.

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; Code:

(require 'gnus)
(require 'gnus-int)
(require 'gnus-range)
(require 'gnus-start)
(eval-when-compile
  (require 'gnus-sum))

(defcustom gnus-cache-active-file
  (expand-file-name "active" gnus-cache-directory)
  "*The cache active file."

  (when gnus-cache-buffer
    (let ((buffer (cdr gnus-cache-buffer))
	  (overview-file (gnus-cache-file-name
			  (car gnus-cache-buffer) ".overview")))
      ;; write the overview only if it was modified
      (when (buffer-modified-p buffer)
	(save-excursion
	  (set-buffer buffer)
	  (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))

	  (setq group (car result)
		number (cdr result))))
      (when (and number
		 (> number 0)		; Reffed article.
		 (or force
                     (and (or (not gnus-cacheable-groups)
                              (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))
	      (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)
	      (push article gnus-newsgroup-cached)
	      (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)
    (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
				(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)
	    (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)

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

  (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

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

	(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) ?/))
	  (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))
			 (progn (forward-line 1) (point)))))
      (setq gnus-newsgroup-cached
	    (delq article gnus-newsgroup-cached))
      (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-int name))
			  (directory-files dir nil "^[0-9]+$" t))
		  '<))
      ;; Update the cache active file, just to synch more.
      (when articles
	(gnus-cache-update-active group (car articles) t)
	(gnus-cache-update-active group (car (last articles))))
      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)
	(if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
			    nil t)
	    (setq beg (progn (beginning-of-line) (point))
		  end (progn (end-of-line) (point)))
	  (setq beg nil)))
      (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)
	(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 "."))
      (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-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)))
    ;; 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)))
    ;; 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))

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

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

(provide 'gnus-cache)

;;; gnus-cache.el ends here

88155:d7ddb3e565de

;;; gnus-cache.el --- cache interface for Gnus

;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
;;   2004, 2005 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; Keywords: news

;; This file is part of GNU Emacs.

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(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."

  (when gnus-cache-buffer
    (let ((buffer (cdr gnus-cache-buffer))
	  (overview-file (gnus-cache-file-name
			  (car gnus-cache-buffer) ".overview")))
      ;; write the overview only if it was modified
      (when (and (buffer-live-p buffer) (buffer-modified-p buffer))
	(with-current-buffer buffer
	  (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))

	  (setq group (car result)
		number (cdr result))))
      (when (and number
		 (> number 0)		; Reffed article.
		 (or force
		     (and (gnus-cache-fully-p 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))
	      (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-possibly-update-active group (cons number number))
	      (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."
  (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-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))

      (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 (&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 ((gnus-verbose (max 6 gnus-verbose)))
    (if (not gnus-newsgroup-cached)
	(gnus-message 3 "No cached articles for this group")
      (gnus-summary-goto-subjects gnus-newsgroup-cached))))

(defun gnus-summary-limit-include-cached ()
  "Limit the summary buffer to articles that are cached."
  (interactive)
  (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

      (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

	(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)
		  (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))
	  (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))
		  '<))
      ;; Update the cache active file, just to synch more.
      (if articles
	  (progn
	    (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)
      (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)
	(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)
      (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

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

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

;;;###autoload
(defun gnus-cache-rename-group (old-group new-group)
  "Rename OLD-GROUP as NEW-GROUP.
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
	    (gnus-gethash old-group gnus-cache-active-hashtb))
	   (new-group-hash-value
	    (gnus-gethash new-group gnus-cache-active-hashtb))
	   (delta
	    (or old-group-hash-value new-group-hash-value)))
      (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb)
      (gnus-sethash old-group nil gnus-cache-active-hashtb)

      (if no-save
	  (setq gnus-cache-active-altered delta)
	(gnus-cache-write-active delta)))))

;;;###autoload
(defun gnus-cache-delete-group (group)
  "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)))
      (gnus-sethash group nil 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