Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-async.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents ec9a17fef872
children e04119814345
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
48 (const :tag "all" t) 48 (const :tag "all" t)
49 (integer :tag "some" 0))) 49 (integer :tag "some" 0)))
50 50
51 (defcustom gnus-prefetched-article-deletion-strategy '(read exit) 51 (defcustom gnus-prefetched-article-deletion-strategy '(read exit)
52 "List of symbols that say when to remove articles from the prefetch buffer. 52 "List of symbols that say when to remove articles from the prefetch buffer.
53 Possible values in this list are `read', which means that 53 Possible values in this list are `read', which means that
54 articles are removed as they are read, and `exit', which means 54 articles are removed as they are read, and `exit', which means
55 that all articles belonging to a group are removed on exit 55 that all articles belonging to a group are removed on exit
56 from that group." 56 from that group."
57 :group 'gnus-asynchronous 57 :group 'gnus-asynchronous
58 :type '(set (const read) (const exit))) 58 :type '(set (const read) (const exit)))
103 ,@forms) 103 ,@forms)
104 (gnus-async-release-semaphore 'gnus-async-article-semaphore))) 104 (gnus-async-release-semaphore 'gnus-async-article-semaphore)))
105 105
106 (put 'gnus-asynch-with-semaphore 'lisp-indent-function 0) 106 (put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
107 (put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body)) 107 (put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
108 108
109 ;;; 109 ;;;
110 ;;; Article prefetch 110 ;;; Article prefetch
111 ;;; 111 ;;;
112 112
113 (gnus-add-shutdown 'gnus-async-close 'gnus) 113 (gnus-add-shutdown 'gnus-async-close 'gnus)
136 (if (not (fboundp 'run-with-idle-timer)) 136 (if (not (fboundp 'run-with-idle-timer))
137 ;; This is either an older Emacs or XEmacs, so we 137 ;; This is either an older Emacs or XEmacs, so we
138 ;; do this, which leads to slightly slower article 138 ;; do this, which leads to slightly slower article
139 ;; buffer display. 139 ;; buffer display.
140 (gnus-async-prefetch-article group next summary) 140 (gnus-async-prefetch-article group next summary)
141 (run-with-idle-timer 141 (run-with-idle-timer
142 0.1 nil 'gnus-async-prefetch-article group next summary))))))) 142 0.1 nil 'gnus-async-prefetch-article group next summary)))))))
143 143
144 (defun gnus-async-prefetch-article (group article summary &optional next) 144 (defun gnus-async-prefetch-article (group article summary &optional next)
145 "Possibly prefetch several articles starting with ARTICLE." 145 "Possibly prefetch several articles starting with ARTICLE."
146 (if (not (gnus-buffer-live-p summary)) 146 (if (not (gnus-buffer-live-p summary))
179 (setq gnus-async-fetch-list 179 (setq gnus-async-fetch-list
180 (nreverse gnus-async-fetch-list)))) 180 (nreverse gnus-async-fetch-list))))
181 181
182 (when do-fetch 182 (when do-fetch
183 (setq article (car gnus-async-fetch-list)))) 183 (setq article (car gnus-async-fetch-list))))
184 184
185 (when (and do-fetch article) 185 (when (and do-fetch article)
186 ;; We want to fetch some more articles. 186 ;; We want to fetch some more articles.
187 (save-excursion 187 (save-excursion
188 (set-buffer summary) 188 (set-buffer summary)
189 (let (mark) 189 (let (mark)
190 (gnus-async-set-buffer) 190 (gnus-async-set-buffer)
191 (goto-char (point-max)) 191 (goto-char (point-max))
192 (setq mark (point-marker)) 192 (setq mark (point-marker))
193 (let ((nnheader-callback-function 193 (let ((nnheader-callback-function
194 (gnus-make-async-article-function 194 (gnus-make-async-article-function
195 group article mark summary next)) 195 group article mark summary next))
196 (nntp-server-buffer 196 (nntp-server-buffer
197 (get-buffer gnus-async-prefetch-article-buffer))) 197 (get-buffer gnus-async-prefetch-article-buffer)))
198 (when do-message 198 (when do-message
199 (gnus-message 7 "Prefetching article %d in group %s" 199 (gnus-message 7 "Prefetching article %d in group %s"
200 article group)) 200 article group))
201 (gnus-request-article article group)))))))))) 201 (gnus-request-article article group))))))))))
238 (ignore-errors 238 (ignore-errors
239 (delete-region (cadr entry) (caddr entry)) 239 (delete-region (cadr entry) (caddr entry))
240 (set-marker (cadr entry) nil) 240 (set-marker (cadr entry) nil)
241 (set-marker (caddr entry) nil)) 241 (set-marker (caddr entry) nil))
242 (gnus-async-with-semaphore 242 (gnus-async-with-semaphore
243 (setq gnus-async-article-alist 243 (setq gnus-async-article-alist
244 (delq entry gnus-async-article-alist)))) 244 (delq entry gnus-async-article-alist))))
245 245
246 (defun gnus-async-prefetch-remove-group (group) 246 (defun gnus-async-prefetch-remove-group (group)
247 "Remove all articles belonging to GROUP from the prefetch buffer." 247 "Remove all articles belonging to GROUP from the prefetch buffer."
248 (when (and (gnus-group-asynchronous-p group) 248 (when (and (gnus-group-asynchronous-p group)
252 (gnus-async-set-buffer) 252 (gnus-async-set-buffer)
253 (while alist 253 (while alist
254 (when (equal group (nth 3 (car alist))) 254 (when (equal group (nth 3 (car alist)))
255 (gnus-async-delete-prefected-entry (car alist))) 255 (gnus-async-delete-prefected-entry (car alist)))
256 (pop alist)))))) 256 (pop alist))))))
257 257
258 (defun gnus-async-prefetched-article-entry (group article) 258 (defun gnus-async-prefetched-article-entry (group article)
259 "Return the entry for ARTICLE in GROUP iff it has been prefetched." 259 "Return the entry for ARTICLE in GROUP iff it has been prefetched."
260 (let ((entry (assq (intern (format "%s-%d" group article)) 260 (let ((entry (assq (intern (format "%s-%d" group article))
261 gnus-async-article-alist))) 261 gnus-async-article-alist)))
262 ;; Perhaps something has emptied the buffer? 262 ;; Perhaps something has emptied the buffer?
264 (= (cadr entry) (caddr entry))) 264 (= (cadr entry) (caddr entry)))
265 (progn 265 (progn
266 (ignore-errors 266 (ignore-errors
267 (set-marker (cadr entry) nil) 267 (set-marker (cadr entry) nil)
268 (set-marker (caddr entry) nil)) 268 (set-marker (caddr entry) nil))
269 (setq gnus-async-article-alist 269 (setq gnus-async-article-alist
270 (delq entry gnus-async-article-alist)) 270 (delq entry gnus-async-article-alist))
271 nil) 271 nil)
272 entry))) 272 entry)))
273 273
274 ;;; 274 ;;;
307 (nntp-decode-text) 307 (nntp-decode-text)
308 (copy-to-buffer nntp-server-buffer (point-min) (point-max)) 308 (copy-to-buffer nntp-server-buffer (point-min) (point-max))
309 (erase-buffer) 309 (erase-buffer)
310 (setq gnus-async-header-prefetched nil) 310 (setq gnus-async-header-prefetched nil)
311 t))) 311 t)))
312 312
313 (provide 'gnus-async) 313 (provide 'gnus-async)
314 314
315 ;;; gnus-async.el ends here 315 ;;; gnus-async.el ends here