#!/opt/isis/OpenIsis/tcl/bin/isish
# let editor know it's Tcl vim:syntax=tcl

package require openIsis;
package require xml;


# map element names to tags
array set tag {}
# highest ag used; set to 99 so we start from 100
set ltag 99
# map attribute names to subfields
# map keys are "tag\tatt"
array set subf {}

openIsisRec rec

proc cdata {data} { # text
	# puts "0\t[string map {\n " "} $data]"
	rec add 0 [string map {\n " "} $data]
}

proc comment {data} {
	# puts "#\t[string map {\n " "} $data]"
}

proc doctype {data} {
	puts "#\t$data"
}

proc estart {name attlist args} {
	global tag ltag subf lsubf
	set start +
	foreach {arg val} $args {
		switch -- $arg -empty { if $val { set start - } }
	}
	if [catch {set t $tag($name)}] {
		set t [set tag($name) [incr ltag]]
	}
	set line $start
	foreach {att val} $attlist {
		set attkey "$t\t$att"
		if [catch {set s $subf($attkey)}] {
			# use $subf($t) as counter for last subfield
			if [catch {set c [incr subf($t)]}] {
				set c [set subf($t) 97]
			}
			set s [set subf($attkey) [format %c $c]]
		}
		append line "^$s$val"
	}
	# puts "$t\t$line"
	rec add $t $line
}

proc eend {name args} {
	global tag
	foreach {arg val} $args {
		switch -- $arg -empty { if $val { return } }
	}
	# puts $tag($name)
	rec add $tag($name) ""
}

set xp [xml::parser \
	-ignorewhitespace yes \
	-reportempty yes \
	-characterdatacommand cdata \
	-commentcommand comment \
	-doctypecommand doctype \
	-elementstartcommand estart \
	-elementendcommand eend \
	-defaultcommand error
]
# doesn't like that:
# -endcdatasectioncommand ecdata
#	-startcdatasectioncommand scdata

$xp parse [read stdin]


# invert the FDT tag,subf to name,attr
foreach {n v} [array get tag] { set name($v) $n}
foreach {n v} [array get subf] {
	if {2 == [scan $n "%u\t%s" t a]} { set attr($t\t$v) $a }
}

foreach t [lsort [array names name]] {
	# puts stderr "$t\t$name($t)" ;# verbose entry
	set line $name($t)
	foreach s [lsort [array names attr "$t\t*"]] {
		# puts stderr "$s\t$attr($s)" ;# verbose entry
		scan $s "%u\t%s" - c
		append line "^$c$attr($s)"
	}
	puts stderr "$t\t$line" ;# the one-line DTD ;)
}

# use the inverted FDT to create the XML text
puts "<!--
[rec serialize]
-->"
set depth 0
rec do t v {
	if !$t { # text
		puts [string repeat \t $depth]$v
		continue
	}
	if {"" == $v} { # close
		incr depth -1
		puts [string repeat \t $depth]</$name($t)>
		continue
	}
	set line "<$name($t)"
	set alist [split $v ^]
	set hasChilds [expr {"+" == [lindex $alist 0]}]
	foreach a [lrange $alist 1 end] {
		append line " $attr($t\t[string index $a 0])=\"[string range $a 1 end]\""
	}
	if $hasChilds {
		append line >
	} else {
		append line />
	}
	puts [string repeat \t $depth]$line
	if $hasChilds {
		incr depth
	}
}