xml updates

diff --git a/contrib/xml/tokenizer.factor b/contrib/xml/tokenizer.factor
index 1573d264ad3d947b66291d4cf0a017f2be01b44f..741081302f6abba4cccd1a3c567884c3c8c77d03 100644 (file)
--- a/contrib/xml/tokenizer.factor
+++ b/contrib/xml/tokenizer.factor
@@ -175,6 +175,7 @@ TUPLE: entity name ;
 \r
 : name-start-char? ( ch -- ? )\r
     {\r
+        { CHAR: :    CHAR: :    }\r
         { CHAR: _    CHAR: _    }\r
         { CHAR: A    CHAR: Z    }\r
         { CHAR: a    CHAR: z    }\r

diff --git a/contrib/xml/utilities.factor b/contrib/xml/utilities.factor
new file mode 100644 (file)
index 0000000..de955ea
--- /dev/null
+++ b/contrib/xml/utilities.factor
@@ -0,0 +1,50 @@
+! Copyright (C) 2005, 2006 Daniel Ehrenberg\r
+! See http://factorcode.org/license.txt for BSD license.\r
+IN: xml\r
+USING: kernel namespaces sequences words io errors hashtables parser arrays ;\r
+\r
+! * Easy XML generation for more literal things\r
+! should this be rewritten?\r
+\r
+: text ( string -- )\r
+    chars>entities add-child ;\r
+\r
+: tag ( string attr-quot contents-quot -- )\r
+    >r swap >r make-hash r> swap r> \r
+    -rot dupd <opener> process\r
+    slip\r
+    <closer> process ; inline\r
+\r
+: comment ( string -- )\r
+    <comment> add-child ;\r
+\r
+: make-xml ( quot -- vector )\r
+    #! Produces a tree of XML from a quotation to generate it\r
+    [ init-xml call xml-stack get first second ] with-scope ; inline\r
+\r
+! * System for words specialized on tag names\r
+\r
+TUPLE: process-missing process tag ;\r
+M: process-missing error.\r
+    "Tag <" write\r
+    process-missing-tag tag-name write\r
+    "> not implemented on process process " write\r
+    dup process-missing-process word-name print ;\r
+\r
+: run-process ( tag word -- )\r
+    2dup "xtable" word-prop\r
+    >r dup tag-name r> hash* [ 2nip call ] [\r
+        drop <process-missing> throw\r
+    ] if ;\r
+\r
+: PROCESS:\r
+    CREATE\r
+    dup H{ } clone "xtable" set-word-prop\r
+    dup literalize \ run-process 2array >quotation define-compound ; parsing\r
+\r
+: TAG:\r
+    scan scan-word [\r
+        swap "xtable" word-prop\r
+        rot "/" split [ >r 2dup r> swap set-hash ] each 2drop\r
+    ] f ; parsing\r
+\r