[ocaml] print more verbose info on xml loading errors

sw/ground_segment/cockpit/editFP.ml

@@ -116,7 +116,7 @@ let new_fp = fun geomap editor_frame accel_group () ->
     createfp#grab_default ();
     ignore(createfp#connect#clicked ~callback:
              begin fun _ ->
-               let xml = Xml.parse_file fp_example in
+               let xml = ExtXml.parse_file fp_example in
                let s = ExtXml.subst_attrib in
                let wgs84 = Latlong.of_string latlong#text in
                let xml = s "lat0" (deg_string_of_rad wgs84.posn_lat) xml in

sw/ground_segment/joystick/input2ivy.ml

@@ -129,7 +129,7 @@ let get_message = fun class_name msg_name ->
 
 (** Get the A/C id from its name in conf/conf.xml *)
 let ac_id_of_name = fun ac_name ->
-  let conf_xml = Xml.parse_file (conf_dir // "conf.xml") in
+  let conf_xml = ExtXml.parse_file (conf_dir // "conf.xml") in
   try
     let aircraft = ExtXml.child ~select:(fun x -> Xml.attrib x "name" = ac_name) conf_xml "aircraft" in
     ExtXml.int_attrib aircraft "ac_id"
@@ -140,7 +140,7 @@ let ac_id_of_name = fun ac_name ->
 (** Fill the index_of_settings table from var/AC/settings.xml *)
 let hash_index_of_settings = fun ac_name ->
   let xml_file = Env.paparazzi_home // "var" // "aircrafts" // ac_name // "settings.xml" in
-  let xml = Xml.parse_file xml_file in
+  let xml = ExtXml.parse_file xml_file in
   let index = ref 0 in
   let rec loop = fun xml ->
     if Xml.tag xml = "dl_settings" then
@@ -155,7 +155,7 @@ let hash_index_of_settings = fun ac_name ->
 (** Fill the index_of_blocks table from var/aircrafts/AC/flight_plan.xml *)
 let hash_index_of_blocks = fun ac_name ->
   let xml_file = Env.paparazzi_home // "var" // "aircrafts" // ac_name // "flight_plan.xml" in
-  let dump = Xml.parse_file xml_file in
+  let dump = ExtXml.parse_file xml_file in
   let flight_plan = ExtXml.child dump "flight_plan" in
   let blocks = ExtXml.child flight_plan "blocks" in
   List.iter (fun block ->
@@ -305,7 +305,7 @@ let trim_set = fun inputs value ->
 (** Input the trim file if it exists *)
 let parse_trim_file = fun trim_file_name inputs ->
   if Sys.file_exists trim_file_name then begin
-    let trim = Xml.parse_file trim_file_name in
+    let trim = ExtXml.parse_file trim_file_name in
     let trim_values = List.map
       (fun x ->
         let axis = ExtXml.attrib x "axis"
@@ -318,7 +318,7 @@ let parse_trim_file = fun trim_file_name inputs ->
 (** Parse the complete (input and messages) XML desxription
     Also parses the trim xml file if it exists *)
 let parse_descr = fun xml_file trim_file ->
-  let xml = Xml.parse_file xml_file in
+  let xml = ExtXml.parse_file xml_file in
 
   let inputs = parse_input (ExtXml.child xml "input")
   and messages_xml = ExtXml.child xml "messages"

sw/ground_segment/tmtc/server.ml

@@ -45,7 +45,7 @@ let dl_id = "ground_dl" (* Hack, should be [my_id] *)
 
 let (//) = Filename.concat
 let logs_path = Env.paparazzi_home // "var" // "logs"
-let conf_xml = Xml.parse_file (Env.paparazzi_home // "conf" // "conf.xml")
+let conf_xml = ExtXml.parse_file (Env.paparazzi_home // "conf" // "conf.xml")
 let srtm_path = Env.paparazzi_home // "data" // "srtm"
 
 let get_indexed_value = fun t i ->
@@ -451,7 +451,7 @@ let send_aircraft_msg = fun ac ->
 let replayed = fun ac_id ->
   let n = String.length ac_id in
   if n > 6 && String.sub ac_id 0 6 = "replay" then
-    (true, String.sub ac_id 6 (n - 6), "/var/replay/",  Xml.parse_file (Env.paparazzi_home // "var/replay/conf/conf.xml"))
+    (true, String.sub ac_id 6 (n - 6), "/var/replay/", ExtXml.parse_file (Env.paparazzi_home // "var/replay/conf/conf.xml"))
   else
     (false, ac_id, "", conf_xml)
 
@@ -516,11 +516,11 @@ let new_aircraft = fun get_alive_md5sum real_id ->
   end;
 
   let fp_file =  var_aircraft_dir // "flight_plan.xml" in
-  let xml_fp = ExtXml.child (Xml.parse_file fp_file) "flight_plan" in
+  let xml_fp = ExtXml.child (ExtXml.parse_file fp_file) "flight_plan" in
 
   let aircraft_conf_dir = var_aircraft_dir // "conf" in
   let airframe_file =  aircraft_conf_dir // ExtXml.attrib conf "airframe" in
-  let airframe_xml = Xml.parse_file airframe_file in
+  let airframe_xml = ExtXml.parse_file airframe_file in
 
   if not is_replayed then
     check_md5sum real_id (get_alive_md5sum ()) aircraft_conf_dir;
@@ -533,7 +533,7 @@ let new_aircraft = fun get_alive_md5sum real_id ->
 
   ignore (Glib.Timeout.add 1000 (fun _ -> update (); true));
 
-  let messages_xml = Xml.parse_file (Env.paparazzi_home // root_dir // "var" // "messages.xml") in
+  let messages_xml = ExtXml.parse_file (Env.paparazzi_home // root_dir // "var" // "messages.xml") in
   ac, messages_xml
 
 let check_alerts = fun a ->

sw/ground_segment/tmtc/settings.ml

@@ -28,7 +28,7 @@ module Tele_Pprz = PprzLink.Messages(struct let name = "telemetry" end)
 
 let (//) = Filename.concat
 let conf_dir = Env.paparazzi_home // "conf"
-let conf_xml = Xml.parse_file (conf_dir // "conf.xml")
+let conf_xml = ExtXml.parse_file (conf_dir // "conf.xml")
 
 
 
@@ -53,7 +53,7 @@ let one_ac = fun (notebook:GPack.notebook) ac_name ->
         Ground_Pprz.message_send "dl" "GET_DL_SETTING" vs in
 
     (* Build the buttons and sliders *)
-    let xml = Xml.parse_file xml_file in
+    let xml = ExtXml.parse_file xml_file in
     let xmls = Xml.children (ExtXml.child xml "dl_settings") in
     let settings = new Page_settings.settings xmls callback ac_id Env.gcs_default_icons_theme (fun _ _ -> ()) in
 

sw/ground_segment/tmtc/wind.ml

@@ -50,7 +50,7 @@
 type id = string
 
 let (//) = Filename.concat
-let conf_xml = Xml.parse_file (Env.paparazzi_home // "conf" // "conf.xml")
+let conf_xml = ExtXml.parse_file (Env.paparazzi_home // "conf" // "conf.xml")
 
 open Geometry_2d
 

sw/lib/ocaml/env.ml

@@ -93,7 +93,7 @@ let filter_modules_target = fun module_file ->
     | [f; n] -> f, n
     | _ -> module_file, ""
   in
-  let module_xml = Xml.parse_file xml_file in
+  let module_xml = ExtXml.parse_file xml_file in
   if Xml.tag module_xml = "module"
   then
     begin

sw/lib/ocaml/extXml.ml

@@ -237,11 +237,11 @@ let my_xml_parse_file =
 let parse_file = fun ?(noprovedtd = false) file ->
   try (if noprovedtd then my_xml_parse_file else Xml.parse_file) file
   with
-  | Xml.Error e -> failwith (sprintf "%s: %s" file (Xml.error e))
+  | Xml.Error e -> failwith (sprintf "XML error in %s: %s" file (Xml.error e))
   | Xml.File_not_found f -> failwith (sprintf "File not found: %s" f)
-  | Dtd.Prove_error e -> failwith (sprintf "%s: %s" file (Dtd.prove_error e))
-  | Dtd.Check_error e -> failwith (sprintf "%s: %s" file (Dtd.check_error e))
-  | Dtd.Parse_error e -> failwith (sprintf "%s: %s" file (Dtd.parse_error e))
+  | Dtd.Prove_error e -> failwith (sprintf "DTD prove error in %s: %s" file (Dtd.prove_error e))
+  | Dtd.Check_error e -> failwith (sprintf "DTD check error in %s: %s" file (Dtd.check_error e))
+  | Dtd.Parse_error e -> failwith (sprintf "DTD parse error in %s: %s" file (Dtd.parse_error e))
 
 
 

sw/lib/ocaml/gen_common.ml

@@ -259,7 +259,7 @@ let get_modules_dir = fun modules ->
 let is_element_unselected = fun ?(verbose=false) target modules name ->
   try
     let name = (Env.paparazzi_home // "conf" // name) in
-    let xml = Xml.parse_file name in
+    let xml = ExtXml.parse_file name in
     match Xml.tag xml with
     | "settings" ->
         let targets = Xml.attrib xml "target" in

sw/lib/ocaml/ubx.ml

@@ -88,7 +88,7 @@ type msg_id = int
 let (//) = Filename.concat
 
 let ubx_xml =
-  lazy (Xml.parse_file (Env.paparazzi_src // "conf" // "ubx.xml"))
+  lazy (ExtXml.parse_file (Env.paparazzi_src // "conf" // "ubx.xml"))
 
 let ubx_get_class = fun name ->
   let ubx_xml = Lazy.force ubx_xml in

sw/lib/ocaml/xml2h.ml

@@ -55,12 +55,12 @@ let begin_out = fun xml_file h_name out ->
   fprintf out "#define %s\n\n" h_name
 
 let start_and_begin_out = fun xml_file h_name out ->
-  let xml = Xml.parse_file xml_file in
+  let xml = ExtXml.parse_file xml_file in
   begin_out xml_file h_name out;
   xml
 
 let start_and_begin = fun xml_file h_name ->
-  let xml = Xml.parse_file xml_file in
+  let xml = ExtXml.parse_file xml_file in
   begin_out xml_file h_name stdout;
   xml
 
@@ -71,7 +71,7 @@ let begin_c_out = fun xml_file name out ->
   fprintf out "#include \"%s.h\"\n\n" name
 
 let start_and_begin_c = fun xml_file name ->
-  let xml = Xml.parse_file xml_file in
+  let xml = ExtXml.parse_file xml_file in
   begin_c_out xml_file name stdout;
   xml
 

sw/lib/ocaml/xmlCom.ml

@@ -31,7 +31,7 @@ Nethtml.Element (_tag, _params, children) -> children
 
 (** Translate <tag .../> to <tag ...></tag> and parse  *)
 let parse_file = fun file ->
-  ignore (Xml.parse_file file);
+  ignore (ExtXml.parse_file file);
   let buff = Buffer.create 5
   and lookup = Buffer.create 5
   and name = Buffer.create 5

sw/logalizer/export.ml

@@ -140,7 +140,7 @@ let export_values = fun ?(sep="tab") ?(export_geo_pos=true) (model:GTree.tree_st
 
   (* Save preferences *)
   let value = String.concat ";" (List.map (fun (msg, field) -> sprintf "%s:%s" msg field) !fields_to_export) in
-  let xml = if Sys.file_exists Env.gconf_file then Xml.parse_file Env.gconf_file else Xml.Element ("gconf", [], []) in
+  let xml = if Sys.file_exists Env.gconf_file then ExtXml.parse_file Env.gconf_file else Xml.Element ("gconf", [], []) in
   let xml = ExtXml.Gconf.add_entry xml "log plotter" "to_export" value in
   let f = open_out Env.gconf_file in
   Printf.fprintf f "%s\n" (ExtXml.to_string_fmt xml);
@@ -232,7 +232,7 @@ let export_values = fun ?(sep="tab") ?(export_geo_pos=true) (model:GTree.tree_st
 let read_preferences = fun () ->
   if Sys.file_exists Env.gconf_file then
     try
-      let xml = Xml.parse_file Env.gconf_file in
+      let xml = ExtXml.parse_file Env.gconf_file in
       let to_export = ExtXml.Gconf.get_value xml "to_export" in
       let pairs = Str.split (Str.regexp ";") to_export in
       List.map

sw/logalizer/logplotter.ml

@@ -565,7 +565,7 @@ let write_kml = fun plot log_name values ->
 
   let l = List.filter (fun (t,_,_) -> t_min <= t && t < t_max) values in
 
-  let xml = Xml.parse_file sample_kml in
+  let xml = ExtXml.parse_file sample_kml in
   let doc = ExtXml.child xml "Document" in
   let place = ExtXml.child doc "Placemark" in
   let line = ExtXml.child place "LineString" in
@@ -657,7 +657,7 @@ let add_ac_submenu = fun ?(export=false) protocol ?(factor=object method text="1
 
 let load_log = fun ?export ?factor (plot:plot) (menubar:GMenu.menu_shell GMenu.factory) curves_fact xml_file ->
   Debug.call 'p' (fun f ->  fprintf f "load_log: %s\n" xml_file);
-  let xml = Xml.parse_file xml_file in
+  let xml = ExtXml.parse_file xml_file in
   let data_file =  ExtXml.attrib xml "data_file" in
 
   Debug.call 'p' (fun f ->  fprintf f "data_file: %s\n" data_file);

sw/logalizer/play_core.ml

@@ -95,7 +95,7 @@ let get_log_bounds = fun () ->
 
 
 let load_log = fun xml_file ->
-  let xml = Xml.parse_file xml_file in
+  let xml = ExtXml.parse_file xml_file in
   let data_file =  ExtXml.attrib xml "data_file" in
 
   let f = Ocaml_tools.find_file [Filename.dirname xml_file] data_file in

sw/logalizer/sd2log.ml

@@ -28,7 +28,7 @@ module U = Unix
 let (//) = Filename.concat
 let var_path = Env.paparazzi_home // "var"
 let default_logs_path = var_path // "logs"
-let conf_xml = Xml.parse_file (Env.paparazzi_home // "conf" // "conf.xml")
+let conf_xml = ExtXml.parse_file (Env.paparazzi_home // "conf" // "conf.xml")
 
 
 module Tm_Pprz = PprzLink.Messages (struct let name = "telemetry" end)

sw/simulator/data.ml

@@ -29,10 +29,10 @@ let (//) = Filename.concat
 let user_conf_path = Env.paparazzi_home // "conf"
 let user_var_path = Env.paparazzi_home // "var"
 
-let conf_xml = Xml.parse_file (user_conf_path // "conf.xml")
+let conf_xml = ExtXml.parse_file (user_conf_path // "conf.xml")
 
 let messages_ap =
-  let xml = Xml.parse_file (user_var_path // "messages.xml") in
+  let xml = ExtXml.parse_file (user_var_path // "messages.xml") in
   try
     ExtXml.child xml ~select:(fun x -> Xml.attrib x "name" = "telemetry") "msg_class"
   with
@@ -65,9 +65,9 @@ let aircraft = fun name ->
   let airframe_file = user_conf_path // ExtXml.attrib aircraft_xml "airframe" in
 
   { id = id; name = name;
-    airframe = Xml.parse_file airframe_file;
-    flight_plan = Xml.parse_file (user_conf_path // ExtXml.attrib aircraft_xml "flight_plan");
-    radio = Xml.parse_file (user_conf_path // ExtXml.attrib aircraft_xml "radio")
+    airframe = ExtXml.parse_file airframe_file;
+    flight_plan = ExtXml.parse_file (user_conf_path // ExtXml.attrib aircraft_xml "flight_plan");
+    radio = ExtXml.parse_file (user_conf_path // ExtXml.attrib aircraft_xml "radio")
   }
 
 module type MISSION = sig val ac : aircraft end

sw/supervision/paparazzicenter.ml

@@ -39,7 +39,7 @@ let get_entry_value = fun xml name ->
   Xml.attrib e "value"
 
 let read_preferences = fun (gui:Gtk_pc.window) file (ac_combo:Gtk_tools.combo) (session_combo:Gtk_tools.combo) (target_combo:Gtk_tools.combo) ->
-  let xml = Xml.parse_file file in
+  let xml = ExtXml.parse_file file in
 
   let read_one = fun name use ->
     try
@@ -81,7 +81,7 @@ let add_entry = fun xml name value ->
 
 
 let write_preferences = fun (gui:Gtk_pc.window) file (ac_combo:Gtk_tools.combo) (session_combo:Gtk_tools.combo) (target_combo:Gtk_tools.combo) ->
-  let xml = if Sys.file_exists file then Xml.parse_file file else Xml.Element ("gconf", [], []) in
+  let xml = if Sys.file_exists file then ExtXml.parse_file file else Xml.Element ("gconf", [], []) in
 
   (* Save A/C name *)
   let xml =

sw/supervision/pc_aircraft.ml

@@ -53,7 +53,7 @@ let write_conf_xml = fun ?(user_save = false) () ->
   let l = Hashtbl.fold (fun _ a r -> a::r) Utils.aircrafts [] in
   let l = List.sort (fun ac1 ac2 -> compare (Xml.attrib ac1 "name") (Xml.attrib ac2 "name")) l in
   let c = Xml.Element ("conf", [], l) in
-  if c <> Xml.parse_file Utils.conf_xml_file then begin
+  if c <> ExtXml.parse_file Utils.conf_xml_file then begin
     if not (Sys.file_exists Utils.backup_xml_file) then
       ignore (Sys.command (sprintf "cp %s %s" Utils.conf_xml_file Utils.backup_xml_file));
     let f = open_out Utils.conf_xml_file in
@@ -234,7 +234,7 @@ let parse_ac_targets = fun target_combo ac_file (log:string->unit) ->
   store#clear ();
   (* add targets *)
   try
-    let af_xml = Xml.parse_file (Env.paparazzi_home // "conf" // ac_file) in
+    let af_xml = ExtXml.parse_file (Env.paparazzi_home // "conf" // ac_file) in
     let targets = get_targets_list af_xml in
     if List.length targets > 0 then
       List.iter (fun t -> Gtk_tools.add_to_combo target_combo (Xml.attrib t "name")) targets
@@ -256,7 +256,7 @@ let parse_ac_flash = fun target flash_combo ac_file ->
   store#clear ();
   Gtk_tools.add_to_combo flash_combo "Default";
   try
-    let af_xml = Xml.parse_file (Env.paparazzi_home // "conf" // ac_file) in
+    let af_xml = ExtXml.parse_file (Env.paparazzi_home // "conf" // ac_file) in
     let targets = get_targets_list af_xml in
     let board = Xml.attrib (List.find (fun t -> Xml.attrib t "name" = target) targets) "board" in
     (* board names as regexp *)
@@ -317,7 +317,7 @@ let ac_combo_handler = fun gui (ac_combo:Gtk_tools.combo) target_combo flash_com
           Xml.Element ("airframe", [], []);
       in
       let fp_file = (Env.paparazzi_home // "conf" // (Xml.attrib aircraft "flight_plan")) in
-      let fp_xml = Xml.parse_file fp_file in
+      let fp_xml = ExtXml.parse_file fp_file in
       let settings_modules = try
         get_settings_modules af_xml fp_xml (ExtXml.attrib_or_default aircraft "settings_modules" "")
       with

sw/tools/find_free_msg_id.ml

@@ -79,7 +79,7 @@ let group = fun l ->
 (* MAIN *)
 let () =
   (* reading files *)
-  let xml = Xml.parse_file messages_xml in
+  let xml = ExtXml.parse_file messages_xml in
   let messages =
     List.map (fun c -> ((Xml.attrib c "name"), Xml.children c)) (Xml.children xml)
   in

sw/tools/generators/gen_abi.ml

@@ -65,7 +65,7 @@ module Syntax = struct
 
   (** Translates one class of a XML message file into a list of messages *)
   let read = fun filename class_ ->
-    let xml = Xml.parse_file filename in
+    let xml = ExtXml.parse_file filename in
     try
       let xml_class = ExtXml.child ~select:(fun x -> Xml.attrib x "name" = class_) xml "msg_class" in
       let msgs = List.map struct_of_xml (Xml.children xml_class) in

sw/tools/generators/gen_aircraft.ml

@@ -266,8 +266,8 @@ let dump_firmware_sections = fun makefile_ac fp xml ->
 
 (** Extracts the makefile sections of an airframe file *)
 let extract_makefile = fun ac_id airframe_file flight_plan_file makefile_ac ->
-  let xml = Xml.parse_file airframe_file in
-  let fp = Xml.parse_file flight_plan_file in
+  let xml = ExtXml.parse_file airframe_file in
+  let fp = ExtXml.parse_file flight_plan_file in
   let f = open_out makefile_ac in
   fprintf f "# This file has been generated by gen_aircraft from %s by %s\n"
     airframe_file Sys.executable_name;
@@ -302,7 +302,7 @@ let () =
       failwith (sprintf "Usage: %s <Aircraft name> [conf.xml]" Sys.executable_name);
     let aircraft = Sys.argv.(1) in
     let conf_xml = if Array.length Sys.argv = 3 then Sys.argv.(2) else default_conf_xml in
-    let conf = Xml.parse_file conf_xml in
+    let conf = ExtXml.parse_file conf_xml in
     check_unique_id_and_name conf conf_xml;
     let aircraft_xml =
       try
@@ -336,7 +336,7 @@ let () =
     mkdir (aircraft_conf_dir // "telemetry");
 
     let target = try Sys.getenv "TARGET" with _ -> "" in
-    let modules = Gen_common.get_modules_of_config ~target (Xml.parse_file abs_airframe_file) (Xml.parse_file abs_flight_plan_file) in
+    let modules = Gen_common.get_modules_of_config ~target (ExtXml.parse_file abs_airframe_file) (Xml.parse_file abs_flight_plan_file) in
     (* normal settings *)
     let settings = try Env.filter_settings (value "settings") with _ -> "" in
     (* remove settings if not supported for the current target *)

sw/tools/generators/gen_airframe.ml

@@ -344,7 +344,7 @@ let rec parse_section = fun ac_id s ->
       printf "}\n\n";
     | "include" ->
       let filename = Str.global_replace (Str.regexp "\\$AC_ID") ac_id (ExtXml.attrib s "href") in
-      let subxml = Xml.parse_file filename in
+      let subxml = ExtXml.parse_file filename in
       printf "/* XML %s */" filename;
       nl ();
       List.iter (parse_section ac_id) (Xml.children subxml)

sw/tools/generators/gen_modules.ml

@@ -407,7 +407,7 @@ let () =
     let modules =
       try
         let target = Sys.getenv "TARGET" in
-        GC.get_modules_of_config ~target xml (Xml.parse_file fp_file)
+        GC.get_modules_of_config ~target xml (ExtXml.parse_file fp_file)
       with
       | Not_found -> failwith "TARTGET env needs to be specified to generate modules files"
     in

sw/tools/generators/gen_radio.ml

@@ -136,7 +136,7 @@ let _ =
   if Array.length Sys.argv < 2 then
     failwith "Usage: gen_radio xml_file";
   let xml_file = Sys.argv.(1) in
-  let xml = Xml.parse_file xml_file in
+  let xml = ExtXml.parse_file xml_file in
 
   printf "/* This file has been generated by gen_radio from %s */\n" xml_file;
   printf "/* Version %s */\n" (Env.get_paparazzi_version ());

sw/tools/generators/gen_settings.ml

@@ -299,7 +299,7 @@ let join_xml_files = fun xml_files ->
     | [f; n] -> f, n
     | _ -> xml_file, ""
     in
-    let xml = Xml.parse_file xml_file in
+    let xml = ExtXml.parse_file xml_file in
     let these_rc_settings =
       try Xml.children (ExtXml.child xml "rc_settings") with
           Not_found -> [] in

sw/tools/generators/gen_srtm.ml

@@ -35,7 +35,7 @@ let () =
   (* reading file function *)
   let read_file_and_print = fun out area ->
     try
-      let xml = Xml.parse_file (srtm_tmp_dir // area) in
+      let xml = ExtXml.parse_file (srtm_tmp_dir // area) in
       prerr_endline (Printf.sprintf "parsing file %s" area);
       let body = ExtXml.child xml "body" in
       let ul = ExtXml.child body "ul" in

sw/tools/wiki_gen/wiki_gen.ml

@@ -39,7 +39,7 @@ let print_targets = fun outfile xml ->
 
 
 let parse_firmware_xml = fun firmware_xml firmware_wiki ->
-  let xml = Xml.parse_file firmware_xml in
+  let xml = ExtXml.parse_file firmware_xml in
   let f = open_out firmware_wiki in
   fprintf f " This file has been generated from %s\n" firmware_xml;
   if ExtXml.tag_is xml "firmware" then begin