From 7e9bcacfcf765bf20e19f6277da8471bcf395d26 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= <kn@lri.fr>
Date: Thu, 28 Jun 2012 18:15:46 +0200
Subject: [PATCH] Add support for text elements in the XML document.

---
 src/tree.ml | 60 +++++++++++++++++++++++++++++++++++------------------
 1 file changed, 40 insertions(+), 20 deletions(-)

diff --git a/src/tree.ml b/src/tree.ml
index c30427c..f914d33 100644
--- a/src/tree.ml
+++ b/src/tree.ml
@@ -99,7 +99,11 @@ struct
 
   let is_left n = n.next_sibling == dummy
 
-  let start_element_handler parser_ ctx tag attr_list =
+
+  let text_string = QName.to_string QName.text
+
+  let rec start_element_handler parser_ ctx tag attr_list =
+    do_text parser_ ctx;
     let parent = top ctx in
     let n = { tag = QName.of_string tag;
               preorder = next ctx;
@@ -113,21 +117,32 @@ struct
     else parent.next_sibling <- n;
     push n ctx
 
-  let rec consume_closing ctx n =
+  and consume_closing ctx n =
     if n.next_sibling != dummy then
       let _ = pop ctx in consume_closing ctx (top ctx)
 
-
-  let end_element_handler parser_ ctx tag =
+  and end_element_handler parser_ ctx tag =
+    do_text parser_ ctx;
     let node = top ctx in
-    if node.first_child == dummy then node.first_child <- nil
+    if nodef.first_child == dummy then node.first_child <- nil
     else begin
       node.next_sibling <- nil;
       consume_closing ctx node
     end
 
-  let character_data_handler parser_ _ t text =
-    Buffer.add_string t text
+  and do_text parser_ ctx =
+    if Buffer.length ctx.text_buffer != 0 then
+      let s = Buffer.contents ctx.text_buffer in
+      Buffer.clear  ctx.text_buffer;
+      start_element_handler parser_ ctx text_string [];
+      let node = top ctx in
+      node.data <- s;
+      end_element_handler parser_ ctx text_string;
+      Format.eprintf "DEBUG: %a\n\n" debug_ctx ctx
+
+
+  let character_data_handler parser_ ctx text =
+    Buffer.add_string ctx.text_buffer text
 
   let create_parser () =
     let ctx = { text_buffer = Buffer.create 512;
@@ -136,6 +151,7 @@ struct
     let parser_ = Expat.parser_create ~encoding:None in
     Expat.set_start_element_handler parser_ (start_element_handler parser_ ctx);
     Expat.set_end_element_handler parser_ (end_element_handler parser_ ctx);
+    Expat.set_character_data_handler parser_ (character_data_handler parser_ ctx);
     push { tag = QName.document;
            preorder = next ctx;
            data = "";
@@ -179,22 +195,26 @@ let load_xml_string = Parser.parse_string
 
 let rec print_xml out tree_ node =
   if node != nil then
-    let tag = QName.to_string node.tag in
-    output_char out '<';
-    output_string out tag;
-    (* print attributes *)
-    if node.first_child == nil then output_string out "/>"
-    else begin
-      output_char out '>';
-      print_xml out tree_ node.first_child;
-      output_string out "</";
-      output_string out tag;
-      output_char out '>'
-    end;
+    let () =
+      if node.tag == QName.text then
+        output_string out node.data
+      else
+        let tag = QName.to_string node.tag in
+        output_char out '<';
+        output_string out tag;
+      (* print attributes *)
+        if node.first_child == nil then output_string out "/>"
+        else begin
+          output_char out '>';
+          print_xml out tree_ node.first_child;
+          output_string out "</";
+          output_string out tag;
+          output_char out '>'
+        end
+    in
     print_xml out tree_ node.next_sibling
 
 
-
 let root t = t.root
 let first_child _ n = n.first_child
 let next_sibling _ n = n.next_sibling
-- 
2.17.1