diff options
Diffstat (limited to 'lisp/gnus/gnus-cache.el')
| -rw-r--r-- | lisp/gnus/gnus-cache.el | 144 |
1 files changed, 106 insertions, 38 deletions
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 9423d9f2f6b..5ed731947bc 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -1,4 +1,4 @@ -;;; gnus-cache.el --- cache interface for Gnus +;;; gnus-cache.el --- cache interface for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -29,9 +29,7 @@ (require 'gnus) (require 'gnus-sum) -(eval-when-compile - (unless (fboundp 'gnus-agent-load-alist) - (defun gnus-agent-load-alist (group)))) +(declare-function gnus-agent-load-alist "gnus-agent" (group)) (defcustom gnus-cache-active-file (expand-file-name "active" gnus-cache-directory) @@ -55,7 +53,7 @@ If you only want to cache your nntp groups, you could set this variable to \"^nntp\". -If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups +If a group matches both `gnus-cacheable-groups' and `gnus-uncacheable-groups' it's not cached." :group 'gnus-cache :type '(choice (const :tag "off" nil) @@ -150,6 +148,8 @@ it's not cached." (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) +(defvar gnus-article-decode-hook) + (defun gnus-cache-possibly-enter-article (group article ticked dormant unread &optional force) (when (and (or force (not (eq gnus-use-cache 'passive))) @@ -294,47 +294,49 @@ it's not cached." (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))) - (gnus-newsgroup-name group) - (gnus-fetch-old-headers fetch-old)) + (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)) + (gnus-retrieve-headers articles group fetch-old)) (let ((uncached-articles (gnus-sorted-difference articles cached)) (cache-file (gnus-cache-file-name group ".overview")) - (file-name-coding-system nnmail-pathname-coding-system) - headers) + 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 headers (and articles - (gnus-fetch-headers uncached-articles))))) + (setq type (and articles + (gnus-retrieve-headers + uncached-articles group fetch-old))))) (gnus-cache-save-buffers) - ;; Then we include the cached headers. - (when (file-exists-p cache-file) - (setq headers - (delete-dups - (sort - (append headers - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (insert-file-contents cache-file) - (gnus-get-newsgroup-headers-xover - (gnus-sorted-difference - cached uncached-articles) - nil (buffer-local-value - 'gnus-newsgroup-dependencies - gnus-summary-buffer) - group)))) - (lambda (l r) - (< (mail-header-number l) - (mail-header-number r))))))) - headers)))) + ;; 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) + (let ((coding-system-for-read + gnus-cache-overview-coding-system)) + (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. @@ -516,7 +518,7 @@ Returns the list of articles removed." (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 @@ -527,6 +529,70 @@ Returns the list of articles removed." (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) + (gnus-cache-save-buffers) + (with-current-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))) + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (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 (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))) + +(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 (pop 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. @@ -648,7 +714,7 @@ If LOW, update the lower bound instead." (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 '<)) + (when (setq nums (sort nums #'<)) (puthash group (cons (car nums) (car (last nums))) gnus-cache-active-hashtb)) @@ -664,6 +730,8 @@ If LOW, update the lower bound instead." (gnus-cache-write-active t) (gnus-message 5 "Generating the cache active file...done")))) +(defvar nnml-generate-active-function) + ;;;###autoload (defun gnus-cache-generate-nov-databases (dir) "Generate NOV files recursively starting in DIR." @@ -818,7 +886,7 @@ supported." (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1000))) (let* ((entry (gethash group gnus-cache-total-fetched-hashtb))) (if entry - (apply '+ entry) + (apply #'+ entry) (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) (+ (gnus-cache-update-overview-total-fetched-for group nil) |