summaryrefslogtreecommitdiff
path: root/lisp/net/soap-client.el
diff options
context:
space:
mode:
authorAlex Harsanyi <AlexHarsanyi@gmail.com>2017-05-24 14:18:39 -0400
committerThomas Fitzsimmons <fitzsim@fitzsim.org>2017-05-25 08:49:57 -0400
commit349fbb35513f001a49623be8fe6704cda4ca48e2 (patch)
tree46e9e97353eb3b5e6dfd375780447552fa9d873b /lisp/net/soap-client.el
parent1a9ce7c54e99d80fb515a33edbeeb75fd3239526 (diff)
downloademacs-349fbb35513f001a49623be8fe6704cda4ca48e2.tar.gz
Remove cl dependency in soap-client.el and soap-inspect.el
* lisp/net/soap-inspect.el: Replace cl library with cl-lib, case with cl-case, destructuring-bind with cl-destructuring-bind and loop with cl-loop. * lisp/net/soap-client.el: Replace cl library with cl-lib, defstruct with cl-defstruct, assert with cl-assert, case with cl-case, ecase with cl-ecase, loop with cl-loop and destructuring-bind with cl-destructuring-bind. Co-authored-by: Stefan Monnier <monnier@iro.umontreal.ca>
Diffstat (limited to 'lisp/net/soap-client.el')
-rw-r--r--lisp/net/soap-client.el311
1 files changed, 155 insertions, 156 deletions
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 5d36cfa89b8..922f6985761 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -43,7 +43,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'cl-lib)
(require 'xml)
@@ -298,7 +297,7 @@ be tagged with a namespace tag."
;; An element in an XML namespace, "things" stored in soap-xml-namespaces will
;; be derived from this object.
-(defstruct soap-element
+(cl-defstruct soap-element
name
;; The "well-known" namespace tag for the element. For example, while
;; parsing XML documents, we can have different tags for the XMLSchema
@@ -321,13 +320,13 @@ element name."
;; a namespace link stores an alias for an object in once namespace to a
;; "target" object possibly in a different namespace
-(defstruct (soap-namespace-link (:include soap-element))
+(cl-defstruct (soap-namespace-link (:include soap-element))
target)
;; A namespace is a collection of soap-element objects under a name (the name
;; of the namespace).
-(defstruct soap-namespace
+(cl-defstruct soap-namespace
(name nil :read-only t) ; e.g "http://xml.apache.org/xml-soap"
(elements (make-hash-table :test 'equal) :read-only t))
@@ -360,9 +359,9 @@ added to the namespace."
(setq name target))))))
;; by now, name should be valid
- (assert (and name (not (equal name "")))
- nil
- "Cannot determine name for namespace link")
+ (cl-assert (and name (not (equal name "")))
+ nil
+ "Cannot determine name for namespace link")
(push (make-soap-namespace-link :name name :target target)
(gethash name (soap-namespace-elements ns))))
@@ -372,7 +371,7 @@ If multiple elements with the same name exist,
DISCRIMINANT-PREDICATE is used to pick one of them. This allows
storing elements of different types (like a message type and a
binding) but the same name."
- (assert (stringp name))
+ (cl-assert (stringp name))
(let ((elements (gethash name (soap-namespace-elements ns))))
(cond (discriminant-predicate
(catch 'found
@@ -394,14 +393,14 @@ binding) but the same name."
;; message exchange. We include here an XML schema model with a parser and
;; serializer/deserializer.
-(defstruct (soap-xs-type (:include soap-element))
+(cl-defstruct (soap-xs-type (:include soap-element))
id
attributes
attribute-groups)
;;;;; soap-xs-basic-type
-(defstruct (soap-xs-basic-type (:include soap-xs-type))
+(cl-defstruct (soap-xs-basic-type (:include soap-xs-type))
;; Basic types are "built in" and we know how to handle them directly.
;; Other type definitions reference basic types, so we need to create them
;; in a namespace (see `soap-make-xs-basic-types')
@@ -483,7 +482,7 @@ This is a specialization of `soap-encode-value' for
(when (or value (eq kind 'boolean))
(let ((value-string
- (case kind
+ (cl-case kind
((string anyURI QName ID IDREF language)
(unless (stringp value)
(error "Not a string value: %s" value))
@@ -495,7 +494,7 @@ This is a specialization of `soap-encode-value' for
;; string format in UTC.
(format-time-string
(concat
- (ecase kind
+ (cl-ecase kind
(dateTime "%Y-%m-%dT%H:%M:%S")
(time "%H:%M:%S")
(date "%Y-%m-%d")
@@ -673,7 +672,7 @@ This is a specialization of `soap-decode-type' for
(if (null contents)
nil
- (ecase kind
+ (cl-ecase kind
((string anyURI QName ID IDREF language) (car contents))
((dateTime time date gYearMonth gYear gMonthDay gDay gMonth)
(car contents))
@@ -694,7 +693,7 @@ This is a specialization of `soap-decode-type' for
;;;;; soap-xs-element
-(defstruct (soap-xs-element (:include soap-element))
+(cl-defstruct (soap-xs-element (:include soap-element))
;; NOTE: we don't support exact number of occurrences via minOccurs,
;; maxOccurs. Instead we support optional? and multiple?
@@ -738,8 +737,8 @@ contains a reference, retrieve the type of the reference."
(ref (xml-get-attribute-or-nil node 'ref))
(substitution-group (xml-get-attribute-or-nil node 'substitutionGroup))
(node-name (soap-l2wk (xml-node-name node))))
- (assert (memq node-name '(xsd:element xsd:group))
- "expecting xsd:element or xsd:group, got %s" node-name)
+ (cl-assert (memq node-name '(xsd:element xsd:group))
+ "expecting xsd:element or xsd:group, got %s" node-name)
(when type
(setq type (soap-l2fq type 'tns)))
@@ -895,11 +894,11 @@ This is a specialization of `soap-encode-value' for
(soap-element-namespace-tag type)))
(setf (soap-xs-element-type^ new-element)
(soap-xs-complex-type-base type))
- (loop for i below (length value)
- do (progn
- (soap-encode-xs-element (aref value i) new-element)
- )))
- (soap-encode-value value type))
+ (cl-loop for i below (length value)
+ do (progn
+ (soap-encode-xs-element (aref value i) new-element)
+ )))
+ (soap-encode-value value type))
(insert "</" fq-name ">\n"))
;; else
(insert "/>\n"))))
@@ -925,18 +924,18 @@ This is a specialization of `soap-decode-type' for
;;;;; soap-xs-attribute
-(defstruct (soap-xs-attribute (:include soap-element))
+(cl-defstruct (soap-xs-attribute (:include soap-element))
type ; a simple type or basic type
default ; the default value, if any
reference)
-(defstruct (soap-xs-attribute-group (:include soap-xs-type))
+(cl-defstruct (soap-xs-attribute-group (:include soap-xs-type))
reference)
(defun soap-xs-parse-attribute (node)
"Construct a `soap-xs-attribute' from NODE."
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:attribute)
- "expecting xsd:attribute, got %s" (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'xsd:attribute)
+ "expecting xsd:attribute, got %s" (soap-l2wk (xml-node-name node)))
(let* ((name (xml-get-attribute-or-nil node 'name))
(type (soap-l2fq (xml-get-attribute-or-nil node 'type)))
(default (xml-get-attribute-or-nil node 'fixed))
@@ -952,8 +951,8 @@ This is a specialization of `soap-decode-type' for
(defun soap-xs-parse-attribute-group (node)
"Construct a `soap-xs-attribute-group' from NODE."
(let ((node-name (soap-l2wk (xml-node-name node))))
- (assert (eq node-name 'xsd:attributeGroup)
- "expecting xsd:attributeGroup, got %s" node-name)
+ (cl-assert (eq node-name 'xsd:attributeGroup)
+ "expecting xsd:attributeGroup, got %s" node-name)
(let ((name (xml-get-attribute-or-nil node 'name))
(id (xml-get-attribute-or-nil node 'id))
(ref (xml-get-attribute-or-nil node 'ref))
@@ -970,7 +969,7 @@ This is a specialization of `soap-decode-type' for
(unless (stringp child)
;; Ignore optional annotation.
;; Ignore anyAttribute nodes.
- (case (soap-l2wk (xml-node-name child))
+ (cl-case (soap-l2wk (xml-node-name child))
(xsd:attribute
(push (soap-xs-parse-attribute child)
(soap-xs-type-attributes attribute-group)))
@@ -1043,7 +1042,7 @@ See also `soap-wsdl-resolve-references'."
;;;;; soap-xs-simple-type
-(defstruct (soap-xs-simple-type (:include soap-xs-type))
+(cl-defstruct (soap-xs-simple-type (:include soap-xs-type))
;; A simple type is an extension on the basic type to which some
;; restrictions can be added. For example we can define a simple type based
;; off "string" with the restrictions that only the strings "one", "two" and
@@ -1064,11 +1063,11 @@ See also `soap-wsdl-resolve-references'."
(defun soap-xs-parse-simple-type (node)
"Construct an `soap-xs-simple-type' object from the XML NODE."
- (assert (memq (soap-l2wk (xml-node-name node))
- '(xsd:simpleType xsd:simpleContent))
- nil
- "expecting xsd:simpleType or xsd:simpleContent node, got %s"
- (soap-l2wk (xml-node-name node)))
+ (cl-assert (memq (soap-l2wk (xml-node-name node))
+ '(xsd:simpleType xsd:simpleContent))
+ nil
+ "expecting xsd:simpleType or xsd:simpleContent node, got %s"
+ (soap-l2wk (xml-node-name node)))
;; NOTE: name can be nil for inline types. Such types cannot be added to a
;; namespace.
@@ -1079,7 +1078,7 @@ See also `soap-wsdl-resolve-references'."
:name name :namespace-tag soap-target-xmlns :id id))
(def (soap-xml-node-find-matching-child
node '(xsd:restriction xsd:extension xsd:union xsd:list))))
- (ecase (soap-l2wk (xml-node-name def))
+ (cl-ecase (soap-l2wk (xml-node-name def))
(xsd:restriction (soap-xs-add-restriction def type))
(xsd:extension (soap-xs-add-extension def type))
(xsd:union (soap-xs-add-union def type))
@@ -1090,10 +1089,10 @@ See also `soap-wsdl-resolve-references'."
(defun soap-xs-add-restriction (node type)
"Add restrictions defined in XML NODE to TYPE, an `soap-xs-simple-type'."
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:restriction)
- nil
- "expecting xsd:restriction node, got %s"
- (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'xsd:restriction)
+ nil
+ "expecting xsd:restriction node, got %s"
+ (soap-l2wk (xml-node-name node)))
(setf (soap-xs-simple-type-base type)
(soap-l2fq (xml-get-attribute node 'base)))
@@ -1101,7 +1100,7 @@ See also `soap-wsdl-resolve-references'."
(dolist (r (xml-node-children node))
(unless (stringp r) ; skip the white space
(let ((value (xml-get-attribute r 'value)))
- (case (soap-l2wk (xml-node-name r))
+ (cl-case (soap-l2wk (xml-node-name r))
(xsd:enumeration
(push value (soap-xs-simple-type-enumeration type)))
(xsd:pattern
@@ -1162,9 +1161,9 @@ See also `soap-wsdl-resolve-references'."
(defun soap-xs-add-union (node type)
"Add union members defined in XML NODE to TYPE, an `soap-xs-simple-type'."
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:union)
- nil
- "expecting xsd:union node, got %s" (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'xsd:union)
+ nil
+ "expecting xsd:union node, got %s" (soap-l2wk (xml-node-name node)))
(setf (soap-xs-simple-type-base type)
(mapcar 'soap-l2fq
@@ -1182,9 +1181,9 @@ See also `soap-wsdl-resolve-references'."
(defun soap-xs-add-list (node type)
"Add list defined in XML NODE to TYPE, a `soap-xs-simple-type'."
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:list)
- nil
- "expecting xsd:list node, got %s" (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'xsd:list)
+ nil
+ "expecting xsd:list node, got %s" (soap-l2wk (xml-node-name node)))
;; A simple type can be defined inline inside the list node or referenced by
;; the itemType attribute, in which case it will be resolved by the
@@ -1219,7 +1218,7 @@ See also `soap-wsdl-resolve-references'."
(defun soap-validate-xs-basic-type (value type)
"Validate VALUE against the basic type TYPE."
(let* ((kind (soap-xs-basic-type-kind type)))
- (case kind
+ (cl-case kind
((anyType Array byte[])
value)
(t
@@ -1384,7 +1383,7 @@ This is a specialization of `soap-decode-type' for
;;;;; soap-xs-complex-type
-(defstruct (soap-xs-complex-type (:include soap-xs-type))
+(cl-defstruct (soap-xs-complex-type (:include soap-xs-type))
indicator ; sequence, choice, all, array
base
elements
@@ -1400,12 +1399,12 @@ This is a specialization of `soap-decode-type' for
type
attributes
attribute-groups)
- (assert (memq node-name '(xsd:complexType xsd:complexContent xsd:group))
- nil "unexpected node: %s" node-name)
+ (cl-assert (memq node-name '(xsd:complexType xsd:complexContent xsd:group))
+ nil "unexpected node: %s" node-name)
(dolist (def (xml-node-children node))
(when (consp def) ; skip text nodes
- (case (soap-l2wk (xml-node-name def))
+ (cl-case (soap-l2wk (xml-node-name def))
(xsd:attribute (push (soap-xs-parse-attribute def) attributes))
(xsd:attributeGroup
(push (soap-xs-parse-attribute-group def)
@@ -1416,7 +1415,7 @@ This is a specialization of `soap-decode-type' for
(xsd:complexContent
(dolist (def (xml-node-children def))
(when (consp def)
- (case (soap-l2wk (xml-node-name def))
+ (cl-case (soap-l2wk (xml-node-name def))
(xsd:attribute
(push (soap-xs-parse-attribute def) attributes))
(xsd:attributeGroup
@@ -1447,15 +1446,15 @@ This is a specialization of `soap-decode-type' for
(defun soap-xs-parse-sequence (node)
"Parse a sequence definition from XML NODE.
Returns a `soap-xs-complex-type'"
- (assert (memq (soap-l2wk (xml-node-name node))
- '(xsd:sequence xsd:choice xsd:all))
- nil
- "unexpected node: %s" (soap-l2wk (xml-node-name node)))
+ (cl-assert (memq (soap-l2wk (xml-node-name node))
+ '(xsd:sequence xsd:choice xsd:all))
+ nil
+ "unexpected node: %s" (soap-l2wk (xml-node-name node)))
(let ((type (make-soap-xs-complex-type)))
(setf (soap-xs-complex-type-indicator type)
- (ecase (soap-l2wk (xml-node-name node))
+ (cl-ecase (soap-l2wk (xml-node-name node))
(xsd:sequence 'sequence)
(xsd:all 'all)
(xsd:choice 'choice)))
@@ -1465,7 +1464,7 @@ Returns a `soap-xs-complex-type'"
(dolist (r (xml-node-children node))
(unless (stringp r) ; skip the white space
- (case (soap-l2wk (xml-node-name r))
+ (cl-case (soap-l2wk (xml-node-name r))
((xsd:element xsd:group)
(push (soap-xs-parse-element r)
(soap-xs-complex-type-elements type)))
@@ -1489,10 +1488,10 @@ Returns a `soap-xs-complex-type'"
(defun soap-xs-parse-extension-or-restriction (node)
"Parse an extension or restriction definition from XML NODE.
Return a `soap-xs-complex-type'."
- (assert (memq (soap-l2wk (xml-node-name node))
- '(xsd:extension xsd:restriction))
- nil
- "unexpected node: %s" (soap-l2wk (xml-node-name node)))
+ (cl-assert (memq (soap-l2wk (xml-node-name node))
+ '(xsd:extension xsd:restriction))
+ nil
+ "unexpected node: %s" (soap-l2wk (xml-node-name node)))
(let (type
attributes
attribute-groups
@@ -1507,7 +1506,7 @@ Return a `soap-xs-complex-type'."
(dolist (def (xml-node-children node))
(when (consp def) ; skip text nodes
- (case (soap-l2wk (xml-node-name def))
+ (cl-case (soap-l2wk (xml-node-name def))
((xsd:sequence xsd:choice xsd:all)
(setq type (soap-xs-parse-sequence def)))
(xsd:attribute
@@ -1628,7 +1627,7 @@ position.
This is a specialization of `soap-encode-value' for
`soap-xs-complex-type' objects."
- (case (soap-xs-complex-type-indicator type)
+ (cl-case (soap-xs-complex-type-indicator type)
(array
(error "Arrays of type soap-encode-xs-complex-type are handled elsewhere"))
((sequence choice all nil)
@@ -1650,7 +1649,7 @@ This is a specialization of `soap-encode-value' for
(let ((e-name (intern e-name)))
(dolist (v value)
(when (equal (car v) e-name)
- (incf instance-count)
+ (cl-incf instance-count)
(soap-encode-value (cdr v) candidate))))
(if (soap-xs-complex-type-indicator type)
(let ((current-point (point)))
@@ -1658,12 +1657,12 @@ This is a specialization of `soap-encode-value' for
;; characters were inserted in the buffer.
(soap-encode-value value candidate)
(when (not (equal current-point (point)))
- (incf instance-count)))
+ (cl-incf instance-count)))
(dolist (v value)
(let ((current-point (point)))
(soap-encode-value v candidate)
(when (not (equal current-point (point)))
- (incf instance-count))))))))
+ (cl-incf instance-count))))))))
;; Do some sanity checking
(let* ((indicator (soap-xs-complex-type-indicator type))
(element-type (soap-xs-element-type element))
@@ -1801,7 +1800,7 @@ type-info stored in TYPE.
This is a specialization of `soap-decode-type' for
`soap-xs-basic-type' objects."
- (case (soap-xs-complex-type-indicator type)
+ (cl-case (soap-xs-complex-type-indicator type)
(array
(let ((result nil)
(element-type (soap-xs-complex-type-base type)))
@@ -1878,7 +1877,7 @@ This is a specialization of `soap-decode-type' for
(list node)))
(element-type (soap-xs-element-type element)))
(dolist (node children)
- (incf instance-count)
+ (cl-incf instance-count)
(let* ((attributes
(soap-decode-xs-attributes element-type node))
;; Attributes may specify xsi:type override.
@@ -1939,11 +1938,11 @@ This is a specialization of `soap-decode-type' for
;;;;; WSDL document elements
-(defstruct (soap-message (:include soap-element))
+(cl-defstruct (soap-message (:include soap-element))
parts ; ALIST of NAME => WSDL-TYPE name
)
-(defstruct (soap-operation (:include soap-element))
+(cl-defstruct (soap-operation (:include soap-element))
parameter-order
input ; (NAME . MESSAGE)
output ; (NAME . MESSAGE)
@@ -1951,13 +1950,13 @@ This is a specialization of `soap-decode-type' for
input-action ; WS-addressing action string
output-action) ; WS-addressing action string
-(defstruct (soap-port-type (:include soap-element))
+(cl-defstruct (soap-port-type (:include soap-element))
operations) ; a namespace of operations
;; A bound operation is an operation which has a soap action and a use
;; method attached -- these are attached as part of a binding and we
;; can have different bindings for the same operations.
-(defstruct soap-bound-operation
+(cl-defstruct soap-bound-operation
operation ; SOAP-OPERATION
soap-action ; value for SOAPAction HTTP header
soap-headers ; list of (message part use)
@@ -1966,11 +1965,11 @@ This is a specialization of `soap-decode-type' for
; http://www.w3.org/TR/wsdl#_soap:body
)
-(defstruct (soap-binding (:include soap-element))
+(cl-defstruct (soap-binding (:include soap-element))
port-type
(operations (make-hash-table :test 'equal) :readonly t))
-(defstruct (soap-port (:include soap-element))
+(cl-defstruct (soap-port (:include soap-element))
service-url
binding)
@@ -1978,10 +1977,10 @@ This is a specialization of `soap-decode-type' for
;;;;; The WSDL document
;; The WSDL data structure used for encoding/decoding SOAP messages
-(defstruct (soap-wsdl
- ;; NOTE: don't call this constructor, see `soap-make-wsdl'
- (:constructor soap-make-wsdl^)
- (:copier soap-copy-wsdl))
+(cl-defstruct (soap-wsdl
+ ;; NOTE: don't call this constructor, see `soap-make-wsdl'
+ (:constructor soap-make-wsdl^)
+ (:copier soap-copy-wsdl))
origin ; file or URL from which this wsdl was loaded
current-file ; most-recently fetched file or URL
xmlschema-imports ; a list of schema imports
@@ -2107,16 +2106,16 @@ used to resolve the namespace alias."
"Parse a schema NODE, placing the results in WSDL.
Return a SOAP-NAMESPACE containing the elements."
(soap-with-local-xmlns node
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:schema)
- nil
- "expecting an xsd:schema node, got %s"
- (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'xsd:schema)
+ nil
+ "expecting an xsd:schema node, got %s"
+ (soap-l2wk (xml-node-name node)))
(let ((ns (make-soap-namespace :name (soap-get-target-namespace node))))
(dolist (def (xml-node-children node))
(unless (stringp def) ; skip text nodes
- (case (soap-l2wk (xml-node-name def))
+ (cl-case (soap-l2wk (xml-node-name def))
(xsd:import
;; Imports will be processed later
;; NOTE: we should expand the location now!
@@ -2195,7 +2194,7 @@ See also `soap-resolve-references' and
(message (cdr input)))
;; Name this part if it was not named
(when (or (null name) (equal name ""))
- (setq name (format "in%d" (incf counter))))
+ (setq name (format "in%d" (cl-incf counter))))
(when (soap-name-p message)
(setf (soap-operation-input operation)
(cons (intern name)
@@ -2206,7 +2205,7 @@ See also `soap-resolve-references' and
(let ((name (car output))
(message (cdr output)))
(when (or (null name) (equal name ""))
- (setq name (format "out%d" (incf counter))))
+ (setq name (format "out%d" (cl-incf counter))))
(when (soap-name-p message)
(setf (soap-operation-output operation)
(cons (intern name)
@@ -2218,7 +2217,7 @@ See also `soap-resolve-references' and
(let ((name (car fault))
(message (cdr fault)))
(when (or (null name) (equal name ""))
- (setq name (format "fault%d" (incf counter))))
+ (setq name (format "fault%d" (cl-incf counter))))
(if (soap-name-p message)
(push (cons (intern name)
(soap-wsdl-get message wsdl 'soap-message-p))
@@ -2304,19 +2303,19 @@ traverse an element tree."
;; If this namespace does not have an alias, create one for it.
(catch 'done
(while t
- (setq nstag (format "ns%d" (incf nstag-id)))
+ (setq nstag (format "ns%d" (cl-incf nstag-id)))
(unless (assoc nstag alias-table)
(soap-wsdl-add-alias nstag (soap-namespace-name ns) wsdl)
(throw 'done t)))))
(maphash (lambda (_name element)
(cond ((soap-element-p element) ; skip links
- (incf nprocessed)
+ (cl-incf nprocessed)
(soap-resolve-references element wsdl))
((listp element)
(dolist (e element)
(when (soap-element-p e)
- (incf nprocessed)
+ (cl-incf nprocessed)
(soap-resolve-references e wsdl))))))
(soap-namespace-elements ns)))))
wsdl)
@@ -2391,9 +2390,9 @@ Build on WSDL if it is provided."
"Assert that NODE is valid."
(soap-with-local-xmlns node
(let ((node-name (soap-l2wk (xml-node-name node))))
- (assert (eq node-name 'wsdl:definitions)
- nil
- "expecting wsdl:definitions node, got %s" node-name))))
+ (cl-assert (eq node-name 'wsdl:definitions)
+ nil
+ "expecting wsdl:definitions node, got %s" node-name))))
(defun soap-parse-wsdl-phase-fetch-imports (node wsdl)
"Fetch and load files imported by NODE into WSDL."
@@ -2473,10 +2472,10 @@ Build on WSDL if it is provided."
(defun soap-parse-message (node)
"Parse NODE as a wsdl:message and return the corresponding type."
- (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:message)
- nil
- "expecting wsdl:message node, got %s"
- (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:message)
+ nil
+ "expecting wsdl:message node, got %s"
+ (soap-l2wk (xml-node-name node)))
(let ((name (xml-get-attribute-or-nil node 'name))
parts)
(dolist (p (soap-xml-get-children1 node 'wsdl:part))
@@ -2500,10 +2499,10 @@ Build on WSDL if it is provided."
(defun soap-parse-port-type (node)
"Parse NODE as a wsdl:portType and return the corresponding port."
- (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:portType)
- nil
- "expecting wsdl:portType node got %s"
- (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:portType)
+ nil
+ "expecting wsdl:portType node got %s"
+ (soap-l2wk (xml-node-name node)))
(let* ((soap-target-xmlns (concat "urn:" (xml-get-attribute node 'name)))
(ns (make-soap-namespace :name soap-target-xmlns)))
(dolist (node (soap-xml-get-children1 node 'wsdl:operation))
@@ -2522,14 +2521,14 @@ Build on WSDL if it is provided."
;; link all messages from this namespace, as this namespace
;; will be used for decoding the response.
- (destructuring-bind (name . message) (soap-operation-input o)
+ (cl-destructuring-bind (name . message) (soap-operation-input o)
(soap-namespace-put-link name message ns))
- (destructuring-bind (name . message) (soap-operation-output o)
+ (cl-destructuring-bind (name . message) (soap-operation-output o)
(soap-namespace-put-link name message ns))
(dolist (fault (soap-operation-faults o))
- (destructuring-bind (name . message) fault
+ (cl-destructuring-bind (name . message) fault
(soap-namespace-put-link name message ns)))
)))))
@@ -2539,10 +2538,10 @@ Build on WSDL if it is provided."
(defun soap-parse-operation (node)
"Parse NODE as a wsdl:operation and return the corresponding type."
- (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:operation)
- nil
- "expecting wsdl:operation node, got %s"
- (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:operation)
+ nil
+ "expecting wsdl:operation node, got %s"
+ (soap-l2wk (xml-node-name node)))
(let ((name (xml-get-attribute node 'name))
(parameter-order (split-string
(xml-get-attribute node 'parameterOrder)))
@@ -2579,10 +2578,10 @@ Build on WSDL if it is provided."
(defun soap-parse-binding (node)
"Parse NODE as a wsdl:binding and return the corresponding type."
- (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:binding)
- nil
- "expecting wsdl:binding node, got %s"
- (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:binding)
+ nil
+ "expecting wsdl:binding node, got %s"
+ (soap-l2wk (xml-node-name node)))
(let ((name (xml-get-attribute node 'name))
(type (xml-get-attribute node 'type)))
(let ((binding (make-soap-binding :name name
@@ -2693,8 +2692,8 @@ decode function to perform the actual decoding."
(when result (throw 'done result))))))
(t
(let ((decoder (get (aref type 0) 'soap-decoder)))
- (assert decoder nil
- "no soap-decoder for %s type" (aref type 0))
+ (cl-assert decoder nil
+ "no soap-decoder for %s type" (aref type 0))
(funcall decoder type node))))))))))
(defun soap-decode-any-type (node)
@@ -2769,10 +2768,10 @@ decode function to perform the actual decoding."
OPERATION is the WSDL operation for which we expect the response,
WSDL is used to decode the NODE"
(soap-with-local-xmlns node
- (assert (eq (soap-l2wk (xml-node-name node)) 'soap:Envelope)
- nil
- "expecting soap:Envelope node, got %s"
- (soap-l2wk (xml-node-name node)))
+ (cl-assert (eq (soap-l2wk (xml-node-name node)) 'soap:Envelope)
+ nil
+ "expecting soap:Envelope node, got %s"
+ (soap-l2wk (xml-node-name node)))
(let ((headers (soap-xml-get-children1 node 'soap:Header))
(body (car (soap-xml-get-children1 node 'soap:Body))))
@@ -2879,8 +2878,8 @@ for the type and calls that specialized function to do the work.
Attributes are inserted in the current buffer at the current
position."
(let ((attribute-encoder (get (aref type 0) 'soap-attribute-encoder)))
- (assert attribute-encoder nil
- "no soap-attribute-encoder for %s type" (aref type 0))
+ (cl-assert attribute-encoder nil
+ "no soap-attribute-encoder for %s type" (aref type 0))
(funcall attribute-encoder value type)))
(defun soap-encode-value (value type)
@@ -2893,7 +2892,7 @@ is to be encoded. This is a generic function which finds an
encoder function based on TYPE and calls that encoder to do the
work."
(let ((encoder (get (aref type 0) 'soap-encoder)))
- (assert encoder nil "no soap-encoder for %s type" (aref type 0))
+ (cl-assert encoder nil "no soap-encoder for %s type" (aref type 0))
(funcall encoder value type))
(when (soap-element-namespace-tag type)
(add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag type))))
@@ -2909,9 +2908,9 @@ being used."
(use (soap-bound-operation-use operation))
(message (cdr (soap-operation-input op)))
(parameter-order (soap-operation-parameter-order op))
- (param-table (loop for formal in parameter-order
- for value in parameters
- collect (cons formal value))))
+ (param-table (cl-loop for formal in parameter-order
+ for value in parameters
+ collect (cons formal value))))
(unless (= (length parameter-order) (length parameters))
(error "Wrong number of parameters for %s: expected %d, got %s"
@@ -3059,41 +3058,41 @@ OPERATION-NAME and PARAMETERS are as described in `soap-invoke'."
(lambda (status)
(let ((data-buffer (current-buffer)))
(unwind-protect
- (let ((error-status (plist-get status :error)))
- (if error-status
- (signal (car error-status) (cdr error-status))
- (apply callback
- (soap-parse-envelope
- (soap-parse-server-response)
- operation wsdl)
- cbargs)))
+ (let ((error-status (plist-get status :error)))
+ (if error-status
+ (signal (car error-status) (cdr error-status))
+ (apply callback
+ (soap-parse-envelope
+ (soap-parse-server-response)
+ operation wsdl)
+ cbargs)))
;; Ensure the url-retrieve buffer is not leaked.
(and (buffer-live-p data-buffer)
(kill-buffer data-buffer))))))
- (let ((buffer (url-retrieve-synchronously
- (soap-port-service-url port))))
- (condition-case err
- (with-current-buffer buffer
- (declare (special url-http-response-status))
- (if (null url-http-response-status)
- (error "No HTTP response from server"))
- (if (and soap-debug (> url-http-response-status 299))
- ;; This is a warning because some SOAP errors come
- ;; back with a HTTP response 500 (internal server
- ;; error)
- (warn "Error in SOAP response: HTTP code %s"
- url-http-response-status))
- (soap-parse-envelope (soap-parse-server-response)
- operation wsdl))
- (soap-error
- ;; Propagate soap-errors -- they are error replies of the
- ;; SOAP protocol and don't indicate a communication
- ;; problem or a bug in this code.
- (signal (car err) (cdr err)))
- (error
- (when soap-debug
- (pop-to-buffer buffer))
- (error (error-message-string err)))))))))
+ (let ((buffer (url-retrieve-synchronously
+ (soap-port-service-url port))))
+ (condition-case err
+ (with-current-buffer buffer
+ (declare (special url-http-response-status))
+ (if (null url-http-response-status)
+ (error "No HTTP response from server"))
+ (if (and soap-debug (> url-http-response-status 299))
+ ;; This is a warning because some SOAP errors come
+ ;; back with a HTTP response 500 (internal server
+ ;; error)
+ (warn "Error in SOAP response: HTTP code %s"
+ url-http-response-status))
+ (soap-parse-envelope (soap-parse-server-response)
+ operation wsdl))
+ (soap-error
+ ;; Propagate soap-errors -- they are error replies of the
+ ;; SOAP protocol and don't indicate a communication
+ ;; problem or a bug in this code.
+ (signal (car err) (cdr err)))
+ (error
+ (when soap-debug
+ (pop-to-buffer buffer))
+ (error (error-message-string err)))))))))
(defun soap-invoke (wsdl service operation-name &rest parameters)
"Invoke a SOAP operation and return the result.