From 739971284fe91a24d84b4dd66e80ffd25e127345 Mon Sep 17 00:00:00 2001
From: microdan <microdan@gmail.com>
Date: Sun, 12 Nov 2006 00:27:30 +0000
Subject: [PATCH] xml updates

---
 contrib/xml/tokenizer.factor |  1 +
 contrib/xml/utilities.factor | 50 ++++++++++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+)
 create mode 100644 contrib/xml/utilities.factor

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