[Emacs-diffs] /srv/bzr/emacs/trunk r107602: Always call the callback when timing out url-queue jobs

[Lars Magne Ingebrigtsen]

------------------------------------------------------------
revno: 107602
committer: Lars Magne Ingebrigtsen <address@hidden>
branch nick: trunk
timestamp: Wed 2012-03-14 03:44:09 +0100
message:
  Always call the callback when timing out url-queue jobs
  
  * url-queue.el (url-queue-kill-job): Make sure that the callback
  is always called, even if we have a timeout.
modified:
  lisp/url/ChangeLog
  lisp/url/url-queue.el

=== modified file 'lisp/url/ChangeLog'
--- a/lisp/url/ChangeLog        2012-03-11 15:12:26 +0000
+++ b/lisp/url/ChangeLog        2012-03-14 02:44:09 +0000
@@ -1,3 +1,8 @@
+2012-03-14  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * url-queue.el (url-queue-kill-job): Make sure that the callback
+       is always called, even if we have a timeout.
+
 2012-03-11  Chong Yidong  <address@hidden>
 
        * url-http.el (url-http-end-of-document-sentinel): Handle

=== modified file 'lisp/url/url-queue.el'
--- a/lisp/url/url-queue.el     2012-02-20 12:12:48 +0000
+++ b/lisp/url/url-queue.el     2012-03-14 02:44:09 +0000
@@ -156,9 +156,20 @@
       (while (setq process (get-buffer-process (url-queue-buffer job)))
        (set-process-sentinel process 'ignore)
        (ignore-errors
-         (delete-process process))))
-    (ignore-errors
-      (kill-buffer (url-queue-buffer job)))))
+         (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 (bufferp (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)