X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7c8b0b3644ada886dfde4032fdf38687a5968089..4869e0d85a215e7fb0262430a48aa4d5804bf0a4:/lisp/url/url-queue.el

diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index c667cb932d..8972d0b056 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -1,6 +1,6 @@
-;;; url-queue.el --- Fetching web pages in parallel
+;;; url-queue.el --- Fetching web pages in parallel   -*- lexical-binding: t -*-
 
-;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: comm
@@ -47,6 +47,7 @@
 ;;; Internal variables.
 
 (defvar url-queue nil)
+(defvar url-queue-progress-timer nil)
 
 (cl-defstruct url-queue
   url callback cbargs silentp
@@ -90,7 +91,13 @@ The variable `url-queue-timeout' sets a timeout."
     (when (and waiting
 	       (< running url-queue-parallel-processes))
       (setf (url-queue-pre-triggered waiting) t)
-      (run-with-idle-timer 0.01 nil 'url-queue-run-queue))))
+      ;; We start fetching from this idle timer...
+      (run-with-idle-timer 0.01 nil #'url-queue-run-queue)
+      ;; And then we set up a separate timer to ensure progress when a
+      ;; web server is unresponsive.
+      (unless url-queue-progress-timer
+        (setq url-queue-progress-timer
+              (run-with-idle-timer 1 1 #'url-queue-check-progress))))))
 
 (defun url-queue-run-queue ()
   (url-queue-prune-old-entries)
@@ -107,6 +114,13 @@ The variable `url-queue-timeout' sets a timeout."
       (setf (url-queue-start-time waiting) (float-time))
       (url-queue-start-retrieve waiting))))
 
+(defun url-queue-check-progress ()
+  (when url-queue-progress-timer
+    (if url-queue
+        (url-queue-run-queue)
+      (cancel-timer url-queue-progress-timer)
+      (setq url-queue-progress-timer nil))))
+
 (defun url-queue-callback-function (status job)
   (setq url-queue (delq job url-queue))
   (when (and (eq (car status) :error)