mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Ensure progress when fetching from the queue

Browse source 
* lisp/url/url-queue.el (url-queue-check-progress): Ensure
that we have progress when fetching queued requests (bug#22576).
This commit is contained in:
Lars Ingebrigtsen 2016-02-08 17:13:01 +11:00
parent 8b50ae8b22
commit da66e55850
1 changed files with 16 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

18
lisp/url/url-queue.el
View file

@ -1,4 +1,4 @@
;;; url-queue.el --- Fetching web pages in parallel
;;; url-queue.el --- Fetching web pages in parallel -*- lexical-binding: t -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@ -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)