X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-async.el;h=65189573da3f479d88267ce14aa78d727b41f68a;hb=76aee12382f9d631bd1a1c51db62be5318e55881;hp=755d55c3f33457d0bcc54587ec3d1b31e433ac35;hpb=a629ef97108075cbae0b8b69b2dd1a4723a520c8;p=gnus

diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el
index 755d55c3f..65189573d 100644
--- a/lisp/gnus-async.el
+++ b/lisp/gnus-async.el
@@ -1,14 +1,16 @@
 ;;; gnus-async.el --- asynchronous support for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -18,8 +20,8 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -35,12 +37,6 @@
   "Support for asynchronous operations."
   :group 'gnus)
 
-(defcustom gnus-asynchronous t
-  "*If nil, inhibit all Gnus asynchronicity.
-If non-nil, let the other asynch variables be heeded."
-  :group 'gnus-asynchronous
-  :type 'boolean)
-
 (defcustom gnus-use-article-prefetch 30
   "*If non-nil, prefetch articles in groups that allow this.
 If a number, prefetch only that many articles forward;
@@ -50,8 +46,14 @@ if t, prefetch as many articles as possible."
 		 (const :tag "all" t)
 		 (integer :tag "some" 0)))
 
+(defcustom gnus-asynchronous nil
+  "*If nil, inhibit all Gnus asynchronicity.
+If non-nil, let the other asynch variables be heeded."
+  :group 'gnus-asynchronous
+  :type 'boolean)
+
 (defcustom gnus-prefetched-article-deletion-strategy '(read exit)
-  "*List of symbols that say when to remove articles from the prefetch buffer.
+  "List of symbols that say when to remove articles from the prefetch buffer.
 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
@@ -65,7 +67,7 @@ from that group."
   :type 'boolean)
 
 (defcustom gnus-async-prefetch-article-p 'gnus-async-unread-p
-  "*Function called to say whether an article should be prefetched or not.
+  "Function called to say whether an article should be prefetched or not.
 The function is called with one parameter -- the article data.
 It should return non-nil if the article is to be prefetched."
   :group 'gnus-asynchronous
@@ -77,7 +79,10 @@ It should return non-nil if the article is to be prefetched."
 (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-hashtb nil)
+(defvar gnus-async-current-prefetch-group nil)
+(defvar gnus-async-current-prefetch-article nil)
+(defvar gnus-async-timer nil)
 
 (defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
 (defvar gnus-async-header-prefetched nil)
@@ -106,8 +111,8 @@ It should return non-nil if the article is to be prefetched."
 	 ,@forms)
      (gnus-async-release-semaphore 'gnus-async-article-semaphore)))
 
-(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
-(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
+(put 'gnus-async-with-semaphore 'lisp-indent-function 0)
+(put 'gnus-async-with-semaphore 'edebug-form-spec '(body))
 
 ;;;
 ;;; Article prefetch
@@ -117,14 +122,14 @@ It should return non-nil if the article is to be prefetched."
 (defun gnus-async-close ()
   (gnus-kill-buffer gnus-async-prefetch-article-buffer)
   (gnus-kill-buffer gnus-async-prefetch-headers-buffer)
-  (setq gnus-async-article-alist nil
+  (setq gnus-async-hashtb nil
+	gnus-async-article-alist nil
 	gnus-async-header-prefetched nil))
 
 (defun gnus-async-set-buffer ()
   (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))))
+  (unless gnus-async-hashtb
+    (setq gnus-async-hashtb (gnus-make-hashtable 1023))))
 
 (defun gnus-async-halt-prefetch ()
   "Stop prefetching."
@@ -144,49 +149,54 @@ It should return non-nil if the article is to be prefetched."
 	      ;; do this, which leads to slightly slower article
 	      ;; buffer display.
 	      (gnus-async-prefetch-article group next summary)
-	    (run-with-idle-timer
-	     0.1 nil 'gnus-async-prefetch-article group next summary)))))))
+	    (when gnus-async-timer
+	      (ignore-errors
+		(nnheader-cancel-timer 'gnus-async-timer)))
+	    (setq gnus-async-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)
   "Possibly prefetch several articles starting with ARTICLE."
   (if (not (gnus-buffer-live-p summary))
       (gnus-async-with-semaphore
-       (setq gnus-async-fetch-list nil))
+	(setq gnus-async-fetch-list nil))
     (when (and gnus-asynchronous
 	       (gnus-alive-p))
       (when next
 	(gnus-async-with-semaphore
-	 (pop gnus-async-fetch-list)))
+	  (pop gnus-async-fetch-list)))
       (let ((do-fetch next)
-	    (do-message t)) ;(eq major-mode 'gnus-summary-mode)))
+	    (do-message t))		;(eq major-mode 'gnus-summary-mode)))
 	(when (and (gnus-group-asynchronous-p group)
 		   (gnus-buffer-live-p summary)
 		   (or (not next)
 		       gnus-async-fetch-list))
 	  (gnus-async-with-semaphore
-	   (unless next
-	     (setq do-fetch (not gnus-async-fetch-list))
-	     ;; Nix out any outstanding requests.
-	     (setq gnus-async-fetch-list nil)
-	     ;; Fill in the new list.
-	     (let ((n gnus-use-article-prefetch)
-		   (data (gnus-data-find-list article))
-		   d)
-	       (while (and (setq d (pop data))
-			   (if (numberp n)
-			       (natnump (decf n))
-			     n))
-		 (unless (or (gnus-async-prefetched-article-entry
-			      group (setq article (gnus-data-number d)))
-			     (not (natnump article))
-			     (not (funcall gnus-async-prefetch-article-p d)))
-		   ;; Not already fetched -- so we add it to the list.
-		   (push article gnus-async-fetch-list)))
-	       (setq gnus-async-fetch-list
-		     (nreverse gnus-async-fetch-list))))
-
-	   (when do-fetch
-	     (setq article (car gnus-async-fetch-list))))
+	    (unless next
+	      (setq do-fetch (not gnus-async-fetch-list))
+	      ;; Nix out any outstanding requests.
+	      (setq gnus-async-fetch-list nil)
+	      ;; Fill in the new list.
+	      (let ((n gnus-use-article-prefetch)
+		    (data (gnus-data-find-list article))
+		    d)
+		(while (and (setq d (pop data))
+			    (if (numberp n)
+				(natnump (decf n))
+			      n))
+		  (unless (or (gnus-async-prefetched-article-entry
+			       group (setq article (gnus-data-number d)))
+			      (not (natnump article))
+			      (not (funcall gnus-async-prefetch-article-p d)))
+		    ;; Not already fetched -- so we add it to the list.
+		    (push article gnus-async-fetch-list)))
+		(setq gnus-async-fetch-list
+		      (nreverse gnus-async-fetch-list))))
+
+	    (when do-fetch
+	      (setq article (car gnus-async-fetch-list))))
 
 	  (when (and do-fetch article)
 	    ;; We want to fetch some more articles.
@@ -204,24 +214,33 @@ It should return non-nil if the article is to be prefetched."
 		  (when do-message
 		    (gnus-message 9 "Prefetching article %d in group %s"
 				  article group))
+		  (setq gnus-async-current-prefetch-group group)
+		  (setq gnus-async-current-prefetch-article article)
 		  (gnus-request-article article group))))))))))
 
 (defun gnus-make-async-article-function (group article mark summary next)
   "Return a callback function."
   `(lambda (arg)
-     (save-excursion
-       (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))
-	 (gnus-async-prefetch-article ,group ,next ,summary t)))))
+     (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next)))
+
+(defun gnus-async-article-callback (arg group article mark summary next)
+  "Function called when an async article is done being fetched."
+  (save-excursion
+    (setq gnus-async-current-prefetch-article nil)
+    (when arg
+      (gnus-async-set-buffer)
+      (gnus-async-with-semaphore
+	(setq
+	 gnus-async-article-alist
+	 (cons (list (intern (format "%s-%d" group article)
+			     gnus-async-hashtb)
+		     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))
+      (gnus-async-prefetch-article group next summary t))))
 
 (defun gnus-async-unread-p (data)
   "Return non-nil if DATA represents an unread article."
@@ -230,6 +249,9 @@ It should return non-nil if the article is to be prefetched."
 (defun gnus-async-request-fetched-article (group article buffer)
   "See whether we have ARTICLE from GROUP and put it in BUFFER."
   (when (numberp article)
+    (when (and (equal group gnus-async-current-prefetch-group)
+	       (eq article gnus-async-current-prefetch-article))
+      (gnus-async-wait-for-article article))
     (let ((entry (gnus-async-prefetched-article-entry group article)))
       (when entry
 	(save-excursion
@@ -237,37 +259,67 @@ It should return non-nil if the article is to be prefetched."
 	  (copy-to-buffer buffer (cadr entry) (caddr entry))
 	  ;; Remove the read article from the prefetch buffer.
 	  (when (memq 'read gnus-prefetched-article-deletion-strategy)
-	    (gnus-async-delete-prefected-entry entry))
+	    (gnus-async-delete-prefetched-entry entry))
 	  t)))))
 
-(defun gnus-async-delete-prefected-entry (entry)
+(defun gnus-async-wait-for-article (article)
+  "Wait until ARTICLE is no longer the currently-being-fetched article."
+  (save-excursion
+    (gnus-async-set-buffer)
+    (let ((proc (nntp-find-connection (current-buffer)))
+	  (nntp-server-buffer (current-buffer))
+	  (nntp-have-messaged nil)
+	  (tries 0))
+      (when proc
+	(condition-case nil
+	    ;; FIXME: we could stop waiting after some
+	    ;; timeout, but this is the wrong place to do it.
+	    ;; rather than checking time-spent-waiting, we
+	    ;; should check time-since-last-output, which
+	    ;; needs to be done in nntp.el.
+	    (while (eq article gnus-async-current-prefetch-article)
+	      (incf tries)
+	      (when (nntp-accept-process-output proc)
+		(setq tries 0))
+	      (when (and (not nntp-have-messaged)
+			 (= tries 3))
+		(gnus-message 5 "Waiting for async article...")
+		(setq nntp-have-messaged t)))
+	  (quit
+	   ;; if the user interrupted on a slow/hung connection,
+	   ;; do something friendly.
+	   (when (> tries 3)
+	     (setq gnus-async-current-prefetch-article nil))
+	   (signal 'quit nil)))
+	(when nntp-have-messaged
+	  (gnus-message 5 ""))))))
+
+(defun gnus-async-delete-prefetched-entry (entry)
   "Delete ENTRY from buffer and alist."
   (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
-	 (delq entry gnus-async-article-alist))))
+    (setq gnus-async-article-alist
+	  (delq entry gnus-async-article-alist))))
 
 (defun gnus-async-prefetch-remove-group (group)
   "Remove all articles belonging to GROUP from the prefetch buffer."
   (when (and (gnus-group-asynchronous-p group)
 	     (memq 'exit gnus-prefetched-article-deletion-strategy))
-    (let ((alist gnus-async-article-alist))
-      (save-excursion
-	(gnus-async-set-buffer)
-	(while alist
-	  (when (equal group (nth 3 (car alist)))
-	    (gnus-async-delete-prefected-entry (car alist)))
-	  (pop alist))))))
+    (save-excursion
+      (gnus-async-set-buffer)
+      (dolist (entry gnus-async-article-alist)
+	(when (equal group (nth 3 entry))
+	  (gnus-async-delete-prefetched-entry entry))))))
 
 (defun gnus-async-prefetched-article-entry (group article)
-  "Return the entry for ARTICLE in GROUP iff it has been prefetched."
+  "Return the entry for ARTICLE in GROUP if it has been prefetched."
   (let ((entry (save-excursion
 		 (gnus-async-set-buffer)
 		 (assq (intern (format "%s-%d" group article)
-			       gnus-asynch-obarray)
+			       gnus-async-hashtb)
 		       gnus-async-article-alist))))
     ;; Perhaps something has emptied the buffer?
     (if (and entry
@@ -322,4 +374,5 @@ It should return non-nil if the article is to be prefetched."
 
 (provide 'gnus-async)
 
+;;; arch-tag: fee61de5-3ea2-4de6-8578-2f90ce89391d
 ;;; gnus-async.el ends here