\f
(defun gnus-cache-change-buffer (group)
- (save-excursion
- (cond ((null gnus-cache-buffer)
- ;; No current cache, so we create and init the buffer.
- (setq gnus-cache-buffer
- (cons group (get-buffer-create " *gnus-cache-overview*")))
- (set-buffer (cdr gnus-cache-buffer))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (gnus-add-current-to-buffer-list)
- (let ((file (gnus-cache-file-name group ".overview")))
- (and (file-exists-p file)
- (insert-file-contents file))))
- ((not (string= group (car gnus-cache-buffer)))
- ;; If a different overview cache is the current, we
- ;; (possibly) save it and change to this groups.
- (set-buffer (cdr gnus-cache-buffer))
- (and (buffer-modified-p)
- (write-region (point-min) (point-max)
- (gnus-cache-file-name
- (car gnus-cache-buffer) ".overview")
- nil 'quiet))
- (erase-buffer)
- (setcar gnus-cache-buffer group)
- (let ((file (gnus-cache-file-name group ".overview")))
- (and (file-exists-p file)
- (insert-file-contents file)))))))
+ (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
+ (or 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 groups cache overview
+ (erase-buffer)
+ (let ((file (gnus-cache-file-name group ".overview")))
+ (and (file-exists-p file)
+ (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))))
-;; Just save the overview buffer.
(defun gnus-cache-save-buffers ()
- (and gnus-cache-buffer
- (save-excursion
- (set-buffer (cdr gnus-cache-buffer))
- (and (buffer-modified-p)
- (write-region (point-min) (point-max)
- (gnus-cache-file-name (car gnus-cache-buffer)
- ".overview")
- nil 'quiet))))
- (setq gnus-cache-buffer nil))
+ ;; save the overview buffer if it exists and has been modified
+ ;; delete empty cache subdirectories
+ (if (null 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
+ (if (buffer-modified-p buffer)
+ (save-excursion
+ (set-buffer buffer)
+ (if (> (buffer-size) 0)
+ ;; non-empty overview, write it out
+ (gnus-make-directory (file-name-directory overview-file))
+ (write-region (point-min) (point-max)
+ overview-file nil 'quietly)
+ ;; empty overview file, remove it
+ (and (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))))
+
;; Return whether an article is a member of a class.
(defun gnus-cache-member-of-class (class ticked dormant unread)
(defun gnus-cache-file-name (group article)
(concat (file-name-as-directory gnus-cache-directory)
(if (gnus-use-long-file-name 'not-cache)
- group (gnus-replace-chars-in-string group ?. ?/))
+ group
+ (let ((group (concat group "")))
+ (if (string-match ":" group)
+ (aset group (match-beginning 0) ?/))
+ (gnus-replace-chars-in-string group ?. ?/)))
"/" (if (stringp article) article (int-to-string article))))
(defun gnus-cache-possibly-enter-article
(group article headers ticked dormant unread)
(let ((number (header-number headers))
file dir)
- (if (or (not (gnus-cache-member-of-class
+ (if (or (not (vectorp headers)) ; This might be a dummy article.
+ (not (gnus-cache-member-of-class
gnus-cache-enter-articles ticked dormant unread))
(file-exists-p (setq file (gnus-cache-file-name group article))))
- ()
- (gnus-summary-select-article)
+ () ; Do nothing.
+ ;; Possibly create the cache directory.
(or (file-exists-p (setq dir (file-name-directory file)))
(gnus-make-directory dir))
+ ;; Save the article in the cache.
(if (file-exists-p file)
- t
+ t ; The article already is saved, so we end here.
+ (gnus-summary-select-article)
(save-excursion
(set-buffer gnus-article-buffer)
- (write-region (point-min) (point-max) file nil 'quiet)
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) file nil 'quiet))
(gnus-cache-change-buffer group)
(set-buffer (cdr gnus-cache-buffer))
(goto-char (point-max))
(forward-line 1)))
(beginning-of-line))
(forward-line 1))
+ (beginning-of-line)
;; [number subject from date id references chars lines xref]
- (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n"
+ (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n"
(header-number headers)
(header-subject headers)
+ (header-from headers)
(header-date headers)
(header-id headers)
(or (header-references headers) "")
(or (header-xref headers) ""))))
t))))
-(defun gnus-cache-possibly-remove-article
- (group article ticked dormant unread)
- (let ((file (gnus-cache-file-name group article)))
+(defun gnus-cache-enter-remove-article (article)
+ (setq gnus-cache-removeable-articles
+ (cons article gnus-cache-removeable-articles)))
+
+(defsubst gnus-cache-possibly-remove-article
+ (article ticked dormant unread)
+ (let ((file (gnus-cache-file-name gnus-newsgroup-name article)))
(if (or (not (file-exists-p file))
(not (gnus-cache-member-of-class
gnus-cache-remove-articles ticked dormant unread)))
nil
(save-excursion
(delete-file file)
- (gnus-cache-change-buffer group)
(set-buffer (cdr gnus-cache-buffer))
(goto-char (point-min))
- (if (or (looking-at (concat (string-to-int article) "\t"))
- (search-forward (concat "\n" (string-to-int article) "\t")))
+ (if (or (looking-at (concat (int-to-string article) "\t"))
+ (search-forward (concat "\n" (int-to-string article) "\t")
+ (point-max) t))
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point))))))))
+(defun gnus-cache-possibly-remove-articles ()
+ (let ((articles gnus-cache-removeable-articles)
+ (cache-articles (gnus-cache-articles-in-group gnus-newsgroup-name))
+ article)
+ (gnus-cache-change-buffer gnus-newsgroup-name)
+ (while articles
+ (setq article (car articles)
+ articles (cdr articles))
+ (if (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)
+ (or (memq article gnus-newsgroup-unreads)
+ (memq article gnus-newsgroup-unselected))))))
+ ;; the overview file might have been modified, save it
+ ;; safe because we're only called at group exit anyway
+ (gnus-cache-save-buffers))
+
+
(defun gnus-cache-request-article (article group)
(let ((file (gnus-cache-file-name group article)))
(if (not (file-exists-p file))
(kill-buffer cache-buf)))
(defun gnus-cache-braid-heads (group cached)
- (let ((cache-buf (get-buffer-create " *gnus-cache*"))
- beg end)
+ (let ((cache-buf (get-buffer-create " *gnus-cache*")))
(save-excursion
(set-buffer cache-buf)
(buffer-disable-undo (current-buffer))
projects / gnus / blobdiff