make-element children

[Jim White <jim at pagesmiths dot com>]

Hi Per.

I was using make-element to generate XML output with lists of children. 
 Unfortunately the only two ways I found to make it work was to either 
do everything with macros or to use apply.  Neither is quite satisfying, 
and mixing the two is ugly.  Although perhaps there would be something I 
could do with the macros and currying make-element?

I've attached the code I was using.  Is there something I could do to 
make the code more concise?  If I'm gonna make all those macros, I would 
like to be able to reuse them for the lists.  Also I was thinking I 
should be able to make a readmacro that does something like this:

(<SEQUENCE> (<ELEMENT> (@NAME 'foo)))

Where the <name> stuff expands to (make-element 'name ...) and similarly 
for @attr.  But then the trick would still need to work for lists:

(apply <SEQUENCE> (map (lambda (x) (<ELEMENT> (@NAME (car x)))) '(foo 
bar baz))

But I would want a macro deal for that too somehow:

(<SEQUENCE> :children: (map (lambda (x) (car x)) '(foo bar baz)))

Otherwise I get <sequence><list><element ... which isn't right.

Any pointers appreciated.

jim
(require 'xml)
(define-syntax XSD:SCHEMA
   (syntax-rules ()  ((XSD:SCHEMA . rest) (make-element 'xsd:schema . rest))))

(define-syntax XSD:ELEMENT
   (syntax-rules ()  ((XSD:ELEMENT . rest) (make-element 'xsd:element . rest))))

(define-syntax XSD:COMPLEXTYPE
   (syntax-rules ()  ((XSD:COMPLEXTYPE . rest) (make-element 'xsd:complexType . rest))))

(define-syntax XSD:SIMPLETYPE
   (syntax-rules ()  ((XSD:SIMPLETYPE . rest) (make-element 'xsd:simpleType . rest))))

(define-syntax XSD:ATTRIBUTE
   (syntax-rules ()  ((XSD:ATTRIBUTE . rest) (make-element 'xsd:attribute . rest))))

(define-syntax ATTR:NAME
   (syntax-rules ()  ((ATTR:NAME value) (make-attribute 'name value))))
(define-syntax ATTR:REF
   (syntax-rules ()  ((ATTR:REF value) (make-attribute 'ref value))))
(define-syntax ATTR:TYPE
   (syntax-rules ()  ((ATTR:NAME value) (make-attribute 'type value))))
(define-syntax ATTR:ORDER
   (syntax-rules ()  ((ATTR:ORDER value) (make-attribute 'order value))))
(define-syntax ATTR:CONTENT
   (syntax-rules ()  ((ATTR:CONTENT value) (make-attribute 'content value))))
(define-syntax ATTR:MINOCCURS
   (syntax-rules ()  ((ATTR:MINOCCURS value) (make-attribute 'minOccurs value))))
(define-syntax ATTR:MAXOCCURS
   (syntax-rules ()  ((ATTR:MAXOCCURS value) (make-attribute 'maxOccurs value))))

(define-syntax field
   (syntax-rules () 
      ((field name) (field name 'xsd:string))
      ((field name type) (field name type 0 1))
      ((field name type min max) 
       (XSD:ELEMENT (ATTR:NAME name) (ATTR:TYPE type)
                    (ATTR:MINOCCURS min) (ATTR:MAXOCCURS max)))))

(define fields 
   (list 
      (field 'f1_name) 
      (field 'f2_sponsor) 
      (field 'f3_trustees 'xsd:string 0 4)))

(define get-field-elements 
   (lambda (fields)
      (map (lambda (f) (XSD:ELEMENT (ATTR:NAME f) (ATTR:TYPE 'string))) fields)))

(define-syntax record-schema
   (syntax-rules ()
       ((record-schema name fields)
        (XSD:SCHEMA (make-attribute 'xmlns:xsd "http://www.w3.org/2001/XMLSchema";)
                    (make-attribute 'targetNamespace "http://com.stuarthack.com/schema/Sponsor";)
           (XSD:ELEMENT (ATTR:NAME name)
              (XSD:COMPLEXTYPE
                 (apply make-element 'xsd:sequence fields)))))))

(display "<?xml version='1.0'?>")
(write (as-xml (record-schema 'Sponsor fields)))