[cl-soap-cvs] CVS update: cl-soap/src/xsd.lisp
Sven Van Caekenberghe
scaekenberghe at common-lisp.net
Tue Sep 27 18:22:55 UTC 2005
Update of /project/cl-soap/cvsroot/cl-soap/src
In directory common-lisp.net:/tmp/cvs-serv24844/src
Modified Files:
xsd.lisp
Log Message:
some refactoring
Date: Tue Sep 27 20:22:54 2005
Author: scaekenberghe
Index: cl-soap/src/xsd.lisp
diff -u cl-soap/src/xsd.lisp:1.16 cl-soap/src/xsd.lisp:1.17
--- cl-soap/src/xsd.lisp:1.16 Tue Sep 27 18:25:17 2005
+++ cl-soap/src/xsd.lisp Tue Sep 27 20:22:53 2005
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: xsd.lisp,v 1.16 2005/09/27 16:25:17 scaekenberghe Exp $
+;;;; $Id: xsd.lisp,v 1.17 2005/09/27 18:22:53 scaekenberghe Exp $
;;;;
;;;; A partial implementation of the XML Schema Definition standard
;;;;
@@ -73,71 +73,60 @@
;;; Parsing
+(defun handle-lxml-schema-elements (children-mixin lxml)
+ (loop :for child :in (lxml-get-children lxml)
+ :do (push (lxml->schema-element child)
+ (get-children children-mixin)))
+ (setf (get-children children-mixin) (nreverse (get-children children-mixin))))
+
(defun lxml->schema-element (lxml)
- (case (lxml-get-tag lxml)
- (xsd:|element|
- (let* ((attributes (lxml-get-attributes lxml))
- (name (getf attributes :|name|))
- (type (getf attributes :|type|))
- (min-occurs (getf attributes :|minOccurs|))
- (max-occurs (getf attributes :|maxOccurs|))
- (nillable (getf attributes :|nillable|))
- (xml-schema-element (make-instance 'xml-schema-element
- :name name
- :type type
- :min-occurs (if min-occurs (parse-integer min-occurs) 1)
- :max-occurs (if max-occurs
- (if (equal max-occurs "unbounded")
- :unbounded
- (parse-integer max-occurs))
- 1)
- :nillable (equal nillable "true"))))
- (loop :for child :in (lxml-get-children lxml) :do
- (push (lxml->schema-element child)
- (get-children xml-schema-element)))
- xml-schema-element))
- (xsd:|simpleType|
- (let* ((attributes (lxml-get-attributes lxml))
- (name (getf attributes :|name|))
- (xsd-type (make-instance 'xsd-simple-type :name name)))
- (loop :for child :in (lxml-get-children lxml) :do
- (push (lxml->schema-element child)
- (get-children xsd-type)))
- xsd-type))
- (xsd:|complexType|
- (let* ((attributes (lxml-get-attributes lxml))
- (name (getf attributes :|name|))
- (xsd-type (make-instance 'xsd-complex-type :name name)))
- (loop :for child :in (lxml-get-children lxml) :do
- (push (lxml->schema-element child)
- (get-children xsd-type)))
- xsd-type))
- (xsd:|complexContent|
- (let* ((xsd-complex-content (make-instance 'xsd-complex-content)))
- (loop :for child :in (lxml-get-children lxml) :do
- (push (lxml->schema-element child)
- (get-children xsd-complex-content)))
- xsd-complex-content))
- (xsd:|restriction|
- (let* ((attributes (lxml-get-attributes lxml))
- (base (getf attributes :|base|))
- (xsd-restriction (make-instance 'xsd-restriction :base base)))
- xsd-restriction))
- (xsd:|extension|
- (let* ((attributes (lxml-get-attributes lxml))
- (base (getf attributes :|base|))
- (xsd-extension (make-instance 'xsd-extension :base base)))
- (loop :for child :in (lxml-get-children lxml) :do
- (push (lxml->schema-element child)
- (get-children xsd-extension)))
- xsd-extension))
- (xsd:|sequence|
- (let ((xsd-sequence (make-instance 'xsd-sequence)))
- (loop :for child :in (lxml-get-children lxml) :do
- (push (lxml->schema-element child)
- (get-children xsd-sequence)))
- (setf (get-children xsd-sequence) (nreverse (get-children xsd-sequence)))
- xsd-sequence))))
+ (let ((attributes (lxml-get-attributes lxml)))
+ (case (lxml-get-tag lxml)
+ (xsd:|element|
+ (let* ((name (getf attributes :|name|))
+ (type (getf attributes :|type|))
+ (min-occurs (getf attributes :|minOccurs|))
+ (max-occurs (getf attributes :|maxOccurs|))
+ (nillable (getf attributes :|nillable|))
+ (xml-schema-element (make-instance 'xml-schema-element
+ :name name
+ :type type
+ :min-occurs (if min-occurs (parse-integer min-occurs) 1)
+ :max-occurs (if max-occurs
+ (if (equal max-occurs "unbounded")
+ :unbounded
+ (parse-integer max-occurs))
+ 1)
+ :nillable (equal nillable "true"))))
+ (handle-lxml-schema-elements xml-schema-element lxml)
+ xml-schema-element))
+ (xsd:|simpleType|
+ (let* ((name (getf attributes :|name|))
+ (xsd-type (make-instance 'xsd-simple-type :name name)))
+ (handle-lxml-schema-elements xsd-type lxml)
+ xsd-type))
+ (xsd:|complexType|
+ (let* ((name (getf attributes :|name|))
+ (xsd-type (make-instance 'xsd-complex-type :name name)))
+ (handle-lxml-schema-elements xsd-type lxml)
+ xsd-type))
+ (xsd:|complexContent|
+ (let ((xsd-complex-content (make-instance 'xsd-complex-content)))
+ (handle-lxml-schema-elements xsd-complex-content lxml)
+ xsd-complex-content))
+ (xsd:|restriction|
+ (let* ((base (getf attributes :|base|))
+ (xsd-restriction (make-instance 'xsd-restriction :base base)))
+ xsd-restriction))
+ (xsd:|extension|
+ (let* ((base (getf attributes :|base|))
+ (xsd-extension (make-instance 'xsd-extension :base base)))
+ (handle-lxml-schema-elements xsd-extension lxml)
+ xsd-extension))
+ (xsd:|sequence|
+ (let ((xsd-sequence (make-instance 'xsd-sequence)))
+ (handle-lxml-schema-elements xsd-sequence lxml)
+ xsd-sequence)))))
(defun lxml->schema-definition (lxml)
(if (eql (lxml-get-tag lxml) 'xsd:|schema|)
More information about the Cl-soap-cvs
mailing list