tsd2xsd generator code

proc define {element sequence {documentation {}}} {
    if {  [llength $sequence] == 1 &&
          [string range $sequence 0 3] eq "xsd:"
    } {
        emitElement $element $sequence $documentation
        return
    }  
    set typename ${element}Type
    emitElement $element $typename 
    emitTypeDef $typename $sequence $documentation
}  

proc extension {element baseType attributes {documentation {}}} {
    emit [subst {<xsd:element name="$element" type="${element}Type"/>
<xsd:complexType name="${element}Type">
    <xsd:annotation>
        <xsd:documentation>$documentation</xsd:documentation>
    </xsd:annotation>
    <xsd:simpleContent>
        <xsd:extension base="$baseType">
    }]  
    foreach attribute $attributes {
        lassign $attribute name doc 
        emit [ subst {    <xsd:attribute name="$name" use="optional">
                <xsd:annotation>
                    <xsd:documentation>$doc</xsd:documentation>
                </xsd:annotation>
            </xsd:attribute>}]
            
    }
    emit {
            </xsd:extension>
    </xsd:simpleContent>
</xsd:complexType>}

}

proc text text {
    emit $text\n
}

proc include {filename} {
    set f [open $filename]
    fconfigure $f -encoding utf-8
    emit \n[read $f]\n
    close $f
}

proc emitElement {element type {documentation {}}} {
    if {$element eq {}} {
        set cardinality {}
        switch -- [string index $type end] {
            + {
                set type [string range $type 0 end-1 ]
                set cardinality {minOccurs="1" maxOccurs="unbounded"}
            }
            ? {
                set type [string range $type 0 end-1 ]
                set cardinality {minOccurs="0" maxOccurs="1"}
            }
            ! {
                set type [string range $type 0 end-1 ]
                set cardinality {minOccurs="1" maxOccurs="1"}
            }
        }
        emit "<xsd:element $cardinality ref=\"$type\">\n"
    } {
        emit "<xsd:element name=\"$element\" type=\"$type\">\n"
    }
    if {$documentation ne {}} {
        emit "<xsd:annotation>\n"
        emit "<xsd:documentation>$documentation</xsd:documentation>\n"
        emit "</xsd:annotation>\n"
    }
    emit "</xsd:element>\n"
}

proc emitSequence {sequence} {
    emit "<xsd:sequence>\n"
    foreach item $sequence {
        emitElement {} $item
    }
    emit "</xsd:sequence>\n"
}

proc emitTypeDef {type sequence documentation} {
    emit "<xsd:complexType name=\"$type\">\n"
    if {$documentation ne {}} {
        emit "<xsd:annotation>\n"
        emit "<xsd:documentation>$documentation</xsd:documentation>\n"
        emit "</xsd:annotation>\n"
    }
    emitSequence $sequence
    emit "</xsd:complexType>\n"
}

proc emit text {
    append ::result $text
}

if {$argc < 1 || $argc > 2} {
    puts stderr "Usage: tsd2xsd tsd-file ?xsd-file?"
    exit
}


set path [pwd]
cd [file dirname [lindex $argv 1]] 

set result ""
lassign $argv tsd xsd
source -encoding utf-8 $tsd
package require tdom
if {$xsd ne {} } {
    set f [open $xsd w]
    fconfigure $f -encoding utf-8
} else {
    set f stdout
}
puts $f {<?xml version="1.0" encoding="UTF-8"?>}
if {[catch {puts $f [[dom parse $result] asXML]} error]} {
    puts stderr $error
    puts $f $result
}
close $f

cd $path