xml.tcl

gistfile1.txt

package require Itcl; namespace import ::itcl::*

proc quote arg { string map {& &amp; \" &quot; ' &apos; < &lt; > &gt;} $arg }

class XmlAttributes {
    variable Attributes {}
    constructor arg {
        dict for {k v} $arg {dict set Attributes $k $v}
    }
    method configure arg {
        dict for {k v} $arg {dict set Attributes $k $v}
    }
    method toString {} {
        set res {}
        dict for {k v} $Attributes { append res [subst { $k="$v"}] }
        return $res
    }
}

class XmlTag {
    variable Tag
    variable Attributes
    constructor {tag attribute} {
        set Tag $tag
        set Attributes [XmlAttributes #auto $attribute]
    }
    destructor { delete object $Attributes }
    method configure arg { $Attributes configure $arg }
    method start  {} { subst {<$Tag[$Attributes toString]>} }
    method end    {} { return </$Tag> }
    method single {} { subst {<$Tag[$Attributes toString] />} }
}

class XmlValue {
    variable Value
    constructor arg { set Value $arg }
    method toString {} { quote $Value }
}

class XmlElement {
    variable Tag
    variable Children
    constructor {tag attribute children} {
        set Tag [XmlTag #auto $tag $attribute]
        set Children $children
    }
    destructor {
        delete object $Tag
        foreach child $Children { delete object $child }
    }
    method configure arg { $Tag configure $arg }
    method children {fn args} { $fn Children {*}$args }
    method toString {} {
        if {$Children eq {}} { return [$Tag single] }
        set str {}
        foreach c $Children { append str [$c toString] }
        subst {[$Tag start]$str[$Tag end]}
    }
}