Update copyright year to 2015

[gnu-emacs] / lisp / url / url-queue.el

diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index 976a26635cd80bb2b29184187878c6f6ce391951..c667cb932d5ef043fe8dd0ad64da73bdc115ec5e 100644 (file)
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -1,6 +1,6 @@
 ;;; url-queue.el --- Fetching web pages in parallel
 
-;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: comm
@@ -28,7 +28,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 (require 'browse-url)
 (require 'url-parse)
 
@@ -48,25 +48,28 @@
 
 (defvar url-queue nil)
 
-(defstruct url-queue
+(cl-defstruct url-queue
   url callback cbargs silentp
-  buffer start-time pre-triggered)
+  buffer start-time pre-triggered
+  inhibit-cookiesp)
 
 ;;;###autoload
-(defun url-queue-retrieve (url callback &optional cbargs silent)
+(defun url-queue-retrieve (url callback &optional cbargs silent inhibit-cookies)
   "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
-Like `url-retrieve' (which see for details of the arguments), but
-controls the level of parallelism via the
-`url-queue-parallel-processes' variable."
+This is like `url-retrieve' (which see for details of the arguments),
+but with limits on the degree of parallelism.  The variable
+`url-queue-parallel-processes' sets the number of concurrent processes.
+The variable `url-queue-timeout' sets a timeout."
   (setq url-queue
        (append url-queue
                (list (make-url-queue :url url
                                      :callback callback
                                      :cbargs cbargs
-                                     :silentp silent))))
+                                     :silentp silent
+                                     :inhibit-cookiesp inhibit-cookies))))
   (url-queue-setup-runners))
 
-;; To ensure asynch behaviour, we start the required number of queue
+;; To ensure asynch behavior, we start the required number of queue
 ;; runners from `run-with-idle-timer'.  So we're basically going
 ;; through the queue in two ways: 1) synchronously when a program
 ;; calls `url-queue-retrieve' (which will then start the required
@@ -81,7 +84,7 @@ controls the level of parallelism via the
       (cond
        ((or (url-queue-start-time entry)
            (url-queue-pre-triggered entry))
-       (incf running))
+       (cl-incf running))
        ((not waiting)
        (setq waiting entry))))
     (when (and waiting
@@ -96,7 +99,7 @@ controls the level of parallelism via the
     (dolist (entry url-queue)
       (cond
        ((url-queue-start-time entry)
-       (incf running))
+       (cl-incf running))
        ((not waiting)
        (setq waiting entry))))
     (when (and waiting
@@ -105,6 +108,7 @@ controls the level of parallelism via the
       (url-queue-start-retrieve waiting))))
 
 (defun url-queue-callback-function (status job)
+  (setq url-queue (delq job url-queue))
   (when (and (eq (car status) :error)
             (eq (cadr (cadr status)) 'connection-failed))
     ;; If we get a connection error, then flush all other jobs from
@@ -113,7 +117,6 @@ controls the level of parallelism via the
     ;; synchronously and totally halts Emacs.
     (url-queue-remove-jobs-from-host
      (plist-get (nthcdr 3 (cadr status)) :host)))
-  (setq url-queue (delq job url-queue))
   (url-queue-run-queue)
   (apply (url-queue-callback job) (cons status (url-queue-cbargs job))))
 
@@ -124,14 +127,17 @@ controls the level of parallelism via the
                   host)
        (push job jobs)))
     (dolist (job jobs)
+      (url-queue-kill-job job)
       (setq url-queue (delq job url-queue)))))
-  
+
 (defun url-queue-start-retrieve (job)
   (setf (url-queue-buffer job)
        (ignore-errors
-         (url-retrieve (url-queue-url job)
-                       #'url-queue-callback-function (list job)
-                       (url-queue-silentp job)))))
+         (let ((url-request-noninteractive t))
+           (url-retrieve (url-queue-url job)
+                         #'url-queue-callback-function (list job)
+                         (url-queue-silentp job)
+                         (url-queue-inhibit-cookiesp job))))))
 
 (defun url-queue-prune-old-entries ()
   (let (dead-jobs)
@@ -142,14 +148,31 @@ controls the level of parallelism via the
                    url-queue-timeout))
        (push job dead-jobs)))
     (dolist (job dead-jobs)
-      (when (bufferp (url-queue-buffer job))
-       (while (get-buffer-process (url-queue-buffer job))
-         (ignore-errors
-           (delete-process (get-buffer-process (url-queue-buffer job)))))
-       (ignore-errors
-         (kill-buffer (url-queue-buffer job))))
+      (url-queue-kill-job job)
       (setq url-queue (delq job url-queue)))))
 
+(defun url-queue-kill-job (job)
+  (when (bufferp (url-queue-buffer job))
+    (let (process)
+      (while (setq process (get-buffer-process (url-queue-buffer job)))
+       (set-process-sentinel process 'ignore)
+       (ignore-errors
+         (delete-process process)))))
+  ;; Call the callback with an error message to ensure that the caller
+  ;; is notified that the job has failed.
+  (with-current-buffer
+      (if (and (bufferp (url-queue-buffer job))
+              (buffer-live-p (url-queue-buffer job)))
+         ;; Use the (partially filled) process buffer it it exists.
+         (url-queue-buffer job)
+       ;; If not, just create a new buffer, which will probably be
+       ;; killed again by the caller.
+       (generate-new-buffer " *temp*"))
+    (apply (url-queue-callback job)
+          (cons (list :error (list 'error 'url-queue-timeout
+                                   "Queue timeout exceeded"))
+                (url-queue-cbargs job)))))
+
 (provide 'url-queue)
 
 ;;; url-queue.el ends here