[wdb] Yet another XML parser. Very minimalistic, just 2 (two!) [proc]edures. Recognizes also singleton like `
`. Procedure `xmlToTree` builds list of tokens, then calls procedure `tokensVarToTree` which destructively processes this list, resulting a [dict]ionary. Exempli gratia: `xmlToTree

Hi!

` ⇒ `type element name p attribute {} content {{type pcdata content Hi!}}` ====== proc xmlToTree src1 { # remove comments set src [regsub -all $src1 ""] # list of tag index pairs set pairs\ [regexp -inline -indices -all {]*/?>} $src] # list of tag strings set tagList [lmap pair $pairs {string range $src {*}$pair}] # indices of pcdata set strIdx [lrange [concat {*}$pairs] 1 end-1] # list of pcdata strings set strList {} foreach {i j} $strIdx { lappend strList [string range $src $i+1 $j-1] } # tokens alternating: tag, pcdata, tag, ... set tokens {} foreach tag $tagList str $strList { lappend tokens $tag if {![string is space $str]} then { lappend tokens $str } } # process list tokensVarToTree tokens } proc tokensVarToTree _tokens { upvar $_tokens tokens set openPattern {<([[:alnum:]:]+)[^>]*>} set emptyPattern {<([[:alnum:]:]+)[^>]*/>} set closePattern {} set dataPattern {^[^<]} # destructive set tokens [lassign $tokens token] if {[regexp $dataPattern $token]} then { # PCDATA dict set result type pcdata dict set result content $token return $result } elseif {[regexp $openPattern $token - name]} then { # TAG opening or empty dict set result type element dict set result name $name dict set result attribute {} dict set result content "" # attributes foreach {- key val}\ [regexp -inline -all {([[:alnum:]]+)="(.*?)"} $token] { dict set result attribute $key $val } foreach {- key val}\ [regexp -inline -all {([[:alnum:]]+)='(.*?)'} $token] { dict set result attribute $key $val } } if {[regexp $emptyPattern $token]} then { # TAG empty: done return $result } while {![regexp $closePattern [lindex $tokens 0]] && [llength $tokens] > 0} { # TAG non-empty: fill contents dict lappend result content [tokensVarToTree tokens] } # remove closing TAG set tokens [lrange $tokens 1 end] set result } ======