[nongnu] elpa/xml-rpc 750fd4fb15 17/64: On functions that are conditionally defined, (xml-debug-print, timezone-parse-date), take them out of the eval-when-compile block so that they're compiled into .elc files. (url): Make sure url-http is loaded to avoid warnings later about let-bound variables. (xml-rpc-value-arrayp): Also verify that it is not a dateTime value.

[Stefan Kangas]

branch: elpa/xml-rpc
commit 750fd4fb157c825052bdb396375de6741c6c8374
Author: Mark A. Hershberger <mah@everybody.org>
Commit: Mark A. Hershberger <mah@everybody.org>

    On functions that are conditionally defined, (xml-debug-print, 
timezone-parse-date), take them out of the eval-when-compile block so that 
they're compiled into .elc files. (url): Make sure url-http is loaded to avoid 
warnings later about let-bound variables. (xml-rpc-value-arrayp): Also verify 
that it is not a dateTime value.
---
 xml-rpc.el | 363 ++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 181 insertions(+), 182 deletions(-)

diff --git a/xml-rpc.el b/xml-rpc.el
index da2a8ca99c..1cf36bca76 100644
--- a/xml-rpc.el
+++ b/xml-rpc.el
@@ -8,12 +8,12 @@
 
 ;; Author: Mark A. Hershberger <mah@everybody.org>
 ;; Original Author: Daniel Lundin <daniel@codefactory.se>
-;; Version: 1.6.6
+;; Version: 1.6.7
 ;; Created: May 13 2001
 ;; Keywords: xml rpc network
 ;; URL: http://emacswiki.org/emacs/xml-rpc.el
 ;; Maintained-at: http://savannah.nongnu.org/bzr/?group=emacsweblogs
-;; Last Modified: <2009-09-13 01:58:08 mah>
+;; Last Modified: <2009-09-16 11:17:07 mah>
 
 ;; This file is NOT (yet) part of GNU Emacs.
 
@@ -167,16 +167,16 @@
 ;;; Code:
 
 (require 'xml)
-(require 'url)
+(require 'url-http)
 (require 'timezone)
 (eval-when-compile
   (require 'cl))
 
-(defconst xml-rpc-version "1.6.6"
+(defconst xml-rpc-version "1.6.7"
   "Current Version of xml-rpc.el")
 
 (defcustom xml-rpc-load-hook nil
- "*Hook run after loading xml-rpc."
+  "*Hook run after loading xml-rpc."
   :type 'hook :group 'xml-rpc)
 
 (defcustom xml-rpc-allow-unicode-string (coding-system-p 'utf-8)
@@ -246,6 +246,7 @@ Set it higher to get some info in the *Messages* buffer"
 (defsubst xml-rpc-value-arrayp (value)
   "Return t if VALUE is an XML-RPC struct."
   (and (listp value)
+       (not (xml-rpc-value-datetimep value))
        (not (xml-rpc-value-structp value))))
 
 (defun xml-rpc-value-booleanp (value)
@@ -349,16 +350,16 @@ functions in xml.el."
                             xmlval)
                    value (cdr value)))
       `((value nil (array nil ,(append '(data nil) result))))))
-    ;; struct
-    ((xml-rpc-value-structp value)
-     (let ((result nil)
-           (xmlval nil))
-       (while (setq xmlval `((member nil (name nil ,(caar value))
-                                     ,(car (xml-rpc-value-to-xml-list
-                                            (cdar value)))))
-                    result (append result xmlval)
-                    value (cdr value)))
-       `((value nil ,(append '(struct nil) result)))))
+   ;; struct
+   ((xml-rpc-value-structp value)
+    (let ((result nil)
+         (xmlval nil))
+      (while (setq xmlval `((member nil (name nil ,(caar value))
+                                   ,(car (xml-rpc-value-to-xml-list
+                                          (cdar value)))))
+                  result (append result xmlval)
+                  value (cdr value)))
+      `((value nil ,(append '(struct nil) result)))))
    ;; Value is a scalar
    ((xml-rpc-value-intp value)
     `((value nil (int nil ,(int-to-string value)))))
@@ -652,79 +653,77 @@ parameters."
          (t
           (xml-rpc-xml-to-response response)))))
 
-(eval-when-compile
-  (unless (fboundp 'xml-escape-string)
-    (defun xml-debug-print (xml &optional indent-string)
-      "Outputs the XML in the current buffer.
+(unless (fboundp 'xml-escape-string)
+  (defun xml-debug-print (xml &optional indent-string)
+    "Outputs the XML in the current buffer.
 XML can be a tree or a list of nodes.
 The first line is indented with the optional INDENT-STRING."
-      (setq indent-string (or indent-string ""))
-      (dolist (node xml)
-        (xml-debug-print-internal node indent-string)))
-
-    (defalias 'xml-print 'xml-debug-print)
-
-    (when (not (boundp 'xml-entity-alist))
-      (defvar xml-entity-alist
-        '(("lt" . "<")
-          ("gt" . ">")
-          ("apos" . "'")
-          ("quot" . "\"")
-          ("amp" . "&"))))
-
-    (defun xml-escape-string (string)
-      "Return the string with entity substitutions made from
+    (setq indent-string (or indent-string ""))
+    (dolist (node xml)
+      (xml-debug-print-internal node indent-string)))
+
+  (defalias 'xml-print 'xml-debug-print)
+
+  (when (not (boundp 'xml-entity-alist))
+    (defvar xml-entity-alist
+      '(("lt" . "<")
+       ("gt" . ">")
+       ("apos" . "'")
+       ("quot" . "\"")
+       ("amp" . "&"))))
+
+  (defun xml-escape-string (string)
+    "Return the string with entity substitutions made from
 xml-entity-alist."
-      (mapconcat (lambda (byte)
-                   (let ((char (char-to-string byte)))
-                     (if (rassoc char xml-entity-alist)
-                         (concat "&" (car (rassoc char xml-entity-alist)) ";")
-                       char)))
-                 ;; This differs from the non-unicode branch.  Just
-                 ;; grabbing the string works here.
-                 string ""))
-
-    (defun xml-debug-print-internal (xml indent-string)
-      "Outputs the XML tree in the current buffer.
+    (mapconcat (lambda (byte)
+                (let ((char (char-to-string byte)))
+                  (if (rassoc char xml-entity-alist)
+                      (concat "&" (car (rassoc char xml-entity-alist)) ";")
+                    char)))
+              ;; This differs from the non-unicode branch.  Just
+              ;; grabbing the string works here.
+              string ""))
+
+  (defun xml-debug-print-internal (xml indent-string)
+    "Outputs the XML tree in the current buffer.
 The first line is indented with INDENT-STRING."
-      (let ((tree xml)
-            attlist)
-        (insert indent-string ?< (symbol-name (xml-node-name tree)))
-
-        ;;  output the attribute list
-        (setq attlist (xml-node-attributes tree))
-        (while attlist
-          (insert ?\  (symbol-name (caar attlist)) "=\""
-                  (xml-escape-string (cdar attlist)) ?\")
-          (setq attlist (cdr attlist)))
-
-        (setq tree (xml-node-children tree))
-
-        (if (null tree)
-            (insert ?/ ?>)
-          (insert ?>)
-
-          ;;  output the children
-          (dolist (node tree)
-            (cond
-             ((listp node)
-              (insert ?\n)
-              (xml-debug-print-internal node (concat indent-string "  ")))
-             ((stringp node)
-              (insert (xml-escape-string node)))
-             (t
-              (error "Invalid XML tree"))))
-
-          (when (not (and (null (cdr tree))
-                          (stringp (car tree))))
-            (insert ?\n indent-string))
-          (insert ?< ?/ (symbol-name (xml-node-name xml)) ?>))))))
-
-(eval-when-compile
-  (let ((tdate (timezone-parse-date "20090101T010101Z")))
-    (when (not (string-equal (aref tdate 0) "2009"))
-      (defun timezone-parse-date (date)
-        "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
+    (let ((tree xml)
+         attlist)
+      (insert indent-string ?< (symbol-name (xml-node-name tree)))
+
+      ;;  output the attribute list
+      (setq attlist (xml-node-attributes tree))
+      (while attlist
+       (insert ?\  (symbol-name (caar attlist)) "=\""
+               (xml-escape-string (cdar attlist)) ?\")
+       (setq attlist (cdr attlist)))
+
+      (setq tree (xml-node-children tree))
+
+      (if (null tree)
+         (insert ?/ ?>)
+       (insert ?>)
+
+       ;;  output the children
+       (dolist (node tree)
+         (cond
+          ((listp node)
+           (insert ?\n)
+           (xml-debug-print-internal node (concat indent-string "  ")))
+          ((stringp node)
+           (insert (xml-escape-string node)))
+          (t
+           (error "Invalid XML tree"))))
+
+       (when (not (and (null (cdr tree))
+                       (stringp (car tree))))
+         (insert ?\n indent-string))
+       (insert ?< ?/ (symbol-name (xml-node-name xml)) ?>)))))
+
+(let ((tdate (timezone-parse-date "20090101T010101Z")))
+  (when (not (string-equal (aref tdate 0) "2009"))
+    (defun timezone-parse-date (date)
+      "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
 Two-digit dates are `windowed'.  Those <69 have 2000 added; otherwise 1900
 is added.  Three-digit dates have 1900 added.
 TIMEZONE is nil for DATEs without a zone field.
@@ -740,104 +739,104 @@ Understands the following styles:
  (8) 1996-06-24 21:13:12 [GMT]
  (9) 1996-06-24 21:13-ZONE
  (10) 19960624T211312"
-        ;; Get rid of any text properties.
-        (and (stringp date)
-             (or (text-properties-at 0 date)
-                 (next-property-change 0 date))
-             (setq date (copy-sequence date))
-             (set-text-properties 0 (length date) nil date))
-        (let ((date (or date ""))
-              (year nil)
-              (month nil)
-              (day nil)
-              (time nil)
-              (zone nil))                      ;This may be nil.
-          (cond ((string-match
-                  "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
-                 ;; Styles: (1) and (2) with timezone and buggy timezone
-                 ;; This is most common in mail and news,
-                 ;; so it is worth trying first.
-                 (setq year 3 month 2 day 1 time 4 zone 5))
-                ((string-match
-                  "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
-                 ;; Styles: (1) and (2) without timezone
-                 (setq year 3 month 2 day 1 time 4 zone nil))
-                ((string-match
-                  "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ 
\t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
-                 ;; Styles: (6) and (7) without timezone
-                 (setq year 6 month 3 day 2 time 4 zone nil))
-                ((string-match
-                  "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ 
\t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ 
\t]*\\([-+a-zA-Z0-9]+\\)" date)
-                 ;; Styles: (6) and (7) with timezone and buggy timezone
-                 (setq year 6 month 3 day 2 time 4 zone 7))
-                ((string-match
-                  "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ 
\t]+\\([0-9]+\\)" date)
-                 ;; Styles: (3) without timezone
-                 (setq year 4 month 1 day 2 time 3 zone nil))
-                ((string-match
-                  "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ 
\t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
-                 ;; Styles: (3) with timezone
-                 (setq year 5 month 1 day 2 time 3 zone 4))
-                ((string-match
-                  "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ 
\t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
-                 ;; Styles: (4) with timezone
-                 (setq year 3 month 2 day 1 time 4 zone 5))
-                ((string-match
-                  "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
-                 ;; Styles: (5) with timezone.
-                 (setq year 3 month 2 day 1 time 4 zone 6))
-                ((string-match
-                  "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?" date)
-                 ;; Styles: (5) without timezone.
-                 (setq year 3 month 2 day 1 time 4 zone nil))
-                ((string-match
-                  "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
-                 ;; Styles: (8) with timezone.
-                 (setq year 1 month 2 day 3 time 4 zone 5))
-                ((string-match
-                  
"\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T 
\t]+\\([0-9]\\{0,2\\}:?[0-9]\\{0,2\\}:?[0-9]\\{0,2\\}\\)[ 
\t]*\\([-+a-zA-Z]+[0-9:]*\\)" date)
-                 ;; Styles: (8) with timezone with a colon in it.
-                 (setq year 1 month 2 day 3 time 4 zone 5))
-                ((string-match
-                  
"\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T 
\t]+\\([0-9]+:?[0-9]+:?[0-9]+\\)" date)
-                 ;; Styles: (8) without timezone.
-                 (setq year 1 month 2 day 3 time 4 zone nil)))
-
-          (when year
-            (setq year (match-string year date))
-            ;; Guess ambiguous years.  Assume years < 69 don't predate the
-            ;; Unix Epoch, so are 2000+.  Three-digit years are assumed to
-            ;; be relative to 1900.
-            (when (< (length year) 4)
-              (let ((y (string-to-number year)))
-                (when (< y 69)
-                  (setq y (+ y 100)))
-                (setq year (int-to-string (+ 1900 y)))))
-            (setq month
-                  (if (or (= (aref date (+ (match-beginning month) 2)) ?-)
-                          (let ((n (string-to-number
-                                    (char-to-string
-                                     (aref date (+ (match-beginning month) 
2))))))
-                            (= (aref (number-to-string n) 0)
-                               (aref date (+ (match-beginning month) 2)))))
-                      ;; Handle numeric months, spanning exactly two digits.
-                      (substring date
-                                 (match-beginning month)
-                                 (+ (match-beginning month) 2))
-                    (let* ((string (substring date
-                                              (match-beginning month)
-                                              (+ (match-beginning month) 3)))
-                           (monthnum
-                            (cdr (assoc (upcase string) 
timezone-months-assoc))))
-                      (when monthnum
-                        (int-to-string monthnum)))))
-            (setq day (match-string day date))
-            (setq time (match-string time date)))
-          (when zone (setq zone (match-string zone date)))
-          ;; Return a vector.
-          (if (and year month)
-              (vector year month day time zone)
-            (vector "0" "0" "0" "0" nil)))))))
+      ;; Get rid of any text properties.
+      (and (stringp date)
+          (or (text-properties-at 0 date)
+              (next-property-change 0 date))
+          (setq date (copy-sequence date))
+          (set-text-properties 0 (length date) nil date))
+      (let ((date (or date ""))
+           (year nil)
+           (month nil)
+           (day nil)
+           (time nil)
+           (zone nil))                 ;This may be nil.
+       (cond ((string-match
+               "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
+              ;; Styles: (1) and (2) with timezone and buggy timezone
+              ;; This is most common in mail and news,
+              ;; so it is worth trying first.
+              (setq year 3 month 2 day 1 time 4 zone 5))
+             ((string-match
+               "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
+              ;; Styles: (1) and (2) without timezone
+              (setq year 3 month 2 day 1 time 4 zone nil))
+             ((string-match
+               "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ 
\t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
+              ;; Styles: (6) and (7) without timezone
+              (setq year 6 month 3 day 2 time 4 zone nil))
+             ((string-match
+               "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ 
\t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ 
\t]*\\([-+a-zA-Z0-9]+\\)" date)
+              ;; Styles: (6) and (7) with timezone and buggy timezone
+              (setq year 6 month 3 day 2 time 4 zone 7))
+             ((string-match
+               "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ 
\t]+\\([0-9]+\\)" date)
+              ;; Styles: (3) without timezone
+              (setq year 4 month 1 day 2 time 3 zone nil))
+             ((string-match
+               "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ 
\t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
+              ;; Styles: (3) with timezone
+              (setq year 5 month 1 day 2 time 3 zone 4))
+             ((string-match
+               "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ 
\t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
+              ;; Styles: (4) with timezone
+              (setq year 3 month 2 day 1 time 4 zone 5))
+             ((string-match
+               "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
+              ;; Styles: (5) with timezone.
+              (setq year 3 month 2 day 1 time 4 zone 6))
+             ((string-match
+               "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?" date)
+              ;; Styles: (5) without timezone.
+              (setq year 3 month 2 day 1 time 4 zone nil))
+             ((string-match
+               "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ 
\t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
+              ;; Styles: (8) with timezone.
+              (setq year 1 month 2 day 3 time 4 zone 5))
+             ((string-match
+               
"\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T 
\t]+\\([0-9]\\{0,2\\}:?[0-9]\\{0,2\\}:?[0-9]\\{0,2\\}\\)[ 
\t]*\\([-+a-zA-Z]+[0-9:]*\\)" date)
+              ;; Styles: (8) with timezone with a colon in it.
+              (setq year 1 month 2 day 3 time 4 zone 5))
+             ((string-match
+               
"\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T 
\t]+\\([0-9]+:?[0-9]+:?[0-9]+\\)" date)
+              ;; Styles: (8) without timezone.
+              (setq year 1 month 2 day 3 time 4 zone nil)))
+
+       (when year
+         (setq year (match-string year date))
+         ;; Guess ambiguous years.  Assume years < 69 don't predate the
+         ;; Unix Epoch, so are 2000+.  Three-digit years are assumed to
+         ;; be relative to 1900.
+         (when (< (length year) 4)
+           (let ((y (string-to-number year)))
+             (when (< y 69)
+               (setq y (+ y 100)))
+             (setq year (int-to-string (+ 1900 y)))))
+         (setq month
+               (if (or (= (aref date (+ (match-beginning month) 2)) ?-)
+                       (let ((n (string-to-number
+                                 (char-to-string
+                                  (aref date (+ (match-beginning month) 2))))))
+                         (= (aref (number-to-string n) 0)
+                            (aref date (+ (match-beginning month) 2)))))
+                   ;; Handle numeric months, spanning exactly two digits.
+                   (substring date
+                              (match-beginning month)
+                              (+ (match-beginning month) 2))
+                 (let* ((string (substring date
+                                           (match-beginning month)
+                                           (+ (match-beginning month) 3)))
+                        (monthnum
+                         (cdr (assoc (upcase string) timezone-months-assoc))))
+                   (when monthnum
+                     (int-to-string monthnum)))))
+         (setq day (match-string day date))
+         (setq time (match-string time date)))
+       (when zone (setq zone (match-string zone date)))
+       ;; Return a vector.
+       (if (and year month)
+           (vector year month day time zone)
+         (vector "0" "0" "0" "0" nil))))))
 
 (provide 'xml-rpc)