2 ||M|| This file is part of HELM, an Hypertextual, Electronic
3 ||A|| Library of Mathematics, developed at the Computer Science
4 ||T|| Department, University of Bologna, Italy.
6 ||T|| HELM is free software; you can redistribute it and/or
7 ||A|| modify it under the terms of the GNU General Public License
8 \ / version 2 or (at your option) any later version.
9 \ / This software is distributed as is, NO WARRANTY.
10 V_______________________________________________________________ *)
16 type 'a out = (unit -> 'a) -> string -> 'a
18 (* internal functions *******************************************************)
24 let system = "http://helm.cs.unibo.it/lambda-delta/" ^ base ^ "/ld.dtd"
27 F.concat base (Str.string_after (U.string_of_uri uri) 3)
30 Format.fprintf frm "<?xml version=%S encoding=%S?>@,@," "1.0" "UTF-8"
33 Format.fprintf frm "<!DOCTYPE ENTRY SYSTEM %S>@,@," system
35 let open_entry si g frm =
36 let opts = if si then "si" else "" in
38 Format.fprintf frm "<ENTRY hierarchy=%S options=%S>" shp opts
43 Format.fprintf frm "</ENTRY>"
45 (* interface functions ******************************************************)
47 let old_export_entity export_entry si g = function
49 let _, uri, bind = entry in
50 let path = path_of_uri uri in
51 let _ = Sys.command (Printf.sprintf "mkdir -p %s" (F.dirname path)) in
52 let och = open_out (path ^ obj_ext) in
53 let frm = Format.formatter_of_out_channel och in
54 Format.pp_set_margin frm max_int;
55 Format.fprintf frm "@[<v>%t%t%t%a%t@]@."
56 pp_head pp_doctype (open_entry si g) export_entry entry close_entry;
60 (****************************************************************************)
62 let export_entity export_entry si g = function
64 let _, uri, bind = entry in
65 let path = path_of_uri root uri in
66 let _ = Sys.command (Printf.sprintf "mkdir -p %s" (F.dirname path)) in
67 let och = open_out (path ^ obj_ext) in
68 let out f s = output_string och s; f () in
69 let f () = close_out och in
71 Format.fprintf frm "@[<v>%t%t%t%a%t@]@."
72 pp_head pp_doctype (open_entry si g) export_entry entry close_entry;