From 349fbb35513f001a49623be8fe6704cda4ca48e2 Mon Sep 17 00:00:00 2001 From: Alex Harsanyi Date: Wed, 24 May 2017 14:18:39 -0400 Subject: [PATCH] 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 --- lisp/net/soap-client.el | 311 +++++++++++++++++++-------------------- lisp/net/soap-inspect.el | 93 ++++++------ 2 files changed, 201 insertions(+), 203 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 "\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. diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index db83cf8463e..cd14eddb4f4 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -37,8 +37,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) - +(require 'cl-lib) (require 'soap-client) ;;; sample-value @@ -53,13 +52,13 @@ will be called." (let ((sample-value (get (aref type 0) 'soap-sample-value))) (if sample-value (funcall sample-value type) - (error "Cannot provide sample value for type %s" (aref type 0))))) + (error "Cannot provide sample value for type %s" (aref type 0))))) (defun soap-sample-value-for-xs-basic-type (type) "Provide a sample value for TYPE, an xs-basic-type. This is a specialization of `soap-sample-value' for xs-basic-type objects." - (case (soap-xs-basic-type-kind type) + (cl-case (soap-xs-basic-type-kind type) (string "a string") (anyURI "an URI") (QName "a QName") @@ -77,7 +76,7 @@ objects." (if (soap-xs-element-name element) (cons (intern (soap-xs-element-name element)) (soap-sample-value (soap-xs-element-type element))) - (soap-sample-value (soap-xs-element-type element)))) + (soap-sample-value (soap-xs-element-type element)))) (defun soap-sample-value-for-xs-attribute (attribute) "Provide a sample value for ATTRIBUTE, a WSDL attribute. @@ -119,20 +118,20 @@ This is a specialization of `soap-sample-value' for ((soap-xs-simple-type-pattern type) (format "a string matching %s" (soap-xs-simple-type-pattern type))) ((soap-xs-simple-type-length-range type) - (destructuring-bind (low . high) (soap-xs-simple-type-length-range type) + (cl-destructuring-bind (low . high) (soap-xs-simple-type-length-range type) (cond - ((and low high) - (format "a string between %d and %d chars long" low high)) - (low (format "a string at least %d chars long" low)) - (high (format "a string at most %d chars long" high)) - (t (format "a string OOPS"))))) + ((and low high) + (format "a string between %d and %d chars long" low high)) + (low (format "a string at least %d chars long" low)) + (high (format "a string at most %d chars long" high)) + (t (format "a string OOPS"))))) ((soap-xs-simple-type-integer-range type) - (destructuring-bind (min . max) (soap-xs-simple-type-integer-range type) + (cl-destructuring-bind (min . max) (soap-xs-simple-type-integer-range type) (cond - ((and min max) (+ min (random (- max min)))) - (min (+ min (random 10))) - (max (random max)) - (t (random 100))))) + ((and min max) (+ min (random (- max min)))) + (min (+ min (random 10))) + (max (random max)) + (t (random 100))))) ((consp (soap-xs-simple-type-base type)) ; an union of values (let ((base (soap-xs-simple-type-base type))) (soap-sample-value (nth (random (length base)) base)))) @@ -146,7 +145,7 @@ This is a specialization of `soap-sample-value' for (append (mapcar 'soap-sample-value-for-xs-attribute (soap-xs-type-attributes type)) - (case (soap-xs-complex-type-indicator type) + (cl-case (soap-xs-complex-type-indicator type) (array (let* ((element-type (soap-xs-complex-type-base type)) (sample1 (soap-sample-value element-type)) @@ -251,24 +250,24 @@ entire WSDL can be inspected." (define-button-type 'soap-client-describe-link - 'face 'link - 'help-echo "mouse-2, RET: describe item" - 'follow-link t - 'action (lambda (button) - (let ((item (button-get button 'item))) - (soap-inspect item))) - 'skip t) + 'face 'link + 'help-echo "mouse-2, RET: describe item" + 'follow-link t + 'action (lambda (button) + (let ((item (button-get button 'item))) + (soap-inspect item))) + 'skip t) (define-button-type 'soap-client-describe-back-link - 'face 'link - 'help-echo "mouse-2, RET: browse the previous item" - 'follow-link t - 'action (lambda (_button) - (let ((item (pop soap-inspect-previous-items))) - (when item - (setq soap-inspect-current-item nil) - (soap-inspect item)))) - 'skip t) + 'face 'link + 'help-echo "mouse-2, RET: browse the previous item" + 'follow-link t + 'action (lambda (_button) + (let ((item (pop soap-inspect-previous-items))) + (when item + (setq soap-inspect-current-item nil) + (soap-inspect item)))) + 'skip t) (defun soap-insert-describe-button (element) "Insert a button to inspect ELEMENT when pressed." @@ -323,7 +322,7 @@ soap-xs-attribute-group, in the current buffer." (insert ", ") (setq first-time nil)) (soap-insert-describe-button b))) - (soap-insert-describe-button (soap-xs-simple-type-base type))) + (soap-insert-describe-button (soap-xs-simple-type-base type))) (insert "\nAttributes: ") (dolist (attribute (soap-xs-simple-type-attributes type)) (let ((name (or (soap-xs-attribute-name attribute) "*inline*")) @@ -359,7 +358,7 @@ soap-xs-attribute-group, in the current buffer." TYPE is a `soap-xs-complex-type'" (insert "Complex type: " (soap-element-fq-name type)) (insert "\nKind: ") - (case (soap-xs-complex-type-indicator type) + (cl-case (soap-xs-complex-type-indicator type) ((sequence all) (insert "a sequence ") (when (soap-xs-complex-type-base type) @@ -394,10 +393,10 @@ TYPE is a `soap-xs-complex-type'" (insert (make-string (- type-width (length (soap-element-fq-name type))) ?\ )) - (when (soap-xs-element-multiple? element) - (insert " multiple")) - (when (soap-xs-element-optional? element) - (insert " optional")))))) + (when (soap-xs-element-multiple? element) + (insert " multiple")) + (when (soap-xs-element-optional? element) + (insert " optional")))))) (choice (insert "a choice ") (when (soap-xs-complex-type-base type) @@ -449,11 +448,11 @@ TYPE is a `soap-xs-complex-type'" "Insert information about PORT-TYPE into the current buffer." (insert "Port-type name: " (soap-element-fq-name port-type) "\n") (insert "Operations:\n") - (loop for o being the hash-values of - (soap-namespace-elements (soap-port-type-operations port-type)) - do (progn - (insert "\t") - (soap-insert-describe-button (car o))))) + (cl-loop for o being the hash-values of + (soap-namespace-elements (soap-port-type-operations port-type)) + do (progn + (insert "\t") + (soap-insert-describe-button (car o))))) (defun soap-inspect-binding (binding) "Insert information about BINDING into the current buffer." @@ -461,13 +460,13 @@ TYPE is a `soap-xs-complex-type'" (insert "\n") (insert "Bound operations:\n") (let* ((ophash (soap-binding-operations binding)) - (operations (loop for o being the hash-keys of ophash - collect o)) + (operations (cl-loop for o being the hash-keys of ophash + collect o)) op-name-width) (setq operations (sort operations 'string<)) - (setq op-name-width (loop for o in operations maximizing (length o))) + (setq op-name-width (cl-loop for o in operations maximizing (length o))) (dolist (op operations) (let* ((bound-op (gethash op ophash)) -- 2.39.2