From 9ebf44d84754adc5b64fcf612c6816c02c80462d Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Sat, 2 Feb 2019 19:29:23 -0500 Subject: Imported Upstream version 8.9.0 --- ide/protocol/xml_printer.ml | 147 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 147 insertions(+) create mode 100644 ide/protocol/xml_printer.ml (limited to 'ide/protocol/xml_printer.ml') diff --git a/ide/protocol/xml_printer.ml b/ide/protocol/xml_printer.ml new file mode 100644 index 00000000..488ef7bf --- /dev/null +++ b/ide/protocol/xml_printer.ml @@ -0,0 +1,147 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* puts " "; + | '>' -> puts ">" + | '<' -> puts "<" + | '&' -> + if p < l - 1 && text.[p + 1] = '#' then + putc '&' + else + puts "&" + | '\'' -> puts "'" + | '"' -> puts """ + | c -> putc c + done + +let buffer_attr tmp (n,v) = + let puts = Buffer.add_string tmp in + let putc = Buffer.add_char tmp in + putc ' '; + puts n; + puts "=\""; + let l = String.length v in + for p = 0 to l - 1 do + match v.[p] with + | '\\' -> puts "\\\\" + | '"' -> puts "\\\"" + | '<' -> puts "<" + | '&' -> puts "&" + | c -> putc c + done; + putc '"' + +let to_buffer tmp x = + let pcdata = ref false in + let puts = Buffer.add_string tmp in + let putc = Buffer.add_char tmp in + let rec loop = function + | Element (tag,alist,[]) -> + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + puts "/>"; + pcdata := false; + | Element (tag,alist,l) -> + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + putc '>'; + pcdata := false; + List.iter loop l; + puts "'; + pcdata := false; + | PCData text -> + if !pcdata then putc ' '; + buffer_pcdata tmp text; + pcdata := true; + in + loop x + +let pcdata_to_string s = + let b = Buffer.create 13 in + buffer_pcdata b s; + Buffer.contents b + +let to_string x = + let b = Buffer.create 200 in + to_buffer b x; + Buffer.contents b + +let to_string_fmt x = + let tmp = Buffer.create 200 in + let puts = Buffer.add_string tmp in + let putc = Buffer.add_char tmp in + let rec loop ?(newl=false) tab = function + | Element (tag, alist, []) -> + puts tab; + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + puts "/>"; + if newl then putc '\n'; + | Element (tag, alist, [PCData text]) -> + puts tab; + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + puts ">"; + buffer_pcdata tmp text; + puts "'; + if newl then putc '\n'; + | Element (tag, alist, l) -> + puts tab; + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + puts ">\n"; + List.iter (loop ~newl:true (tab^" ")) l; + puts tab; + puts "'; + if newl then putc '\n'; + | PCData text -> + buffer_pcdata tmp text; + if newl then putc '\n'; + in + loop "" x; + Buffer.contents tmp + +let print t xml = + let tmp, flush = match t with + | TChannel oc -> + let b = Buffer.create 200 in + b, (fun () -> Buffer.output_buffer oc b; flush oc) + | TBuffer b -> + b, (fun () -> ()) + in + to_buffer tmp xml; + flush () -- cgit v1.2.3