[nongnu] elpa/xml-rpc e4002b8502 40/64: Really fix struct detection.

[Stefan Kangas]

branch: elpa/xml-rpc
commit e4002b8502686215642919eccd9afa2e8203d590
Author: Michael Alan Dorman <mdorman@ironicdesign.com>
Commit: Michael Alan Dorman <mdorman@ironicdesign.com>

    Really fix struct detection.
    
    Commit aa0953b2d4ef1b983bc54357b56af63cab4309b9 claimed to improve
    detection of structs, but actually broke xml-rpc's ability to encode
    anything other than simple "text" -> "text" maps: anything else, arrays,
    dates, nested structs---all of which are perfectly reasonable according
    to the xml-rpc standard---would cause `xml-rpc-value-structp` to return
    `nil`.
    
    In other words:
    
      (xml-rpc-value-structp '(("bar" . "foo")))
      => t
    
      (xml-rpc-value-structp '(("bar" :datetime (12345 12345))))
      => nil
    
    This change introduces a `xml-rpc-valuep` function that will recognize
    any sort of xml-rpc value, and then hooks that in place of the clearly
    erroneous `(not (listp (cdr curval)))`.
---
 xml-rpc.el | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

diff --git a/xml-rpc.el b/xml-rpc.el
index 984ebe9408..33dc07d933 100644
--- a/xml-rpc.el
+++ b/xml-rpc.el
@@ -252,6 +252,20 @@ Set it higher to get some info in the *Messages* buffer"
   "A list of extra headers to send with the next request.
 Should be an assoc list of headers/contents.  See `url-request-extra-headers'")
 
+(defsubst xml-rpc-valuep (value)
+  "Return t if VALUE is any sort of xml-rpc structure.
+
+Return nil otherwise."
+  (or (xml-rpc-value-intp value)
+      (xml-rpc-value-doublep value)
+      (xml-rpc-value-stringp value)
+      (xml-rpc-value-structp value)
+      (xml-rpc-value-arrayp value)
+      (xml-rpc-value-vectorp value)
+      (xml-rpc-value-booleanp value)
+      (xml-rpc-value-datetimep value)
+      (xml-rpc-value-base64p value)))
+
 ;;
 ;; Value type handling functions
 ;;
@@ -281,7 +295,7 @@ Should be an assoc list of headers/contents.  See 
`url-request-extra-headers'")
                          (setq curval (car-safe vals))
                          (consp curval)
                          (stringp (car-safe curval))
-                         (not (listp (cdr curval)))))
+                         (xml-rpc-valuep (cdr curval))))
            (setq vals (cdr-safe vals)))
          result)))