proc getdataType {path} { return [lindex [split [hinfo $path] ,] 0] } proc encode {str} { set result [string map -nocase { "\"" {"} {'} {'} {<} {<} {>} {>} {&} {&} \u0 {} \u1 {} \u2 {} \u3 {} \u4 {} \u5 {} \u6 {} \u7 {} \u8 {} \u9 { } \ua { } \ub {} \uc {} \ud { } \ue {} \uf {} \u10 {} \u11 {} \u12 {} \u13 {} \u14 {} \u15 {} \u16 {} \u17 {} \u18 {} \u19 {} \u1a {} \u1b {} \u1c {} \u1d {} \u1e {} \u1f {} } $str] return $result } proc make_nodes {path result indent} { if {[hpropexists $path "control"]} { set value [hgetpropval $path "control"] if {[string compare -nocase $value "false"] == 0} { return $result } } set nodename [file tail $path]; set type [getdataType $path] set prefix [string repeat " " $indent] set newIndent [expr $indent + 2] append result "$prefix\n" if {[string compare -nocase $type "none"] != 0} { if [ catch { set value [encode [hval $path]] } message ] { set value "HVAL_ERROR:${message}" } append result "$prefix $value\n" } foreach p [property_elements $path $newIndent] { append result $p } foreach x [lsort [hlist $path]] { set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent] } append result "$prefix\n" return $result } proc property_elements {path indent} { set prefix [string repeat " " $indent] foreach {key} [lsort [hlistprop $path tclnames]] { if {[string compare -nocase $key "control"] == 0} {continue} set value [encode [hgetpropval $path $key]] lappend proplist "$prefix\n" if {[string compare -nocase $key "help"] == 0} { lappend proplist "$prefix $value\n" } else { foreach v [split $value ,] { lappend proplist "$prefix $v\n" } } lappend proplist "$prefix\n" } if [info exists proplist] {return $proplist} } proc getgumtreexml {path} { append result "\n" append result "\n" if {[string compare $path "/" ] == 0} { foreach n [lsort [hlist $path]] { set result [make_nodes $n $result 2] } } else { set result [make_nodes $path $result 2] } append result "\n" } proc make_value_nodes {path result indent} { if {[hpropexists $path "control"]} { set value [hgetpropval $path "control"] if {[string compare -nocase $value "false"] == 0} { return $result } } set nodename [file tail $path]; set type [getdataType $path] set prefix [string repeat " " $indent] set newIndent [expr $indent + 2] append result "$prefix\n" if {[string compare -nocase $type "none"] != 0} { if [ catch { set value [encode [hval $path]] } message ] { set value "HVAL_ERROR:${message}" } append result "$prefix $value\n" } foreach x [lsort [hlist $path]] { set result [make_value_nodes [string map {// /} "$path/$x"] $result $newIndent] } append result "$prefix\n" return $result } proc getgumtreexmlvalues {path} { append result "\n" append result "\n" if {[string compare $path "/" ] == 0} { foreach n [lsort [hlist $path]] { set result [make_value_nodes $n $result 2] } } else { set result [make_value_nodes $path $result 2] } append result "\n" } if {[info exists guminit] == 0} { set guminit 1 Publish getgumtreexml Spy Publish getgumtreexmlvalues Spy }