[cl-soap-cvs] CVS update: cl-soap/src/xsd.lisp

[Sven Van Caekenberghe]

Update of /project/cl-soap/cvsroot/cl-soap/src
In directory common-lisp.net:/tmp/cvs-serv9383/src

Modified Files:
	xsd.lisp 
Log Message:
various bugfixes

Date: Fri Sep 30 21:58:05 2005
Author: scaekenberghe

Index: cl-soap/src/xsd.lisp
diff -u cl-soap/src/xsd.lisp:1.20 cl-soap/src/xsd.lisp:1.21
--- cl-soap/src/xsd.lisp:1.20	Fri Sep 30 21:21:43 2005
+++ cl-soap/src/xsd.lisp	Fri Sep 30 21:58:05 2005
@@ -1,6 +1,6 @@
 ;;;; -*- mode: lisp -*-
 ;;;;
-;;;; $Id: xsd.lisp,v 1.20 2005/09/30 19:21:43 scaekenberghe Exp $
+;;;; $Id: xsd.lisp,v 1.21 2005/09/30 19:58:05 scaekenberghe Exp $
 ;;;;
 ;;;; A partial implementation of the XML Schema Definition standard
 ;;;;
@@ -358,6 +358,7 @@
 ;; ELT = ( <multiplicity> "element-name" [ :primitive | ELT* ] )
 ;; where <multiplicity> is 1, ?, + or * and :primitive is a XSD primitive type keyword
 ;; all element types are resolved into primitives or sequences of sub elements
+;; elements without contents are also possible
 
 (defun get-xsd-template-multiplicity (xml-schema-element)
   (with-slots (min-occurs max-occurs)
@@ -464,29 +465,33 @@
       template
     (let* ((tag (intern element-name (s-xml:get-package namespace)))
            (children (lxml-find-tags tag lxml)))
-      (if (symbolp (first contents))
-          (let ((primitive-type (first contents)))
-            (case multiplicity
-              ((1 ?) (if children
-                         (resolve-xsd-template-primitive element-name primitive-type (second (first children)))
-                       (when (eql multiplicity 1)
-                         (error "Required element ~s not bound" element-name))))
-              ((+ *) (if children
-                         (loop :for child :in children
-                               :collect (resolve-xsd-template-primitive element-name primitive-type (second child)))
-                       (when (eql multiplicity +)
-                         (error "Required repeating element ~s not bound correctly" element-name))))))
-          (case multiplicity
-            ((1 ?) (if children
-                       `(,element-name ,(resolve-xsd-template-members contents (first children) namespace))
-                     (when (eql multiplicity 1)
-                       (error "Required element ~s not bound" element-name))))
-            ((+ *) (if children
-                       `(,element-name
-                         ,(loop :for child :in children
-                                :collect (resolve-xsd-template-members contents child namespace)))
-                     (when (eql multiplicity +)
-                       (error "Required repeating element ~s not bound correctly" element-name)))))))))
+      (cond ((null contents) `(,element-name))
+            ((symbolp (first contents))
+             (let ((primitive-type (first contents)))
+               (case multiplicity
+                 ((1 ?) (if children
+                            (resolve-xsd-template-primitive element-name primitive-type 
+                                                            (lxml-get-contents (first children)))
+                          (when (eql multiplicity 1)
+                            (error "Required element ~s not bound" element-name))))
+                 ((+ *) (if children
+                            (loop :for child :in children
+                                  :collect (resolve-xsd-template-primitive element-name primitive-type 
+                                                                           (lxml-get-contents child)))
+                          (when (eql multiplicity +)
+                            (error "Required repeating element ~s not bound correctly" element-name)))))))
+            (t
+             (case multiplicity
+               ((1 ?) (if children
+                          `(,element-name ,(resolve-xsd-template-members contents (first children) namespace))
+                        (when (eql multiplicity 1)
+                          (error "Required element ~s not bound" element-name))))
+               ((+ *) (if children
+                          `(,element-name
+                            ,(loop :for child :in children
+                                   :collect (resolve-xsd-template-members contents child namespace)))
+                        (when (eql multiplicity +)
+                          (error "Required repeating element ~s not bound correctly" element-name))))))))))
 
 (defun resolve-element (element lxml xml-schema-definition namespace)
   (let ((template (generate-xsd-template element xml-schema-definition)))