summaryrefslogtreecommitdiff
path: root/lisp/url/url.el
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2005-06-10 21:14:34 +0000
committerStefan Monnier <monnier@iro.umontreal.ca>2005-06-10 21:14:34 +0000
commit7f95457178a15c411cc91d94ddefab6d1e5fa77a (patch)
tree234eb40e9fcf6a002405383c75a1314bbdfaf4fa /lisp/url/url.el
parentf1b587064a41ef495ef7a87b992dbdd711d557da (diff)
downloademacs-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.el31
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