[Emacs-diffs] master 77ba0f1: `url-retrieve-synchronously' now takes an optional timeout parameter

[Lars Ingebrigtsen]

branch: master
commit 77ba0f1c5a259615ec049e21d061c4646e29f1d6
Author: Lars Magne Ingebrigtsen <address@hidden>
Commit: Lars Magne Ingebrigtsen <address@hidden>

    `url-retrieve-synchronously' now takes an optional timeout parameter
    
    * doc/misc/url.texi (Retrieving URLs): Document optional parameters.
    
    * lisp/url/url.el (url-retrieve-synchronously): Allow passing
    in a timeout parameter (bug#22940).
---
 doc/misc/url.texi |    7 ++++++-
 etc/NEWS          |    4 ++++
 lisp/url/url.el   |   18 ++++++++++++++----
 3 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 62b1d74..fe03234 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -289,11 +289,16 @@ string or a parsed URL structure.  If it is a string, 
that string is
 passed through @code{url-encode-url} before using it, to ensure that
 it is properly URI-encoded (@pxref{URI Encoding}).
 
address@hidden url-retrieve-synchronously url
address@hidden url-retrieve-synchronously url &optional silent no-cookies 
timeout
 This function synchronously retrieves the data specified by @var{url},
 and returns a buffer containing the data.  The return value is
 @code{nil} if there is no data associated with the URL (as is the case
 for @code{dired}, @code{info}, and @code{mailto} URLs).
+
+If @var{silent} is address@hidden, don't do any messaging while
+retrieving.  If @var{inhibit-cookies} is address@hidden, refuse to
+store cookies.  If @var{timeout} is passed, it should be a number that
+says (in seconds) how long to wait for a response before giving up.
 @end defun
 
 @defun url-retrieve url callback &optional cbargs silent no-cookies
diff --git a/etc/NEWS b/etc/NEWS
index e401d2d..2aeee96 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -284,6 +284,10 @@ servers.
 programmatically delete all cookies, or cookies from a specific
 domain.
 
++++
+*** `url-retrieve-synchronously' now takes an optional timeout parameter.
+
+---
 *** The URL package now support HTTPS over proxies supporting CONNECT.
 
 +++
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 4837ba0..6d710e0 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -221,14 +221,20 @@ URL-encoded before it's used."
     buffer))
 
 ;;;###autoload
-(defun url-retrieve-synchronously (url &optional silent inhibit-cookies)
+(defun url-retrieve-synchronously (url &optional silent inhibit-cookies 
timeout)
   "Retrieve URL synchronously.
 Return the buffer containing the data, or nil if there are no data
 associated with it (the case for dired, info, or mailto URLs that need
-no further processing).  URL is either a string or a parsed URL."
+no further processing).  URL is either a string or a parsed URL.
+
+If SILENT is non-nil, don't do any messaging while retrieving.
+If INHIBIT-COOKIES is non-nil, refuse to store cookies.  If
+TIMEOUT is passed, it should be a number that says (in seconds)
+how long to wait for a response before giving up."
   (url-do-setup)
 
   (let ((retrieval-done nil)
+       (start-time (current-time))
         (asynch-buffer nil))
     (setq asynch-buffer
          (url-retrieve url (lambda (&rest ignored)
@@ -250,7 +256,11 @@ no further processing).  URL is either a string or a 
parsed URL."
        ;; buffer-local variable so we can find the exact process that we
        ;; should be waiting for.  In the mean time, we'll just wait for any
        ;; process output.
-       (while (not retrieval-done)
+       (while (and (not retrieval-done)
+                    (or (not timeout)
+                        (< (float-time (time-subtract
+                                        (current-time) start-time))
+                           timeout)))
          (url-debug 'retrieval
                     "Spinning in url-retrieve-synchronously: %S (%S)"
                     retrieval-done asynch-buffer)
@@ -281,7 +291,7 @@ no further processing).  URL is either a string or a parsed 
URL."
             ;; `sleep-for' was tried but it lead to other forms of
             ;; hanging.  --Stef
             (unless (or (with-local-quit
-                         (accept-process-output proc))
+                         (accept-process-output proc 1))
                        (null proc))
               ;; accept-process-output returned nil, maybe because the process
               ;; exited (and may have been replaced with another).  If we got