81 lines
2.4 KiB
Tcl
81 lines
2.4 KiB
Tcl
proc getdataType {path} {
|
|
return [lindex [split [hinfo $path] ,] 0]
|
|
}
|
|
|
|
|
|
proc make_nodes {path result indent} {
|
|
set nodename [file tail $path];
|
|
set type [getdataType $path]
|
|
set prefix [string repeat " " $indent]
|
|
set newIndent [expr $indent + 2]
|
|
#array set prop_list [ string trim [join [split [hlistprop $path] =]] ]
|
|
set prop_list(control) true
|
|
set we_have_control [info exists prop_list(control)]
|
|
if {$we_have_control == 0 || $we_have_control && $prop_list(control) == "true"} {
|
|
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
|
|
foreach p [property_elements $path $newIndent] {
|
|
append result $p
|
|
}
|
|
foreach x [hlist $path] {
|
|
set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent]
|
|
}
|
|
append result "$prefix</component>\n"
|
|
}
|
|
return $result
|
|
}
|
|
|
|
proc property_elements_old {path indent} {
|
|
set prefix [string repeat " " $indent]
|
|
foreach {key value} [string map {= " "} [hlistprop $path]] {
|
|
if {[string compare -nocase $key "control"] == 0} {continue}
|
|
lappend proplist "$prefix<property id=\"$key\">\n"
|
|
# foreach v [split $value ,] {
|
|
# lappend proplist "$prefix$prefix<value>$v</value>\n"
|
|
# }
|
|
lappend proplist "$prefix$prefix<value>$value</value>\n"
|
|
lappend proplist "$prefix</property>\n"
|
|
}
|
|
if [info exists proplist] {return $proplist}
|
|
}
|
|
|
|
proc property_elements {path indent} {
|
|
set prefix [string repeat " " $indent]
|
|
set data [hlistprop $path]
|
|
set propList [split $data \n]
|
|
foreach prop $propList {
|
|
set pl [split $prop =]
|
|
set key [string trim [lindex $pl 0]]
|
|
set value [string trim [lindex $pl 1]]
|
|
if {[string length $key] < 1} {
|
|
continue
|
|
}
|
|
lappend proplist "$prefix<property id=\"$key\">\n"
|
|
lappend proplist "$prefix$prefix<value>$value</value>\n"
|
|
lappend proplist "$prefix</property>\n"
|
|
}
|
|
if [info exists proplist] {return $proplist}
|
|
}
|
|
|
|
proc getgumtreexml {path} {
|
|
append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
|
|
append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"
|
|
|
|
if {[string compare $path "/" ] == 0} {
|
|
foreach n [hlist $path] {
|
|
set result [make_nodes $n $result 2]
|
|
}
|
|
} else {
|
|
# set result [make_nodes $path $result 2]
|
|
foreach n [hlist $path] {
|
|
set result [make_nodes $path/$n $result 2]
|
|
}
|
|
}
|
|
|
|
append result "</hipadaba:SICS>\n"
|
|
}
|
|
|
|
if {[info exists guminit] == 0} {
|
|
set guminit 1
|
|
Publish getgumtreexml Spy
|
|
}
|