imported all of my Github gists from https://gist.github.com/rhaberkorn

1 files changed, 52 insertions, 0 deletions

diff --git a/xml.sc b/xml.sc
new file mode 100644
index 0000000..7f45ce2
--- /dev/null
+++ b/xml.sc
@@ -0,0 +1,52 @@
+# Quick and dirty SNOBOL4/Snocone DOM-like XML parser
+
+struct tag {type, params, lastp, children, last, parent}
+struct param {name, value}
+word = SPAN("_0123456789" && &LCASE)
+xml = (("<!--" && ARB && "-->") $ *ITEM(children(current),last(current) = last(current) + 1) |
+       "<" && word $ *type(current = ITEM(children(current),last(current) = last(current) + 1) =
+                                     tag(NULL, ARRAY(10), 0, ARRAY(10), 0, current)) &&
+           ARBNO(SPAN(" ") && word $ *name(ITEM(params(current), lastp(current) = lastp(current) + 1) = param()) &&
+                 ARBNO(" ") && "=" && ARBNO(" ") && ("'"|'"') $ st && BREAK(*st) $ *value(ITEM(params(current),lastp(current))) && *st) &&
+       (">" | "/>" && *godown()) | "</" && word $ tag_name && ">" && *(tag_name :: type(current)) && *godown() |
+       (BREAK("<") | REM) $ *ITEM(children(current),last(current) = last(current) + 1)) && (RPOS(0) | *xml)
+procedure godown() {
+ current = parent(current); return
+}
+
+# recursive function to produce a XML tree from a TAG data structure
+procedure node_to_xml(node) i {
+ if(type(node) :!: NULL) {
+  node_to_xml = node_to_xml && "<" && type(node)
+  for(i=1, i <= lastp(node), i=i+1)
+   node_to_xml = node_to_xml && " " && name(ITEM(params(node), i)) && '="' && value(ITEM(params(node), i)) && '"'
+  if(last(node) == 0)
+   node_to_xml = node_to_xml && "/>"
+    else
+   node_to_xml = node_to_xml && ">"
+ }
+
+ for(i=1, i <= last(node), i=i+1)
+  if(DATATYPE(ITEM(children(node),i)) :: "TAG")
+   node_to_xml = node_to_xml && node_to_xml(ITEM(children(node),i))
+    else
+   node_to_xml = node_to_xml && ITEM(children(node),i)
+
+ if(type(node) :!: NULL && last(node) > 0)
+  node_to_xml = node_to_xml && "</" && type(node) && ">"
+}
+
+# TEST CODE
+current = tag(NULL, NULL, NULL, ARRAY(10), 0, NULL)
+'<test arg1="a1" arg2="a2">hgg<br/>jklhg<b><!-- Kommentar -->Bold text</b></test>' ? xml
+
+test_tag = ITEM(children(current),1)
+OUTPUT = type(test_tag)
+OUTPUT = name(ITEM(params(test_tag),2))
+OUTPUT = ITEM(children(test_tag),1)
+b_tag = ITEM(children(test_tag),4)
+OUTPUT = ITEM(children(b_tag),1)
+OUTPUT = ITEM(children(b_tag),2)
+
+type(test_tag) = "neu"
+OUTPUT = node_to_xml(current)