Commit 0db6894c authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-11-05 21:01:51 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-05 21:01:51+00:00
parent d981a9be
(* Print XML documents, using PXP *)
open Pxp_aux
open Pxp_types
open Value
let exn_print_xml = CDuceExn (Pair (Atom (Types.mk_atom "Invalid_argument"),
string "print_xml"))
let to_enc = `Enc_iso88591
let string_of_xml v=
let buffer = Buffer.create 127 in
let wms =
write_markup_string
~from_enc:`Enc_iso88591
~to_enc
(`Out_buffer buffer)
and wds =
write_data_string
~from_enc:`Enc_iso88591
~to_enc
(`Out_buffer buffer)
in
let comment s = wms ("<!--" ^ s ^ "-->")
and write_att (n,v) = wms (" " ^ n ^ "=\""); wds v; wms "\"" in
let element_start name attrs =
wms ("<" ^ name); List.iter write_att attrs; wms "\n>"
and element_end name = wms ("</" ^ name ^ "\n>")
and document_start () =
wms ("<?xml version='1.0' encoding='" ^
Netconversion.string_of_encoding to_enc ^
"'?>\n")
and text s = wds s in
let rec print_elt = function
| Pair (Atom tag, Pair (Record attrs, content)) ->
let tag = Types.atom_name tag in
element_start tag
(List.map (fun (n,v) ->
if not (is_str v) then raise exn_print_xml;
(Types.label_name n,get_string v)) attrs);
print_content content;
element_end tag
| Char x ->
wds (String.make 1 (Chars.Unichar.to_char x)); (* TODO: opt *)
| _ -> raise exn_print_xml
and print_content = function
| String (i,j,s,q) ->
wds (String.sub s i (j - i));
print_content q
| Pair (elt, q) ->
print_elt elt;
print_content q
| Atom a when a = Sequence.nil_atom -> true
| _ -> raise exn_print_xml
in
document_start ();
print_elt v;
Buffer.contents buffer
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment