;;; gnus-async.el --- asynchronous support for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
;;; Code:
-(require 'gnus-load)
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
(require 'gnus-sum)
(require 'nntp)
(defcustom gnus-prefetched-article-deletion-strategy '(read exit)
"List of symbols that say when to remove articles from the prefetch buffer.
-Possible values in this list are `read', which means that
+Possible values in this list are `read', which means that
articles are removed as they are read, and `exit', which means
that all articles belonging to a group are removed on exit
from that group."
(defvar gnus-async-article-alist nil)
(defvar gnus-async-article-semaphore '(nil))
(defvar gnus-async-fetch-list nil)
+(defvar gnus-asynch-obarray nil)
(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
(defvar gnus-async-header-prefetched nil)
(gnus-async-release-semaphore 'gnus-async-article-semaphore)))
(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
-(put 'gnus-asynch-with-semaphore 'lisp-indent-hook 0)
(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
-
+
;;;
;;; Article prefetch
;;;
gnus-async-header-prefetched nil))
(defun gnus-async-set-buffer ()
- (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t))
+ (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
+ (unless gnus-asynch-obarray
+ (set (make-local-variable 'gnus-asynch-obarray)
+ (gnus-make-hashtable 1023))))
+
+(defun gnus-async-halt-prefetch ()
+ "Stop prefetching."
+ (setq gnus-async-fetch-list nil))
(defun gnus-async-prefetch-next (group article summary)
"Possibly prefetch several articles starting with the article after ARTICLE."
;; do this, which leads to slightly slower article
;; buffer display.
(gnus-async-prefetch-article group next summary)
- (run-with-idle-timer
+ (run-with-idle-timer
0.1 nil 'gnus-async-prefetch-article group next summary)))))))
(defun gnus-async-prefetch-article (group article summary &optional next)
(when next
(gnus-async-with-semaphore
(pop gnus-async-fetch-list)))
- (let ((do-fetch next))
+ (let ((do-fetch next)
+ (do-message t)) ;(eq major-mode 'gnus-summary-mode)))
(when (and (gnus-group-asynchronous-p group)
(gnus-buffer-live-p summary)
(or (not next)
(when do-fetch
(setq article (car gnus-async-fetch-list))))
-
+
(when (and do-fetch article)
;; We want to fetch some more articles.
(save-excursion
(goto-char (point-max))
(setq mark (point-marker))
(let ((nnheader-callback-function
- (gnus-make-async-article-function
+ (gnus-make-async-article-function
group article mark summary next))
- (nntp-server-buffer
+ (nntp-server-buffer
(get-buffer gnus-async-prefetch-article-buffer)))
- (gnus-message 7 "Prefetching article %d in group %s"
- article group)
+ (when do-message
+ (gnus-message 9 "Prefetching article %d in group %s"
+ article group))
(gnus-request-article article group))))))))))
(defun gnus-make-async-article-function (group article mark summary next)
"Return a callback function."
`(lambda (arg)
(save-excursion
- (gnus-async-set-buffer)
- (gnus-async-with-semaphore
- (push (list ',(intern (format "%s-%d" group article))
- ,mark (set-marker (make-marker)
- (point-max))
- ,group ,article)
- gnus-async-article-alist))
+ (when arg
+ (gnus-async-set-buffer)
+ (gnus-async-with-semaphore
+ (push (list ',(intern (format "%s-%d" group article)
+ gnus-asynch-obarray)
+ ,mark (set-marker (make-marker) (point-max))
+ ,group ,article)
+ gnus-async-article-alist)))
(if (not (gnus-buffer-live-p ,summary))
(gnus-async-with-semaphore
(setq gnus-async-fetch-list nil))
(defun gnus-async-delete-prefected-entry (entry)
"Delete ENTRY from buffer and alist."
- (delete-region (cadr entry) (caddr entry))
- (set-marker (cadr entry) nil)
- (set-marker (caddr entry) nil)
+ (ignore-errors
+ (delete-region (cadr entry) (caddr entry))
+ (set-marker (cadr entry) nil)
+ (set-marker (caddr entry) nil))
(gnus-async-with-semaphore
- (setq gnus-async-article-alist
+ (setq gnus-async-article-alist
(delq entry gnus-async-article-alist))))
(defun gnus-async-prefetch-remove-group (group)
(when (equal group (nth 3 (car alist)))
(gnus-async-delete-prefected-entry (car alist)))
(pop alist))))))
-
+
(defun gnus-async-prefetched-article-entry (group article)
"Return the entry for ARTICLE in GROUP iff it has been prefetched."
- (assq (intern (format "%s-%d" group article))
- gnus-async-article-alist))
+ (let ((entry (save-excursion
+ (gnus-async-set-buffer)
+ (assq (intern (format "%s-%d" group article)
+ gnus-asynch-obarray)
+ gnus-async-article-alist))))
+ ;; Perhaps something has emptied the buffer?
+ (if (and entry
+ (= (cadr entry) (caddr entry)))
+ (progn
+ (ignore-errors
+ (set-marker (cadr entry) nil)
+ (set-marker (caddr entry) nil))
+ (setq gnus-async-article-alist
+ (delq entry gnus-async-article-alist))
+ nil)
+ entry)))
;;;
;;; Header prefetch
(erase-buffer)
(setq gnus-async-header-prefetched nil)
t)))
-
+
(provide 'gnus-async)
;;; gnus-async.el ends here