REBOL [
	Title: "XML-Language"
	Author: ["RebolTech" "Ingo Hohmann"]
	purpose: [
		{empty attributes are returned as "", not as none}
		{attribute names and tags as words}
	]
]

xml-language: make object! [
    verbose: false
    joinset: func [cset chars][insert copy cset chars]
    diffset: func [cset chars][remove/part copy cset chars]
    error: func [msg arg][print [msg arg] halt]
    space: make bitset! #{
0026000001000000000000000000000000000000000000000000000000000000
}
    char: make bitset! #{
00260000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
}
    letter: make bitset! #{
0100000000000000FEFFFF07FEFFFF070000000000000000FFFF7FFFFFFF7F01
}
    digit: make bitset! #{
000000000000FF03000000000000000000000000000000000000000000000000
}
    alpha-num: make bitset! #{
010000000000FF03FEFFFF07FEFFFF070000000000000000FFFF7FFFFFFF7F01
}
    name-first: make bitset! #{
0100000000000004FEFFFF87FEFFFF070000000000000000FFFF7FFFFFFF7F01
}
    name-chars: make bitset! #{
010000000060FF07FEFFFF87FEFFFF070000000000000000FFFF7FFFFFFF7F01
}
    data-chars: make bitset! #{
00260000FFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
}
    qt1: "'"
    qt2: {"}
    data-chars-qt1: make bitset! #{
002600007FFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
}
    data-chars-qt2: make bitset! #{
00260000FBFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
}
    name: [name-first any name-chars]
    sp: [some space]
    sp?: [any space]
    parents: []
    new-node: func [name][
        if verbose [print ["New tag:" name]] 
        insert/only tail parents parent 
        parent: add-kid copy reduce [name none none] ; (iho)
    ]
    end-node: func [name][
        while [name <> first parent] [
            if verbose [print ["unterminated tag:" first parent]] 
            if empty? parents [error "End tag error:" name] 
            pop-parent
        ] 
        pop-parent
    ]
    pop-parent: func [][
        parent: last parents 
        remove back tail parents
    ]
    add-kid: func [kid][
        if none? third parent [parent/3: make block! 1] 
        insert/only tail third parent kid 
        kid
    ]
    add-attr: func [name value][
        if none? second parent [parent/2: make block! 2] 
        insert insert tail second parent to-word name either none? value [""][value] ; (iho)
    ]
    check-version: func [version][print ["XML Version:" version]]
    document: [prolog sp? content to end]
    prolog: [sp? xml-decl? any [sp? doc-type-decls]]
    xml-decl?: ["<?xml" version-info thru "?>" | none]
    version-info: [sp "version" eq [qt1 version-num qt1 | qt2 version-num qt2]]
    version-num: [copy temp some name-chars (check-version temp)]
    doc-type-decls: [cmt | "<!" thru ">" | "<?" thru "?>"]
    element: [cmt | s-tag ["/>" (pop-parent) | #">" any content e-tag]]
    s-tag: [#"<" tag (node: new-node to-word tag-name) any [sp attribute] sp?] ; (iho)
    e-tag: ["</" tag (end-node to-word tag-name) sp? #">"] ; (iho)
    tag: [copy tag-name name]
    content: [element | copy data some data-chars (add-kid data)]
    attribute: [copy attr-name name eq attr-value (add-attr attr-name attr-data)]
    eq: [sp? #"=" sp?]
    attr-value: [
        [qt1 copy attr-data any data-chars-qt1 qt1] | 
        [qt2 copy attr-data any data-chars-qt2 qt2]
    ]
    cmt: ["<!--" thru "-->"]
    parse-xml: func [str][
        paroot: parent: copy reduce ['document none none] 
        parse/case/all str document 
        paroot
    ]
]