[nongnu] elpa/xml-rpc 8c944a1b7d 37/64: Merge pull request #1 from stsquad/extra-headers-rebase

[Stefan Kangas]

branch: elpa/xml-rpc
commit 8c944a1b7dca0408298f169537f780ab40b0493a
Merge: 822f5bc020 4fd5a03a36
Author: Mark A. Hershberger <mah@everybody.org>
Commit: Mark A. Hershberger <mah@everybody.org>

    Merge pull request #1 from stsquad/extra-headers-rebase
    
    Here is the pull request
---
 xml-rpc.el | 24 +++++++++++++++++++-----
 1 file changed, 19 insertions(+), 5 deletions(-)

diff --git a/xml-rpc.el b/xml-rpc.el
index f870bd4ab1..bfc21f880d 100644
--- a/xml-rpc.el
+++ b/xml-rpc.el
@@ -246,6 +246,10 @@ Set it higher to get some info in the *Messages* buffer"
 (defvar xml-rpc-fault-code nil
   "Contains the fault code if a fault is returned")
 
+(defvar xml-rpc-request-extra-headers nil
+  "A list of extra headers to send with the next request.
+Should be an assoc list of headers/contents.  See `url-request-extra-headers'")
+
 ;;
 ;; Value type handling functions
 ;;
@@ -560,10 +564,12 @@ or nil if called with ASYNC-CALLBACK-FUNCTION."
               (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
               (url-request-coding-system xml-rpc-use-coding-system)
               (url-http-attempt-keepalives t)
-              (url-request-extra-headers (list
-                                          (cons "Connection" "close")
-                                          (cons "Content-Type"
-                                                "text/xml; charset=utf-8"))))
+              (url-request-extra-headers (append
+                                          (list
+                                           (cons "Connection" "close")
+                                           (cons "Content-Type"
+                                                 "text/xml; charset=utf-8"))
+                                          xml-rpc-request-extra-headers)))
           (when (> xml-rpc-debug 1)
             (print url-request-data (create-file-buffer "request-data")))
 
@@ -586,7 +592,9 @@ or nil if called with ASYNC-CALLBACK-FUNCTION."
                      result)))
                 (t                      ; Post emacs20 w3-el
                  (if async-callback-function
-                     (url-retrieve server-url async-callback-function)
+                     (let ((cbargs (list async-callback-function)))
+                       (url-retrieve server-url
+                                     'xml-new-rpc-request-callback-handler 
cbargs))
                    (let ((buffer (url-retrieve-synchronously server-url)))
                      (with-current-buffer buffer
                        (when (not (numberp url-http-response-status))
@@ -688,6 +696,12 @@ handled from XML-BUFFER."
     (funcall callback-fun (xml-rpc-xml-to-response xml-response))))
 
 
+(defun xml-new-rpc-request-callback-handler (status callback-fun)
+  "Handle a new style `url-retrieve' callback passing `STATUS' and 
`CALLBACK-FUN'."
+  (let ((xml-buffer (current-buffer)))
+    (xml-rpc-request-callback-handler callback-fun xml-buffer)))
+
+
 (defun xml-rpc-method-call-async (async-callback-func server-url method
                                                       &rest params)
   "Call an XML-RPC method asynchronously at SERVER-URL named METHOD with \