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;
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;
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 = "";
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