diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2005-06-10 21:14:34 +0000 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2005-06-10 21:14:34 +0000 |
commit | 7f95457178a15c411cc91d94ddefab6d1e5fa77a (patch) | |
tree | 234eb40e9fcf6a002405383c75a1314bbdfaf4fa /lisp/url/url.el | |
parent | f1b587064a41ef495ef7a87b992dbdd711d557da (diff) | |
download | emacs-7f95457178a15c411cc91d94ddefab6d1e5fa77a.tar.gz |
(url-retrieve-synchronously): Don't exit precipitously when
fetching a file via ange-ftp.
Diffstat (limited to 'lisp/url/url.el')
-rw-r--r-- | lisp/url/url.el | 31 |
1 files changed, 20 insertions, 11 deletions
diff --git a/lisp/url/url.el b/lisp/url/url.el index 05ef85c9300..8b57d885949 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -170,17 +170,26 @@ no further processing). URL is either a string or a parsed URL." (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer)) (setq retrieval-done t asynch-buffer (current-buffer))))) - (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 + (if (null 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 + (let ((proc (get-buffer-process asynch-buffer))) + ;; If the access method was synchronous, `retrieval-done' should + ;; hopefully already be set to t. If it is nil, and `proc' is also + ;; nil, it implies that the async process is not running in + ;; asynch-buffer. This happens e.g. for FTP files. In such a case + ;; url-file.el should probably set something like a `url-process' + ;; 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) (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" retrieval-done asynch-buffer) - (if (memq (process-status proc) '(closed exit signal failed)) + (if (and proc (memq (process-status proc) + '(closed exit signal failed))) ;; FIXME: It's not clear whether url-retrieve's callback is ;; guaranteed to be called or not. It seems that url-http ;; decides sometimes consciously not to call it, so it's not @@ -193,7 +202,7 @@ no further processing). URL is either a string or a parsed URL." ;; 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) + (unless (or (accept-process-output proc) (null 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)))))) @@ -201,9 +210,9 @@ no further processing). URL is either a string or a parsed URL." (defun url-mm-callback (&rest ignored) (let ((handle (mm-dissect-buffer t))) - (save-excursion - (url-mark-buffer-as-dead (current-buffer)) - (set-buffer (generate-new-buffer (url-recreate-url url-current-object))) + (url-mark-buffer-as-dead (current-buffer)) + (with-current-buffer + (generate-new-buffer (url-recreate-url url-current-object)) (if (eq (mm-display-part handle) 'external) (progn (set-process-sentinel |