cgit.sxemacs.org Git - gnus/blob - lisp/gnus-async.el

   1 ;;; gnus-async.el --- asynchronous support for Gnus
   2 ;; Copyright (C) 1996 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'gnus-load)
  29 (require 'gnus-sum)
  30 (require 'nntp)
  31
  32 (defvar gnus-use-article-prefetch 30
  33   "*If non-nil, prefetch articles in groups that allow this.
  34 If a number, prefetch only that many articles forward;
  35 if t, prefetch as many articles as possible.")
  36
  37 (defvar gnus-prefetched-article-deletion-strategy '(read exit)
  38   "List of symbols that say when to remove articles from the prefetch buffer.
  39 Possible values in this list are `read', which means that
  40 articles are removed as they are read, and `exit', which means
  41 that all articles belonging to a group are removed on exit
  42 from that group.")
  43
  44 ;;; Internal variables.
  45
  46 (defvar gnus-async-article-alist nil)
  47
  48 (defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*")
  49
  50 ;;; Utility functions.
  51
  52 (defun gnus-group-asynchronous-p (group)
  53   "Say whether GROUP is fetched from a server that supports asynchronocity."
  54   (gnus-asynchronous-p (gnus-find-method-for-group group)))
  55
  56 ;;; Article prefetch
  57
  58 (gnus-add-shutdown 'gnus-async-close 'gnus)
  59 (defun gnus-async-close ()
  60   (gnus-kill-buffer gnus-async-prefetch-article-buffer)
  61   (setq gnus-async-article-alist nil))
  62
  63 (defun gnus-async-set-prefetch-buffer ()
  64   (if (get-buffer gnus-async-prefetch-article-buffer)
  65       (set-buffer gnus-async-prefetch-article-buffer)
  66     (set-buffer (get-buffer-create gnus-async-prefetch-article-buffer))
  67     (buffer-disable-undo (current-buffer))
  68     (gnus-add-current-to-buffer-list)))
  69
  70 (defun gnus-async-prefetch-next (group article summary)
  71   "Possibly prefetch several articles starting with the article after ARTICLE."
  72   (let ((next (caadr (gnus-data-find-list article))))
  73     (when next
  74       (gnus-async-prefetch-article group next summary))))
  75
  76 (defun gnus-async-prefetch-article (group article summary &optional number)
  77   "Possibly prefetch several articles starting with ARTICLE."
  78   (unless number
  79     (setq number gnus-use-article-prefetch))
  80   (when (and number
  81              (or (not (numberp number))
  82                  (> number 0))
  83              (gnus-group-asynchronous-p group)
  84              (gnus-buffer-live-p summary))
  85     (when (numberp number)
  86       (decf number))
  87     (while (and article (gnus-async-prefetched-article-entry group article))
  88       (setq article (caadr (gnus-data-find-list article)))
  89       (when (numberp number)
  90         (decf number)))
  91     (when article
  92       ;; We want to fetch some more articles.
  93       (save-excursion
  94         (set-buffer summary)
  95         (let ((next (caadr (gnus-data-find-list article)))
  96               mark)
  97           (gnus-async-set-prefetch-buffer)
  98           (goto-char (point-max))
  99           (setq mark (point-marker))
 100           (let ((nnheader-callback-function
 101                  `(lambda (arg)
 102                     (save-excursion
 103                       (gnus-async-set-prefetch-buffer)
 104                       (push (list ',(intern (format "%s-%d" group article))
 105                                   ,mark (set-marker (make-marker) (point-max))
 106                                   ,group ,article)
 107                             gnus-async-article-alist)
 108                       (when (gnus-buffer-live-p ,summary)
 109                         ,(when next
 110                            `(gnus-async-prefetch-article
 111                              ,group ,next ,summary ,number))))))
 112                 (nntp-server-buffer (get-buffer
 113                                      gnus-async-prefetch-article-buffer)))
 114             (gnus-message 7 "Prefetching article %d in group %s"
 115                           article group)
 116             (gnus-request-article article group)))))))
 117
 118 (defun gnus-async-request-fetched-article (group article buffer)
 119   "See whether we have ARTICLE from GROUP and put it in BUFFER."
 120   (let ((entry (gnus-async-prefetched-article-entry group article)))
 121     (when entry
 122       (save-excursion
 123         (gnus-async-set-prefetch-buffer)
 124         (copy-to-buffer buffer (cadr entry) (caddr entry))
 125         ;; Remove the read article from the prefetch buffer.
 126         (when (memq 'read gnus-prefetched-article-deletion-strategy)
 127           (gnus-asynch-delete-prefected-entry entry))
 128         ;; Decode the article.  Perhaps this shouldn't be done
 129         ;; here?
 130         (set-buffer buffer)
 131         (nntp-decode-text)
 132         (goto-char (point-min))
 133         (gnus-delete-line)
 134         t))))
 135
 136 (defun gnus-asynch-delete-prefected-entry (entry)
 137   "Delete ENTRY from buffer and alist."
 138   (delete-region (cadr entry) (caddr entry))
 139   (set-marker (cadr entry) nil)
 140   (set-marker (caddr entry) nil)
 141   (setq gnus-async-article-alist
 142         (delq entry gnus-async-article-alist)))
 143
 144 (defun gnus-async-prefetch-remove-group (group)
 145   "Remove all articles belonging to GROUP from the prefetch buffer."
 146   (when (and (gnus-group-asynchronous-p group)
 147              (memq 'exit gnus-prefetched-article-deletion-strategy))
 148     (let ((alist gnus-async-article-alist))
 149       (save-excursion
 150         (gnus-async-set-prefetch-buffer)
 151         (while alist
 152           (when (equal group (nth 3 (car alist)))
 153             (gnus-asynch-delete-prefected-entry (car alist)))
 154           (pop alist))))))
 155
 156 (defun gnus-async-prefetched-article-entry (group article)
 157   "Return the entry for ARTICLE in GROUP iff it has been prefetched."
 158   (assq (intern (format "%s-%d" group article))
 159         gnus-async-article-alist))
 160
 161 (provide 'gnus-async)
 162
 163 ;;; gnus-async.el ends here