*)
open Printf
-open Pxp_types
-open Pxp_ev_parser
let debug = false
let debug_print s = if debug then prerr_endline s
`Entities, "data/extra-entities.xml";
]
-
-let rec find_first_tag pull_parser =
- match pull_parser () with
- | Some (E_start_tag _ as e) -> e
- | None -> assert false
- | _ -> find_first_tag pull_parser
-
-let iter_entities_file f pull_parser =
- ignore (find_first_tag pull_parser); (* <entities-table> *)
- let rec aux () =
- match pull_parser () with
- | Some (E_start_tag ("entity", attrs, _, _)) ->
- (try
- let name = List.assoc "name" attrs in
- let value = List.assoc "value" attrs in
- f name value
- with Not_found -> ());
- aux ()
- | None -> ()
- | _ -> aux ()
+let iter_gen record_tag name_field value_field f fname =
+ let start_element tag attrs =
+ if tag = record_tag then
+ try
+ let name = List.assoc name_field attrs in
+ let value = List.assoc value_field attrs in
+ f name value
+ with Not_found -> ()
in
- aux ()
+ let callbacks = {
+ XmlPushParser.default_callbacks with
+ XmlPushParser.start_element = Some start_element
+ } in
+ let xml_parser = XmlPushParser.create_parser callbacks in
+ XmlPushParser.parse xml_parser (`File fname)
-let iter_dictionary_file f pull_parser =
- ignore (find_first_tag pull_parser); (* <dictionary> *)
- let rec aux () =
- match pull_parser () with
- | Some (E_start_tag ("entry", attrs, _, _)) ->
- (try
- let name = List.assoc "name" attrs in
- let value = List.assoc "val" attrs in
- f name value
- with Not_found -> ());
- aux ()
- | None -> ()
- | _ -> aux ()
- in
- aux ()
+let iter_entities_file = iter_gen "entity" "name" "value"
+let iter_dictionary_file = iter_gen "entry" "name" "val"
let parse_from_xml () =
let (macro2utf8, utf82macro) = (Hashtbl.create 2000, Hashtbl.create 2000) in
let add_macro macro utf8 =
debug_print (sprintf "Adding macro %s = '%s'" macro utf8);
Hashtbl.add macro2utf8 macro utf8;
-(* Hashtbl.add utf82macro utf8 macro *)
+ Hashtbl.add utf82macro utf8 macro
in
let fill_table () =
List.iter
(fun (typ, fname) ->
- let entry = `Entry_document [ `Extend_dtd_fully; `Parse_xml_decl ] in
- let config = PxpHelmConf.pxp_config in
- let entity_manager =
- create_entity_manager ~is_document:true config (from_file fname)
- in
- let pull_parser = create_pull_parser config entry entity_manager in
match typ with
- | `Entities -> iter_entities_file add_macro pull_parser
- | `Dictionary -> iter_dictionary_file add_macro pull_parser)
+ | `Entities -> iter_entities_file add_macro fname
+ | `Dictionary -> iter_dictionary_file add_macro fname)
xml_tables
in
fill_table ();
- macro2utf8
+ macro2utf8, utf82macro
let main () =
let oc = open_out Sys.argv.(1) in
output_string oc "(* GENERATED by make_table: DO NOT EDIT! *)\n";
output_string oc "let macro2utf8 = Hashtbl.create 2000\n";
- let macro2utf8 = parse_from_xml () in
+ output_string oc "let utf82macro = Hashtbl.create 2000\n";
+ let macro2utf8, utf82macro = parse_from_xml () in
Hashtbl.iter
(fun macro utf8 ->
fprintf oc "let _ = Hashtbl.add macro2utf8 \"%s\" \"%s\"\n"
macro (String.escaped utf8))
macro2utf8;
+ Hashtbl.iter
+ (fun utf8 macro ->
+ fprintf oc "let _ = Hashtbl.add utf82macro \"%s\" \"%s\"\n"
+ (String.escaped utf8) macro)
+ utf82macro;
close_out oc
let _ = main ()