1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
package provide xotcl::xml::recreatorVisitor 1.0
package require -exact xotcl::xml::parser 1.0
package require XOTcl 1
namespace eval ::xotcl::xml::recreatorVisitor {
namespace import ::xotcl::*
##############################################################################
#
# a visitor that recreates an XML representation from a
# node tree
#
#############################################################################
Class XMLRecreatorVisitor -superclass NodeTreeVisitor -parameter useCDATA
#
# determine nesting depth of an object if the aggregation tree
#
XMLRecreatorVisitor instproc nestingDepth {obj} {
for {set d 0;set s [$obj info parent]} {$s ne "::"} {set s [$s info parent]} {
incr d
}
return $d
}
#
# insert appropriate number of spaces for indentation -> return space string
#
XMLRecreatorVisitor instproc indent chars {
set spaces " "
for {set l 9} {$l<$chars} {incr l $l} {append spaces $spaces}
return [string range $spaces 1 $chars]
}
XMLRecreatorVisitor instproc insertIndent {obj} {
my instvar nestingStart
return [my indent [expr {([my nestingDepth $obj] - $nestingStart)*2} - 2]]
}
XMLRecreatorVisitor instproc attrIndent {objName fa} {
upvar [self callinglevel] $fa firstAttr
if {$firstAttr} {
set firstAttr 0
return " "
} else {
return "\n[my insertIndent $objName] "
}
}
XMLRecreatorVisitor instproc getContent objName {
return [$objName content]
}
XMLRecreatorVisitor instproc hasOnlyAttrs {obj} {
if {[$obj exists pcdata]} {return 0}
foreach c [$obj info children] {
if {[$c istype XMLNode]} {return 0}
}
return 1
}
#
# hook to append line feed dependent on the object
# default is to append one \n
#
XMLRecreatorVisitor instproc appendLineFeed obj {
return "\n"
}
#
# evaluate node objName
#
XMLRecreatorVisitor instproc visit objName {
my instvar result
set c [my getContent $objName]
if {$c ne ""} {
$objName instvar attributes pcdata
set ns [$objName resolveNS]
set firstAttr 1
set attrStr ""
if {[string first $objName $ns] != -1} {
# append xmlns attributes, xmlns=... first
if {[$ns exists nsArray(xmlns)]} {
append attrStr [my attrIndent $objName firstAttr]
append attrStr "xmlns = \"[$ns set nsArray(xmlns)]\""
}
foreach a [$ns array names nsArray] {
if {$a ne "xmlns"} {
append attrStr [my attrIndent $objName firstAttr]
append attrStr "xmlns:${a} = \"[$ns set nsArray($a)]\""
}
}
}
foreach a [array names attributes] {
append attrStr [my attrIndent $objName firstAttr]
append attrStr "$a = \"$attributes($a)\""
}
append result "[my insertIndent $objName]<${c}$attrStr"
if {[my hasOnlyAttrs $objName]} {
append result "/>"
} else {
append result ">"
}
if {[info exists pcdata] && [llength $pcdata]>1 &&
[lindex $pcdata 0] eq ""} {
append result " " [my pcdataString [lindex $pcdata 1]]
}
append result [my appendLineFeed $objName]
}
return $result
}
XMLRecreatorVisitor instproc pcdataString text {
if {[my exists useCDATA] && [regexp < $text]} {
return "<!\[CDATA\[$text]]>"
}
return $text
}
#
# evaluate end of a node
#
XMLRecreatorVisitor instproc visitEnd objName {
my instvar result
set c [$objName content]
if {$c ne ""} {
if {![my hasOnlyAttrs $objName]} {
append result [my insertIndent $objName] </$c>\n
}
}
# a child is responsible for the "mixed content" data elements
# that have a location after the child
set p [$objName info parent]
if {[$p istype XMLElement] && [$p mixedContent]} {
foreach {location data} [$p set pcdata] {
if {$location == $objName} {
append result [my insertIndent $objName] \
[my pcdataString $data] \n
}
}
}
}
#
# public method to be called on top node -> returns XML text as result
#
XMLRecreatorVisitor instproc interpretNodeTree node {
my instvar result
set result ""
my set nestingStart [my nestingDepth $node]
$node accept [self]
return $result
}
namespace export XMLRecreatorVisitor
}
namespace import ::xotcl::xml::recreatorVisitor::*
|
