mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-01 11:14:55 +00:00
Code Issues Releases Activity

Autoload `url-queue-retrieve', and fix up the pruning code.

Browse Source
This commit is contained in:
Lars Magne Ingebrigtsen 2011-05-02 20:15:39 +02:00
parent 08da93f1a3
commit 471129b1e3
2 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lisp/url/ChangeLog
View File

@ -3,6 +3,9 @@
* url-queue.el: New file.
(url-queue-run-queue): Pick the first waiting job, and not the
last.
(url-queue-parallel-processes): Lower the concurrency level, since
Emacs doesn't seem to like too many async processes.
(url-queue-prune-old-entries): Fix up the pruning code.
2011-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>

15
lisp/url/url-queue.el
View File

@ -31,7 +31,7 @@
(eval-when-compile (require 'cl))
(require 'browse-url)
(defcustom url-queue-parallel-processes 4
(defcustom url-queue-parallel-processes 2
"The number of concurrent processes."
:type 'integer
:group 'url)
@ -47,8 +47,9 @@
(defstruct url-queue
url callback cbargs silentp
process start-time)
buffer start-time)
;;;###autoload
(defun url-queue-retrieve (url callback &optional cbargs silent)
"Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
Like `url-retrieve' (which see for details of the arguments), but
@ -83,7 +84,7 @@ controls the level of parallelism via the
(apply (url-queue-callback job) (cons status (url-queue-cbargs job))))
(defun url-queue-start-retrieve (job)
(setf (url-queue-process job)
(setf (url-queue-buffer job)
(ignore-errors
(url-retrieve (url-queue-url job)
#'url-queue-callback-function (list job)
@ -98,12 +99,12 @@ controls the level of parallelism via the
url-queue-timeout))
(push job dead-jobs)))
(dolist (job dead-jobs)
(when (processp (url-queue-process job))
(when (bufferp (url-queue-buffer job))
(ignore-errors
(delete-process (url-queue-process job)))
(delete-process (get-buffer-process (url-queue-buffer job))))
(ignore-errors
(kill-buffer (process-buffer (url-queue-process job))))
(setq url-queue (delq job url-queue))))))
(kill-buffer (url-queue-buffer job))))
(setq url-queue (delq job url-queue)))))
(provide 'url-queue)