Mercurial > emacs
annotate lisp/gnus/gnus-async.el @ 110662:07e31ac3910e
gnus-agent.el (gnus-agent-add-group): Fix call to gnus-completing-read.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Thu, 30 Sep 2010 10:25:45 +0000 |
parents | f2e111723c3a |
children | 42815c76b976 |
rev | line source |
---|---|
17493 | 1 ;;; gnus-async.el --- asynchronous support for Gnus |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
2 |
74547 | 3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
106815 | 4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
17493 | 5 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
22585
diff
changeset
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 7 ;; Keywords: news |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
17493 | 12 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
17493 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
17493 | 19 ;; GNU General Public License for more details. |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17493 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;;; Code: | |
27 | |
19521
6f6cf9184e93
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
28 (eval-when-compile (require 'cl)) |
6f6cf9184e93
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
29 |
17493 | 30 (require 'gnus) |
31 (require 'gnus-sum) | |
32 (require 'nntp) | |
33 | |
34 (defgroup gnus-asynchronous nil | |
35 "Support for asynchronous operations." | |
36 :group 'gnus) | |
37 | |
38 (defcustom gnus-use-article-prefetch 30 | |
39 "*If non-nil, prefetch articles in groups that allow this. | |
40 If a number, prefetch only that many articles forward; | |
41 if t, prefetch as many articles as possible." | |
42 :group 'gnus-asynchronous | |
43 :type '(choice (const :tag "off" nil) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
44 (const :tag "all" t) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
45 (integer :tag "some" 0))) |
17493 | 46 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
47 (defcustom gnus-asynchronous nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
48 "*If nil, inhibit all Gnus asynchronicity. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
49 If non-nil, let the other asynch variables be heeded." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
50 :group 'gnus-asynchronous |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
51 :type 'boolean) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
52 |
17493 | 53 (defcustom gnus-prefetched-article-deletion-strategy '(read exit) |
54 "List of symbols that say when to remove articles from the prefetch buffer. | |
55 Possible values in this list are `read', which means that | |
56 articles are removed as they are read, and `exit', which means | |
57 that all articles belonging to a group are removed on exit | |
58 from that group." | |
59 :group 'gnus-asynchronous | |
60 :type '(set (const read) (const exit))) | |
61 | |
62 (defcustom gnus-use-header-prefetch nil | |
63 "*If non-nil, prefetch the headers to the next group." | |
64 :group 'gnus-asynchronous | |
65 :type 'boolean) | |
66 | |
67 (defcustom gnus-async-prefetch-article-p 'gnus-async-unread-p | |
68 "Function called to say whether an article should be prefetched or not. | |
69 The function is called with one parameter -- the article data. | |
70 It should return non-nil if the article is to be prefetched." | |
71 :group 'gnus-asynchronous | |
72 :type 'function) | |
73 | |
110025
5f352fd4346a
Misc Gnus fixes by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
106815
diff
changeset
|
74 (defcustom gnus-async-post-fetch-function nil |
5f352fd4346a
Misc Gnus fixes by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
106815
diff
changeset
|
75 "Function called after an article has been prefetched. |
5f352fd4346a
Misc Gnus fixes by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
106815
diff
changeset
|
76 The function will be called narrowed to the region of the article |
5f352fd4346a
Misc Gnus fixes by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
106815
diff
changeset
|
77 that was fetched." |
5f352fd4346a
Misc Gnus fixes by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
106815
diff
changeset
|
78 :group 'gnus-asynchronous |
5f352fd4346a
Misc Gnus fixes by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
106815
diff
changeset
|
79 :type 'function) |
5f352fd4346a
Misc Gnus fixes by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
106815
diff
changeset
|
80 |
17493 | 81 ;;; Internal variables. |
82 | |
83 (defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") | |
84 (defvar gnus-async-article-alist nil) | |
85 (defvar gnus-async-article-semaphore '(nil)) | |
86 (defvar gnus-async-fetch-list nil) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
87 (defvar gnus-async-hashtb nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
88 (defvar gnus-async-current-prefetch-group nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
89 (defvar gnus-async-current-prefetch-article nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
90 (defvar gnus-async-timer nil) |
17493 | 91 |
92 (defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*") | |
93 (defvar gnus-async-header-prefetched nil) | |
94 | |
95 ;;; Utility functions. | |
96 | |
97 (defun gnus-group-asynchronous-p (group) | |
98 "Say whether GROUP is fetched from a server that supports asynchronicity." | |
99 (gnus-asynchronous-p (gnus-find-method-for-group group))) | |
100 | |
101 ;;; Somewhat bogus semaphores. | |
102 | |
103 (defun gnus-async-get-semaphore (semaphore) | |
104 "Wait until SEMAPHORE is released." | |
105 (while (/= (length (nconc (symbol-value semaphore) (list nil))) 2) | |
106 (sleep-for 1))) | |
107 | |
108 (defun gnus-async-release-semaphore (semaphore) | |
109 "Release SEMAPHORE." | |
110 (setcdr (symbol-value semaphore) nil)) | |
111 | |
112 (defmacro gnus-async-with-semaphore (&rest forms) | |
113 `(unwind-protect | |
114 (progn | |
115 (gnus-async-get-semaphore 'gnus-async-article-semaphore) | |
116 ,@forms) | |
117 (gnus-async-release-semaphore 'gnus-async-article-semaphore))) | |
118 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
119 (put 'gnus-async-with-semaphore 'lisp-indent-function 0) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
120 (put 'gnus-async-with-semaphore 'edebug-form-spec '(body)) |
17493 | 121 |
122 ;;; | |
123 ;;; Article prefetch | |
124 ;;; | |
125 | |
126 (gnus-add-shutdown 'gnus-async-close 'gnus) | |
127 (defun gnus-async-close () | |
128 (gnus-kill-buffer gnus-async-prefetch-article-buffer) | |
129 (gnus-kill-buffer gnus-async-prefetch-headers-buffer) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
130 (setq gnus-async-hashtb nil |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
131 gnus-async-article-alist nil |
17493 | 132 gnus-async-header-prefetched nil)) |
133 | |
134 (defun gnus-async-set-buffer () | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
22585
diff
changeset
|
135 (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
136 (unless gnus-async-hashtb |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
137 (setq gnus-async-hashtb (gnus-make-hashtable 1023)))) |
17493 | 138 |
139 (defun gnus-async-halt-prefetch () | |
140 "Stop prefetching." | |
141 (setq gnus-async-fetch-list nil)) | |
142 | |
143 (defun gnus-async-prefetch-next (group article summary) | |
144 "Possibly prefetch several articles starting with the article after ARTICLE." | |
145 (when (and (gnus-buffer-live-p summary) | |
146 gnus-asynchronous | |
147 (gnus-group-asynchronous-p group)) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110276
diff
changeset
|
148 (with-current-buffer gnus-summary-buffer |
17493 | 149 (let ((next (caadr (gnus-data-find-list article)))) |
150 (when next | |
151 (if (not (fboundp 'run-with-idle-timer)) | |
152 ;; This is either an older Emacs or XEmacs, so we | |
153 ;; do this, which leads to slightly slower article | |
154 ;; buffer display. | |
155 (gnus-async-prefetch-article group next summary) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
156 (when gnus-async-timer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
157 (ignore-errors |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
158 (nnheader-cancel-timer 'gnus-async-timer))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
159 (setq gnus-async-timer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
160 (run-with-idle-timer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
161 0.1 nil 'gnus-async-prefetch-article |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
162 group next summary)))))))) |
17493 | 163 |
164 (defun gnus-async-prefetch-article (group article summary &optional next) | |
165 "Possibly prefetch several articles starting with ARTICLE." | |
166 (if (not (gnus-buffer-live-p summary)) | |
167 (gnus-async-with-semaphore | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
168 (setq gnus-async-fetch-list nil)) |
17493 | 169 (when (and gnus-asynchronous |
170 (gnus-alive-p)) | |
171 (when next | |
172 (gnus-async-with-semaphore | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
173 (pop gnus-async-fetch-list))) |
17493 | 174 (let ((do-fetch next) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
175 (do-message t)) ;(eq major-mode 'gnus-summary-mode))) |
17493 | 176 (when (and (gnus-group-asynchronous-p group) |
177 (gnus-buffer-live-p summary) | |
178 (or (not next) | |
179 gnus-async-fetch-list)) | |
180 (gnus-async-with-semaphore | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
181 (unless next |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
182 (setq do-fetch (not gnus-async-fetch-list)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
183 ;; Nix out any outstanding requests. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
184 (setq gnus-async-fetch-list nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
185 ;; Fill in the new list. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
186 (let ((n gnus-use-article-prefetch) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
187 (data (gnus-data-find-list article)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
188 d) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
189 (while (and (setq d (pop data)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
190 (if (numberp n) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
191 (natnump (decf n)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
192 n)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
193 (unless (or (gnus-async-prefetched-article-entry |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
194 group (setq article (gnus-data-number d))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
195 (not (natnump article)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
196 (not (funcall gnus-async-prefetch-article-p d))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
197 ;; Not already fetched -- so we add it to the list. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
198 (push article gnus-async-fetch-list))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
199 (setq gnus-async-fetch-list |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
200 (nreverse gnus-async-fetch-list)))) |
17493 | 201 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
202 (when do-fetch |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
203 (setq article (car gnus-async-fetch-list)))) |
17493 | 204 |
205 (when (and do-fetch article) | |
206 ;; We want to fetch some more articles. | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110276
diff
changeset
|
207 (with-current-buffer summary |
17493 | 208 (let (mark) |
209 (gnus-async-set-buffer) | |
210 (goto-char (point-max)) | |
211 (setq mark (point-marker)) | |
212 (let ((nnheader-callback-function | |
213 (gnus-make-async-article-function | |
214 group article mark summary next)) | |
215 (nntp-server-buffer | |
216 (get-buffer gnus-async-prefetch-article-buffer))) | |
217 (when do-message | |
218 (gnus-message 9 "Prefetching article %d in group %s" | |
219 article group)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
220 (setq gnus-async-current-prefetch-group group) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
221 (setq gnus-async-current-prefetch-article article) |
17493 | 222 (gnus-request-article article group)))))))))) |
223 | |
224 (defun gnus-make-async-article-function (group article mark summary next) | |
225 "Return a callback function." | |
226 `(lambda (arg) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
227 (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
228 |
110261
8a1ec5899552
gnus-async.el (gnus-html-prefetch-images): Autoload it when compiling; (gnus-async-article-callback): Fix typo.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110258
diff
changeset
|
229 (eval-when-compile |
8a1ec5899552
gnus-async.el (gnus-html-prefetch-images): Autoload it when compiling; (gnus-async-article-callback): Fix typo.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110258
diff
changeset
|
230 (autoload 'gnus-html-prefetch-images "gnus-html")) |
8a1ec5899552
gnus-async.el (gnus-html-prefetch-images): Autoload it when compiling; (gnus-async-article-callback): Fix typo.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110258
diff
changeset
|
231 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
232 (defun gnus-async-article-callback (arg group article mark summary next) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
233 "Function called when an async article is done being fetched." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
234 (save-excursion |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
235 (setq gnus-async-current-prefetch-article nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
236 (when arg |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
237 (gnus-async-set-buffer) |
110276
07962d48d848
gnus-html.el (gnus-html-schedule-image-fetching): Decode entities before feeding URLs to curl.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110261
diff
changeset
|
238 (save-excursion |
07962d48d848
gnus-html.el (gnus-html-schedule-image-fetching): Decode entities before feeding URLs to curl.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110261
diff
changeset
|
239 (save-restriction |
07962d48d848
gnus-html.el (gnus-html-schedule-image-fetching): Decode entities before feeding URLs to curl.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110261
diff
changeset
|
240 (narrow-to-region mark (point-max)) |
07962d48d848
gnus-html.el (gnus-html-schedule-image-fetching): Decode entities before feeding URLs to curl.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110261
diff
changeset
|
241 ;; Prefetch images for the groups that want that. |
07962d48d848
gnus-html.el (gnus-html-schedule-image-fetching): Decode entities before feeding URLs to curl.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110261
diff
changeset
|
242 (when (fboundp 'gnus-html-prefetch-images) |
07962d48d848
gnus-html.el (gnus-html-schedule-image-fetching): Decode entities before feeding URLs to curl.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110261
diff
changeset
|
243 (gnus-html-prefetch-images summary)) |
07962d48d848
gnus-html.el (gnus-html-schedule-image-fetching): Decode entities before feeding URLs to curl.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110261
diff
changeset
|
244 (when gnus-async-post-fetch-function |
110025
5f352fd4346a
Misc Gnus fixes by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
106815
diff
changeset
|
245 (funcall gnus-async-post-fetch-function summary)))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
246 (gnus-async-with-semaphore |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
247 (setq |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
248 gnus-async-article-alist |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
249 (cons (list (intern (format "%s-%d" group article) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
250 gnus-async-hashtb) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
251 mark (set-marker (make-marker) (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
252 group article) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
253 gnus-async-article-alist)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
254 (if (not (gnus-buffer-live-p summary)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
255 (gnus-async-with-semaphore |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
256 (setq gnus-async-fetch-list nil)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
257 (gnus-async-prefetch-article group next summary t)))) |
17493 | 258 |
259 (defun gnus-async-unread-p (data) | |
260 "Return non-nil if DATA represents an unread article." | |
261 (gnus-data-unread-p data)) | |
262 | |
263 (defun gnus-async-request-fetched-article (group article buffer) | |
264 "See whether we have ARTICLE from GROUP and put it in BUFFER." | |
265 (when (numberp article) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
266 (when (and (equal group gnus-async-current-prefetch-group) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
267 (eq article gnus-async-current-prefetch-article)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
268 (gnus-async-wait-for-article article)) |
17493 | 269 (let ((entry (gnus-async-prefetched-article-entry group article))) |
270 (when entry | |
271 (save-excursion | |
272 (gnus-async-set-buffer) | |
273 (copy-to-buffer buffer (cadr entry) (caddr entry)) | |
274 ;; Remove the read article from the prefetch buffer. | |
275 (when (memq 'read gnus-prefetched-article-deletion-strategy) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
276 (gnus-async-delete-prefetched-entry entry)) |
17493 | 277 t))))) |
278 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
279 (defun gnus-async-wait-for-article (article) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
280 "Wait until ARTICLE is no longer the currently-being-fetched article." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
281 (save-excursion |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
282 (gnus-async-set-buffer) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
283 (let ((proc (nntp-find-connection (current-buffer))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
284 (nntp-server-buffer (current-buffer)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
285 (nntp-have-messaged nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
286 (tries 0)) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
287 (when proc |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
288 (condition-case nil |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
289 ;; FIXME: we could stop waiting after some |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
290 ;; timeout, but this is the wrong place to do it. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
291 ;; rather than checking time-spent-waiting, we |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
292 ;; should check time-since-last-output, which |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
293 ;; needs to be done in nntp.el. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
294 (while (eq article gnus-async-current-prefetch-article) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
295 (incf tries) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
296 (when (nntp-accept-process-output proc) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
297 (setq tries 0)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
298 (when (and (not nntp-have-messaged) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
299 (= tries 3)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
300 (gnus-message 5 "Waiting for async article...") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
301 (setq nntp-have-messaged t))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
302 (quit |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
303 ;; if the user interrupted on a slow/hung connection, |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
304 ;; do something friendly. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
305 (when (> tries 3) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
306 (setq gnus-async-current-prefetch-article nil)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
307 (signal 'quit nil))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
308 (when nntp-have-messaged |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
309 (gnus-message 5 "")))))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
310 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
311 (defun gnus-async-delete-prefetched-entry (entry) |
17493 | 312 "Delete ENTRY from buffer and alist." |
313 (ignore-errors | |
314 (delete-region (cadr entry) (caddr entry)) | |
315 (set-marker (cadr entry) nil) | |
316 (set-marker (caddr entry) nil)) | |
317 (gnus-async-with-semaphore | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
318 (setq gnus-async-article-alist |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
319 (delq entry gnus-async-article-alist)))) |
17493 | 320 |
321 (defun gnus-async-prefetch-remove-group (group) | |
322 "Remove all articles belonging to GROUP from the prefetch buffer." | |
323 (when (and (gnus-group-asynchronous-p group) | |
324 (memq 'exit gnus-prefetched-article-deletion-strategy)) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
325 (save-excursion |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
326 (gnus-async-set-buffer) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
327 (dolist (entry gnus-async-article-alist) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
328 (when (equal group (nth 3 entry)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78486
diff
changeset
|
329 (gnus-async-delete-prefetched-entry entry)))))) |
17493 | 330 |
331 (defun gnus-async-prefetched-article-entry (group article) | |
78486
f0a07da7dd45
Replace `iff' in doc-strings and comments.
Glenn Morris <rgm@gnu.org>
parents:
78224
diff
changeset
|
332 "Return the entry for ARTICLE in GROUP if it has been prefetched." |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
22585
diff
changeset
|
333 (let ((entry (save-excursion |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
22585
diff
changeset
|
334 (gnus-async-set-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
22585
diff
changeset
|
335 (assq (intern (format "%s-%d" group article) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
336 gnus-async-hashtb) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
22585
diff
changeset
|
337 gnus-async-article-alist)))) |
17493 | 338 ;; Perhaps something has emptied the buffer? |
339 (if (and entry | |
340 (= (cadr entry) (caddr entry))) | |
341 (progn | |
342 (ignore-errors | |
343 (set-marker (cadr entry) nil) | |
344 (set-marker (caddr entry) nil)) | |
345 (setq gnus-async-article-alist | |
346 (delq entry gnus-async-article-alist)) | |
347 nil) | |
348 entry))) | |
349 | |
350 ;;; | |
351 ;;; Header prefetch | |
352 ;;; | |
353 | |
354 (defun gnus-async-prefetch-headers (group) | |
355 "Prefetch the headers for group GROUP." | |
356 (save-excursion | |
357 (let (unread) | |
358 (when (and gnus-use-header-prefetch | |
359 gnus-asynchronous | |
360 (gnus-group-asynchronous-p group) | |
361 (listp gnus-async-header-prefetched) | |
362 (setq unread (gnus-list-of-unread-articles group))) | |
363 ;; Mark that a fetch is in progress. | |
364 (setq gnus-async-header-prefetched t) | |
365 (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) | |
366 (erase-buffer) | |
367 (let ((nntp-server-buffer (current-buffer)) | |
368 (nnheader-callback-function | |
369 `(lambda (arg) | |
370 (setq gnus-async-header-prefetched | |
371 ,(cons group unread))))) | |
372 (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) | |
373 | |
374 (defun gnus-async-retrieve-fetched-headers (articles group) | |
375 "See whether we have prefetched headers." | |
376 (when (and gnus-use-header-prefetch | |
377 (gnus-group-asynchronous-p group) | |
378 (listp gnus-async-header-prefetched) | |
379 (equal group (car gnus-async-header-prefetched)) | |
380 (equal articles (cdr gnus-async-header-prefetched))) | |
381 (save-excursion | |
382 (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) | |
383 (nntp-decode-text) | |
384 (copy-to-buffer nntp-server-buffer (point-min) (point-max)) | |
385 (erase-buffer) | |
386 (setq gnus-async-header-prefetched nil) | |
387 t))) | |
388 | |
389 (provide 'gnus-async) | |
390 | |
391 ;;; gnus-async.el ends here |