# HG changeset patch # User Stefan Monnier # Date 1105626911 0 # Node ID d91d1f84814f553b3ff950b3593208fd986a01a4 # Parent 6f663dc1995f439cc81ed30b12ea3dc97dc9eae9 (url-retrieve-synchronously): Use accept-process-output rather than sit-for. diff -r 6f663dc1995f -r d91d1f84814f lisp/url/ChangeLog --- a/lisp/url/ChangeLog Thu Jan 13 11:35:05 2005 +0000 +++ b/lisp/url/ChangeLog Thu Jan 13 14:35:11 2005 +0000 @@ -1,3 +1,8 @@ +2005-01-13 Stefan Monnier + + * url.el (url-retrieve-synchronously): Use accept-process-output rather + than sit-for. + 2005-01-03 Klaus Straubinger (tiny change) * url-http.el (url-http-handle-authentication): diff -r 6f663dc1995f -r d91d1f84814f lisp/url/url.el --- a/lisp/url/url.el Thu Jan 13 11:35:05 2005 +0000 +++ b/lisp/url/url.el Thu Jan 13 14:35:11 2005 +0000 @@ -1,6 +1,7 @@ ;;; url.el --- Uniform Resource Locator retrieval tool -;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc. +;; Copyright (c) 1996, 1997, 1998, 1999, 2001, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: Bill Perry ;; Keywords: comm, data, processes, hypermedia @@ -169,26 +170,25 @@ (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer)) (setq retrieval-done t asynch-buffer (current-buffer))))) - (if (not asynch-buffer) - ;; We do not need to do anything, it was a mailto or something - ;; similar that takes processing completely outside of the URL - ;; package. - nil - (while (not retrieval-done) - (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" - retrieval-done asynch-buffer) - ;; Quoth Stef: - ;; It turns out that the problem seems to be that the (sit-for - ;; 0.1) below doesn't actually process the data: instead it - ;; returns immediately because there is keyboard input - ;; waiting, so we end up spinning endlessly waiting for the - ;; process to finish while not letting it finish. - - ;; However, raman claims that it blocks Emacs with Emacspeak - ;; for unexplained reasons. Put back for his benefit until - ;; someone can understand it. - ;; (sleep-for 0.1) - (sit-for 0.1)) + (let ((proc (and asynch-buffer (get-buffer-process asynch-buffer)))) + (if (null proc) + ;; We do not need to do anything, it was a mailto or something + ;; similar that takes processing completely outside of the URL + ;; package. + nil + (while (not retrieval-done) + (url-debug 'retrieval + "Spinning in url-retrieve-synchronously: %S (%S)" + retrieval-done asynch-buffer) + ;; We used to use `sit-for' here, but in some cases it wouldn't + ;; work because apparently pending keyboard input would always + ;; interrupt it before it got a chance to handle process input. + ;; `sleep-for' was tried but it lead to other forms of + ;; hanging. --Stef + (unless (accept-process-output proc) + ;; accept-process-output returned nil, maybe because the process + ;; exited (and may have been replaced with another). + (setq proc (get-buffer-process asynch-buffer))))) asynch-buffer))) (defun url-mm-callback (&rest ignored)