[nongnu] elpa/xml-rpc 9fa979302b 63/64: Merge pull request #17 from xml-rpc-el/ci

[Stefan Kangas]

branch: elpa/xml-rpc
commit 9fa979302b24f2fee4e450384663b64a8cec061e
Merge: a876849b45 eb50e8b116
Author: Mark A. Hershberger <mah@everybody.org>
Commit: GitHub <noreply@github.com>

    Merge pull request #17 from xml-rpc-el/ci
    
    Add CI, add README, trim compat code.
---
 .github/workflows/CI.yml |  33 ++++
 Makefile                 |   2 +
 README.org               |  99 +++++++++++
 xml-rpc.el               | 417 ++++-------------------------------------------
 4 files changed, 168 insertions(+), 383 deletions(-)

diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml
new file mode 100644
index 0000000000..0ee2fa865a
--- /dev/null
+++ b/.github/workflows/CI.yml
@@ -0,0 +1,33 @@
+
+name: CI
+
+on:
+  pull_request:
+  push:
+    paths-ignore:
+    - '**.org'
+
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    strategy:
+      matrix:
+        emacs_version:
+          - 24.4
+          - 24.5
+          - 25.1
+          - 25.2
+          - 25.3
+          - 26.1
+          - 26.2
+          - 26.3
+          - 27.1
+          - snapshot
+    steps:
+    - uses: purcell/setup-emacs@master
+      with:
+        version: ${{ matrix.emacs_version }}
+
+    - uses: actions/checkout@v2
+    - name: Run tests
+      run: 'make test'
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000000..57d5aaee72
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,2 @@
+test:
+       emacs -batch -l xml-rpc-test.el -f ert-run-tests-batch-and-exit
diff --git a/README.org b/README.org
new file mode 100644
index 0000000000..c089a8fc6e
--- /dev/null
+++ b/README.org
@@ -0,0 +1,99 @@
+[[https://melpa.org/#/xml-rpc][file:https://melpa.org/packages/xml-rpc-badge.svg]]
+* Commentary:
+
+This is an [[http://xmlrpc.com/][XML-RPC]] client implementation in elisp, 
capable of both synchronous and asynchronous method calls (using the url 
package's async retrieval functionality).
+
+XML-RPC is remote procedure calls over HTTP using XML to describe the function 
call and return values.
+
+xml-rpc.el represents XML-RPC datatypes as lisp values, automatically 
converting to and from the XML datastructures as needed, both for method 
parameters and return values, making using XML-RPC methods fairly transparent 
to the lisp code.
+
+* Installation:
+
+If you use [[http://elpa.gnu.org/][ELPA]], and have configured the 
[[https://melpa.org/][MELPA]] repository, then =M-x package-install RET xml-rpc 
RET= interface. This is preferrable as you will have access to updates 
automatically.
+
+If you would like to use ELPA, but this is your first time to use it or MELPA, 
then try evaluating the following code in emacs:
+#+begin_src elisp
+  (progn
+    (require 'package)
+    (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/";) 
t)
+    (unless (package-installed-p 'xml-rpc)
+      (with-temp-buffer
+        (url-insert-file-contents 
"https://raw.githubusercontent.com/xml-rpc-el/xml-rpc-el/master/xml-rpc.el";)
+        (package-install-from-buffer))))
+#+end_src
+
+Otherwise, just make sure this file in your load-path (usually =~/.emacs.d= is 
included) and put
+#+begin_src elisp
+(require 'xml-rpc) 
+#+end_src
+in your =~/.emacs= or =~/.emacs.d/init.el= file.
+
+* Requirements
+
+xml-rpc.el uses the url package for http handling and =xml.el= for XML parsing 
or, if you have Emacs 27+ with =libxml= included, =libxml=. The url package 
that is part of Emacs works fine.
+
+* Bug reports
+
+Please use =M-x xml-rpc-submit-bug-report= to report bugs directly to the 
maintainer, or use [[https://github.com/xml-rpc-el/xml-rpc-el/issues][github's 
issue system]].
+
+* Representing data types
+ XML-RPC datatypes are represented as follows
+
+| type         | data                                   |
+| int          | 42                                     |
+| float/double | 42.0                                   |
+| string       | "foo"                                  |
+| base64       | (list :base64                          |
+|              | (base64-encode-string "hello" t))      |
+|              | '(:base64 "aGVsbG8=")                  |
+| array        | '(1 2 3 4)   '(1 2 3 (4.1 4.2))  [ ]   |
+|              | '(:array (("not" "a") ("struct" "!"))) |
+| struct       | '(("name" . "daniel")                  |
+|              | ("height" . 6.1))                      |
+| dateTime     | '(:datetime (1234 124))                |
+
+
+* Examples
+
+Here follows some examples demonstrating the use of xml-rpc.el
+
+** Normal synchronous operation
+#+begin_src elisp
+(xml-rpc-method-call "http://localhost:80/RPC"; 'foo-method foo bar zoo)
+#+end_src
+
+** Asynchronous example (cb-foo will be called when the methods returns)
+#+begin_src elisp
+(defun cb-foo (foo)
+  (print (format "%s" foo)))
+
+(xml-rpc-method-call-async 'cb-foo "http://localhost:80/RPC";
+                           'foo-method foo bar zoo)
+#+end_src
+
+** Some real world working examples for fun and play
+These were last tested working on 2020-09-06.
+*** Fetch the first state name from UserLand's server
+#+begin_src elisp
+  (xml-rpc-method-call "http://betty.userland.com/rpc2";
+                       'examples.getStateName '(1))
+#+end_src
+
+Results in:
+
+#+begin_example
+Alabama
+#+end_example
+
+*** Get a list of supported methods from a blog
+#+begin_src elisp
+  (mapconcat (lambda (s) (when s s))
+    (xml-rpc-method-call "https://hexmode.wordpress.com/xmlrpc.php";
+                         'mt.supportedMethods)
+    ", ")
+#+end_src
+
+Results in:
+#+begin_example
+wp.getUsersBlogs, wp.newPost, wp.editPost, wp.deletePost, wp.getPost, 
wp.getPosts, wp.newTerm, wp.editTerm, wp.deleteTerm, wp.getTerm, wp.getTerms, 
wp.getTaxonomy, wp.getTaxonomies, wp.getUser, wp.getUsers, wp.getProfile, 
wp.editProfile, wp.getPage, wp.getPages, wp.newPage, wp.deletePage, 
wp.editPage, wp.getPageList, wp.getAuthors, wp.getCategories, wp.getTags, 
wp.newCategory, wp.deleteCategory, wp.suggestCategories, wp.uploadFile, 
wp.deleteFile, wp.getCommentCount, wp.getPostStatusList, [...]
+#+end_example
diff --git a/xml-rpc.el b/xml-rpc.el
index 3426771bf2..46e4772a1f 100644
--- a/xml-rpc.el
+++ b/xml-rpc.el
@@ -1,28 +1,28 @@
 ;;; xml-rpc.el --- An elisp implementation of clientside XML-RPC  -*- 
lexical-binding:t -*-
 
-;; Copyright (C) 2002-2010 Mark A. Hershberger
+;; Copyright (C) 2002-2020 Mark A. Hershberger
 ;; Copyright (C) 2001 CodeFactory AB.
 ;; Copyright (C) 2001 Daniel Lundin.
 ;; Copyright (C) 2006 Shun-ichi Goto
 ;;   Modified for non-ASCII character handling.
 
-;; Author: Mark A. Hershberger <mah@everybody.org>
+;; Maintainer: Mark A. Hershberger <mah@everybody.org>
 ;; Original Author: Daniel Lundin <daniel@codefactory.se>
-;; Version: 1.6.13
+;; Version: 1.6.15
 ;; Created: May 13 2001
 ;; Keywords: xml rpc network
-;; URL: http://github.com/hexmode/xml-rpc-el
-;; Last Modified: <2020-09-06 15:33:28 mah>
+;; URL: http://github.com/xml-rpc-el/xml-rpc-el
+;; Last Modified: <2020-09-06 20:07:23 mah>
 
-(defconst xml-rpc-version "1.6.14"
+(defconst xml-rpc-version "1.6.15"
   "Current version of xml-rpc.el")
 
 ;; This file is NOT (yet) part of GNU Emacs.
 
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
+;; This program is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by the Free
+;; Software Foundation, either version 3 of the License, or (at your option)
+;; any later version.
 
 ;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -32,179 +32,6 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-;;; Commentary:
-
-;; This is an XML-RPC client implementation in elisp, capable of both
-;; synchronous and asynchronous method calls (using the url package's async
-;; retrieval functionality).
-;; XML-RPC is remote procedure calls over HTTP using XML to describe the
-;; function call and return values.
-
-;; xml-rpc.el represents XML-RPC datatypes as lisp values, automatically
-;; converting to and from the XML datastructures as needed, both for method
-;; parameters and return values, making using XML-RPC methods fairly
-;; transparent to the lisp code.
-
-;;; Installation:
-
-;; If you use ELPA (http://tromey.com/elpa), you can install via the
-;; M-x package-list-packages interface. This is preferrable as you
-;; will have access to updates automatically.
-
-;; Otherwise, just make sure this file in your load-path (usually
-;; ~/.emacs.d is included) and put (require 'xml-rpc) in your
-;; ~/.emacs or ~/.emacs.d/init.el file.
-
-;;; Requirements
-
-;; xml-rpc.el uses the url package for http handling and xml.el for
-;; XML parsing. url is a part of the W3 browser package.  The url
-;; package that is part of Emacs 22+ works great.
-;;
-;; xml.el is a part of GNU Emacs 21, but can also be downloaded from
-;; here: <URL:ftp://ftp.codefactory.se/pub/people/daniel/elisp/xml.el>
-
-;;; Bug reports
-
-;; Please use M-x xml-rpc-submit-bug-report to report bugs.
-
-;;; XML-RPC datatypes are represented as follows
-
-;;          int:  42
-;; float/double:  42.0
-;;       string:  "foo"
-;;       base64:  (list :base64 (base64-encode-string "hello" t)) '(:base64 
"aGVsbG8=")
-;;        array:  '(1 2 3 4)   '(1 2 3 (4.1 4.2))  [ ]  '(:array (("not" "a") 
("struct" "!")))
-;;       struct:  '(("name" . "daniel") ("height" . 6.1))
-;;     dateTime:  '(:datetime (1234 124))
-
-
-;;; Examples
-
-;; Here follows some examples demonstrating the use of xml-rpc.el
-
-;; Normal synchronous operation
-;; ----------------------------
-
-;; (xml-rpc-method-call "http://localhost:80/RPC"; 'foo-method foo bar zoo)
-
-;; Asynchronous example (cb-foo will be called when the methods returns)
-;; ---------------------------------------------------------------------
-
-;; (defun cb-foo (foo)
-;;   (print (format "%s" foo)))
-
-;; (xml-rpc-method-call-async 'cb-foo "http://localhost:80/RPC";
-;;                            'foo-method foo bar zoo)
-
-
-;; Some real world working examples for fun and play
-;; -------------------------------------------------
-
-;; Check the temperature (celsius) outside jonas@codefactory.se's apartment
-
-;; (xml-rpc-method-call
-;;      "http://flint.bengburken.net:80/xmlrpc/onewire_temp.php";
-;;      'onewire.getTemp)
-
-
-;; Fetch the latest NetBSD news the past 5 days from O'reillynet
-
-;; (xml-rpc-method-call "http://www.oreillynet.com/meerkat/xml-rpc/server.php";
-;;                   'meerkat.getItems
-;;                   '(("channel" . 1024)
-;;                     ("search" . "/NetBSD/")
-;;                     ("time_period" . "5DAY")
-;;                     ("ids" . 0)
-;;                     ("descriptions" . 200)
-;;                     ("categories" . 0)
-;;                     ("channels" . 0)
-;;                     ("dates" . 0)
-;;                     ("num_items" . 5)))
-
-
-;;; History:
-
-;; 1.6.13  - Fix running on Emacs 25 or later
-
-;; 1.6.12  - Add tests (thanks mdorman!), fix struct detection
-
-;; 1.6.11  - Add a way (xml-rpc-request-headers) for clients to add extra 
headers.
-
-;; 1.6.10.1 - removed extra HTTP header "Connection: close" and re-enabled 
keep-alive
-;;            to work with long-lived connections when large data is 
transmitted (LTC)
-
-;; 1.6.10  - Improve detection of structs with a patch from Jos'h Fuller.
-
-;; 1.6.9   - Add support for the i8 type (64 bit integers)
-;;         - Quote lambda with #' instead of ' to silence byte compiler
-
-;; 1.6.8.3 - [linda] Support for explicitly passing 'base64 data types.
-
-;; 1.6.8.2 - [linda] Fixed bug that empty values were translated into a 
boolean (nil)
-;;           instead of an empty string "" when turning XML into an Emacs list.
-
-;; 1.6.8.1 - [linda] Fixed bugs to be able to use empty lists and lists of 
lists
-;;           of strings as XML parameters.
-;;           (Bugs reported to web site with patches in Dec-2010.)
-
-;; 1.6.8   - Add a report-xml-rpc-bug function
-;;           Eliminate unused xml-rpc-get-temp-buffer-name
-;;           Improve compatibility with Xemacs
-
-;; 1.6.7   - Skipped version
-
-;; 1.6.6   - Use the correct dateTime elements.  Fix bug in parsing null int.
-
-;; 1.6.5.1 - Fix compile time warnings.
-
-;; 1.6.5   - Made handling of dateTime elements more robust.
-
-;; 1.6.4.1 - Updated to work with both Emacs22 and Emacs23.
-
-;; 1.6.2.2 - Modified to allow non-ASCII string again.
-;;           It can handle non-ASCII page name and comment
-;;           on Emacs 21 also.
-
-;; 1.6.2.1 - Modified to allow non-ASCII string.
-;;           If xml-rpc-allow-unicode-string is non-nil,
-;;           make 'value' object instead of 'base64' object.
-;;           This is good for WikiRPC.
-
-;; 1.6.2   - Fix whitespace issues to work better with new xml.el
-;;           Fix bug in string handling.
-;;           Add support for gzip-encoding when needed.
-
-;; 1.6.1   - base64 support added.
-;;           url-insert-entities-in-string done on string types now.
-
-;; 1.6     - Fixed dependencies (remove w3, add cl).
-;;           Move string-to-boolean and boolean-to-string into xml-rpc
-;;           namespace.
-;;           Fix bug in xml-rpc-xml-to-response where non-existent var was.
-;;           More tweaking of "Connection: close" header.
-;;           Fix bug in xml-rpc-request-process-buffer so that this works with
-;;           different mixes of the url.el code.
-
-;; 1.5.1   - Added Andrew J Cosgriff's patch to make the
-;;           xml-rpc-clean-string function work in XEmacs.
-
-;; 1.5     - Added headers to the outgoing url-retreive-synchronously
-;;           so that it would close connections immediately on completion.
-
-;; 1.4     - Added conditional debugging code.  Added version tag.
-
-;; 1.2     - Better error handling.  The documentation didn't match
-;;           the code.  That was changed so that an error was
-;;           signaled.  Also, better handling of various and
-;;           different combinations of xml.el and url.el.
-
-;; 1.1     - Added support for boolean types.  If the type of a
-;;           returned value is not specified, string is assumed
-
-;; 1.0     - First version
-
-
 ;;; Code:
 
 (require 'xml)
@@ -259,7 +86,8 @@ Set it higher to get some info in the *Messages* buffer"
 
 (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'")
+Should be an assoc list of headers/contents.  See
+`url-request-extra-headers'")
 
 ;;
 ;; Value type handling functions
@@ -372,14 +200,15 @@ Return nil otherwise."
   (or (string-equal value "true") (string-equal value "1")))
 
 (defun xml-rpc-caddar-safe (list)
-  "Assume that LIST is '((value nil REST)) and return REST.  If REST is nil, 
then return \"\""
+  "Assume that LIST is '((value nil REST)) and return REST.  If
+REST is nil, then return \"\""
   (let ((rest (car-safe (cdr-safe (cdr-safe (car-safe list))))))
     (if rest
        rest
       "")))
 
 (defun xml-rpc-xml-list-to-value (xml-list)
-  "Convert an XML-RPC structure in an xml.el style XML-LIST to an elisp list, \
+  "Convert an XML-RPC structure in an xml.el style XML-LIST to an elisp list,
 interpreting and simplifying it while retaining its structure."
   (let (valtype valvalue)
     (cond
@@ -390,7 +219,9 @@ interpreting and simplifying it while retaining its 
structure."
       (cond
        ;; Base64
        ((eq valtype 'base64)
-        (list :base64 (base64-decode-string valvalue))) ; for some reason, 
Emacs wraps this in a second encoding
+                                        ; for some reason, Emacs wraps this in
+                                        ; a second encoding
+        (list :base64 (base64-decode-string valvalue)))
        ;; Boolean
        ((eq valtype 'boolean)
         (xml-rpc-string-to-boolean valvalue))
@@ -440,7 +271,7 @@ interpreting and simplifying it while retaining its 
structure."
   (format-time-string "%Y%m%dT%H:%M:%S" (cadr value)))
 
 (defun xml-rpc-value-to-xml-list (value)
-  "Return XML representation of VALUE properly formatted for use with the  \
+  "Return XML representation of VALUE properly formatted for use with the
 functions in xml.el."
   (cond
    ;; boolean
@@ -451,7 +282,9 @@ functions in xml.el."
     `((value nil (dateTime.iso8601 nil ,(xml-rpc-datetime-to-string value)))))
    ;; base64 (explicit)
    ((xml-rpc-value-base64p value)
-    `((value nil (base64 nil ,(base64-encode-string (cadr value)))))) ; strip 
keyword; for some reason, Emacs decodes this twice
+                                        ; strip keyword; for some reason,
+                                        ; Emacs decodes this twice
+    `((value nil (base64 nil ,(base64-encode-string (cadr value))))))
    ;; array as vector (for empty lists)
    ((xml-rpc-value-vectorp value)
     (let ((result nil)
@@ -462,7 +295,8 @@ functions in xml.el."
       `((value nil (array nil ,(append '(data nil) result))))))
    ;; array as list
    ((xml-rpc-value-arrayp value)
-    (setq value (if (eq (car value) :array) (cadr value) value)) ; strip 
keyword if any
+                                        ; strip keyword if any
+    (setq value (if (eq (car value) :array) (cadr value) value))
     (let ((result nil)
           (xmlval nil))
       (while (setq xmlval (xml-rpc-value-to-xml-list (car value))
@@ -521,8 +355,8 @@ functions in xml.el."
 ;;
 
 (defsubst xml-rpc-response-errorp (response)
-  "An 'xml-rpc-method-call'  result value is always a list, where the first \
-element in RESPONSE is either nil or if an error occured, a cons pair \
+  "An 'xml-rpc-method-call'  result value is always a list, where the first
+element in RESPONSE is either nil or if an error occured, a cons pair
 according to (errnum .  \"Error string\"),"
   (eq 'fault (car-safe (caddar response))))
 
@@ -625,7 +459,8 @@ or nil if called with ASYNC-CALLBACK-FUNCTION."
                  (if async-callback-function
                      (let ((cbargs (list async-callback-function)))
                        (url-retrieve server-url
-                                     'xml-new-rpc-request-callback-handler 
cbargs))
+                                     '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))
@@ -728,7 +563,7 @@ or nil if called with ASYNC-CALLBACK-FUNCTION."
 
 
 (defun xml-rpc-request-callback-handler (callback-fun xml-buffer)
-  "Marshall a callback function request to CALLBACK-FUN with the results \
+  "Marshall a callback function request to CALLBACK-FUN with the results
 handled from XML-BUFFER."
   (let ((xml-response (xml-rpc-request-process-buffer xml-buffer)))
     (when (< xml-rpc-debug 1)
@@ -737,15 +572,16 @@ handled from XML-BUFFER."
 
 
 (defun xml-new-rpc-request-callback-handler (_status callback-fun)
-  "Handle a new style `url-retrieve' callback passing `STATUS' and 
`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 \
-PARAMS as parameters. When the method returns, ASYNC-CALLBACK-FUNC will be \
+  "Call an XML-RPC method asynchronously at SERVER-URL named METHOD with
+PARAMS as parameters. When the method returns, ASYNC-CALLBACK-FUNC will be
 called with the result as parameter."
   (let* ((m-name (if (stringp method)
                      method
@@ -763,7 +599,7 @@ called with the result as parameter."
     (xml-rpc-request server-url m-func-call async-callback-func)))
 
 (defun xml-rpc-method-call (server-url method &rest params)
-  "Call an XML-RPC method at SERVER-URL named METHOD with PARAMS as \
+  "Call an XML-RPC method at SERVER-URL named METHOD with PARAMS as
 parameters."
   (let ((response
          (xml-rpc-method-call-async nil server-url method params)))
@@ -772,191 +608,6 @@ parameters."
           (t
            (xml-rpc-xml-to-response response)))))
 
-(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
-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.
-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)) ?>)))))
-
-(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.
-
-Understands the following styles:
- (1) 14 Apr 89 03:20[:12] [GMT]
- (2) Fri, 17 Mar 89 4:01[:33] [GMT]
- (3) Mon Jan 16 16:12[:37] [GMT] 1989
- (4) 6 May 1992 1641-JST (Wednesday)
- (5) 22-AUG-1993 10:59:12.82
- (6) Thu, 11 Apr 16:17:12 91 [MET]
- (7) Mon, 6  Jul 16:47:20 T 1992 [MET]
- (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))))))
-
 (provide 'xml-rpc)
 
 ;; Local Variables: