Re: Fwd: HTTP redirects make url-retrieve-synchronously asynchronous

[Stefan Monnier <monnier@iro.umontreal.ca>]

>> 2. sometimes the callback gets called in another buffer than the one
>> returned by url-retrieve.

>> One solution would be to give the first buffer a local variable that
>> would, in this case, point to the second buffer.
>> Then url-retrieve-synchronously could check the local variable, which
>> would tell it to check the process in the other buffer.

> Yes, sounds like a good quick-fix.

The patch below uses this approach.  Mark, does it work well for you?


        Stefan


Index: lisp/url/url.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/url/url.el,v
retrieving revision 1.20
diff -u -r1.20 url.el
--- lisp/url/url.el	10 Jan 2006 19:31:15 -0000	1.20
+++ lisp/url/url.el	23 Jan 2006 20:37:41 -0000
@@ -114,6 +114,13 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Retrieval functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar url-redirect-buffer nil
+  "New buffer into which the retrieval will take place.
+Sometimes while retrieving a URL, the URL library needs to use another buffer
+than the one returned initially by `url-retrieve'.  In this case, it sets this
+variable in the original buffer as a forwarding pointer.")
+
 ;;;###autoload
 (defun url-retrieve (url callback &optional cbargs)
   "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
@@ -189,10 +189,14 @@
 	  (url-debug 'retrieval
 		     "Spinning in url-retrieve-synchronously: %S (%S)"
 		     retrieval-done asynch-buffer)
+          (if (buffer-local-value 'url-redirect-buffer asynch-buffer)
+              (setq proc (get-buffer-process
+                          (setq asynch-buffer
+                                (buffer-local-value 'url-redirect-buffer
+                                                    asynch-buffer))))
 	  (if (and proc (memq (process-status proc)
                               '(closed exit signal failed))
-                   ;; Make sure another process hasn't been started, as can
-                   ;; happen with http redirections.
+                     ;; Make sure another process hasn't been started.
 		   (eq proc (or (get-buffer-process asynch-buffer) proc)))
 	      ;; FIXME: It's not clear whether url-retrieve's callback is
 	      ;; guaranteed to be called or not.  It seems that url-http
@@ -200,7 +204,7 @@
 	      ;; clear that it's a bug, but even then we need to decide how
 	      ;; url-http can then warn us that the download has completed.
               ;; In the mean time, we use this here workaround.
-              (setq retrieval-done t)
+                (setq retrieval-done t))
             ;; 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.
Index: lisp/url/url-http.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/url/url-http.el,v
retrieving revision 1.23
diff -u -r1.23 url-http.el
--- lisp/url/url-http.el	18 Nov 2005 16:55:54 -0000	1.23
+++ lisp/url/url-http.el	23 Jan 2006 20:37:41 -0000
@@ -1,6 +1,6 @@
 ;;; url-http.el --- HTTP retrieval routines
 
-;; Copyright (C) 1999, 2001, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2004, 2005, 2006  Free Software Foundation, Inc.
 
 ;; Author: Bill Perry <wmperry@gnu.org>
 ;; Keywords: comm, data, processes
@@ -35,10 +35,8 @@
 (require 'url-cookie)
 (require 'mail-parse)
 (require 'url-auth)
-(autoload 'url-retrieve-synchronously "url")
-(autoload 'url-retrieve "url")
+(require 'url)
 (autoload 'url-cache-create-filename "url-cache")
-(autoload 'url-mark-buffer-as-dead "url")
 
 (defconst url-http-default-port 80 "Default HTTP port.")
 (defconst url-http-asynchronous-p t "HTTP retrievals are asynchronous.")
@@ -509,10 +509,17 @@
            (let ((url-request-method url-http-method)
 		 (url-request-data url-http-data)
 		 (url-request-extra-headers url-http-extra-headers))
+             ;; Put in the current buffer a forwarding pointer to the new
+             ;; destination buffer.
+             ;; FIXME: This is a hack to fix url-retrieve-synchronously
+             ;; without changing the API.  Instead url-retrieve should
+             ;; either simply not return the "destination" buffer, or it
+             ;; should take an optional `dest-buf' argument.
+             (set (make-local-variable 'url-redirect-buffer)
 	     (url-retrieve redirect-uri url-callback-function
 			   (cons :redirect
 				 (cons redirect-uri
-				       url-callback-arguments)))
+                                            url-callback-arguments))))
 	     (url-mark-buffer-as-dead (current-buffer))))))
       (4				; Client error
        ;; 400 Bad Request