diff options
| author | Lars Magne Ingebrigtsen | 2011-05-02 20:15:39 +0200 |
|---|---|---|
| committer | Lars Magne Ingebrigtsen | 2011-05-02 20:15:39 +0200 |
| commit | 471129b1e3510bedc1a4a71fe5656961e803ca66 (patch) | |
| tree | ee0af1e4a13d97ec13288ae01f2e1e36b68b3d7c | |
| parent | 08da93f1a3b99ea81572aeb2e8d0fdfa7b63b0e8 (diff) | |
| download | emacs-471129b1e3510bedc1a4a71fe5656961e803ca66.tar.gz emacs-471129b1e3510bedc1a4a71fe5656961e803ca66.zip | |
Autoload `url-queue-retrieve', and fix up the pruning code.
| -rw-r--r-- | lisp/url/ChangeLog | 3 | ||||
| -rw-r--r-- | lisp/url/url-queue.el | 15 |
2 files changed, 11 insertions, 7 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 55b400e2bd7..1049d09d6db 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog | |||
| @@ -3,6 +3,9 @@ | |||
| 3 | * url-queue.el: New file. | 3 | * url-queue.el: New file. |
| 4 | (url-queue-run-queue): Pick the first waiting job, and not the | 4 | (url-queue-run-queue): Pick the first waiting job, and not the |
| 5 | last. | 5 | last. |
| 6 | (url-queue-parallel-processes): Lower the concurrency level, since | ||
| 7 | Emacs doesn't seem to like too many async processes. | ||
| 8 | (url-queue-prune-old-entries): Fix up the pruning code. | ||
| 6 | 9 | ||
| 7 | 2011-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org> | 10 | 2011-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 8 | 11 | ||
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index d572418e3e2..7f20f80cc99 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el | |||
| @@ -31,7 +31,7 @@ | |||
| 31 | (eval-when-compile (require 'cl)) | 31 | (eval-when-compile (require 'cl)) |
| 32 | (require 'browse-url) | 32 | (require 'browse-url) |
| 33 | 33 | ||
| 34 | (defcustom url-queue-parallel-processes 4 | 34 | (defcustom url-queue-parallel-processes 2 |
| 35 | "The number of concurrent processes." | 35 | "The number of concurrent processes." |
| 36 | :type 'integer | 36 | :type 'integer |
| 37 | :group 'url) | 37 | :group 'url) |
| @@ -47,8 +47,9 @@ | |||
| 47 | 47 | ||
| 48 | (defstruct url-queue | 48 | (defstruct url-queue |
| 49 | url callback cbargs silentp | 49 | url callback cbargs silentp |
| 50 | process start-time) | 50 | buffer start-time) |
| 51 | 51 | ||
| 52 | ;;;###autoload | ||
| 52 | (defun url-queue-retrieve (url callback &optional cbargs silent) | 53 | (defun url-queue-retrieve (url callback &optional cbargs silent) |
| 53 | "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. | 54 | "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. |
| 54 | Like `url-retrieve' (which see for details of the arguments), but | 55 | Like `url-retrieve' (which see for details of the arguments), but |
| @@ -83,7 +84,7 @@ controls the level of parallelism via the | |||
| 83 | (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))) | 84 | (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))) |
| 84 | 85 | ||
| 85 | (defun url-queue-start-retrieve (job) | 86 | (defun url-queue-start-retrieve (job) |
| 86 | (setf (url-queue-process job) | 87 | (setf (url-queue-buffer job) |
| 87 | (ignore-errors | 88 | (ignore-errors |
| 88 | (url-retrieve (url-queue-url job) | 89 | (url-retrieve (url-queue-url job) |
| 89 | #'url-queue-callback-function (list job) | 90 | #'url-queue-callback-function (list job) |
| @@ -98,12 +99,12 @@ controls the level of parallelism via the | |||
| 98 | url-queue-timeout)) | 99 | url-queue-timeout)) |
| 99 | (push job dead-jobs))) | 100 | (push job dead-jobs))) |
| 100 | (dolist (job dead-jobs) | 101 | (dolist (job dead-jobs) |
| 101 | (when (processp (url-queue-process job)) | 102 | (when (bufferp (url-queue-buffer job)) |
| 102 | (ignore-errors | 103 | (ignore-errors |
| 103 | (delete-process (url-queue-process job))) | 104 | (delete-process (get-buffer-process (url-queue-buffer job)))) |
| 104 | (ignore-errors | 105 | (ignore-errors |
| 105 | (kill-buffer (process-buffer (url-queue-process job)))) | 106 | (kill-buffer (url-queue-buffer job)))) |
| 106 | (setq url-queue (delq job url-queue)))))) | 107 | (setq url-queue (delq job url-queue))))) |
| 107 | 108 | ||
| 108 | (provide 'url-queue) | 109 | (provide 'url-queue) |
| 109 | 110 | ||