%s

" in - let titlepage = - Pxp_document.find ~deeply:false - (match_elt "div" "class" ~attr_value:"titlepage" ()) document in - let toc = - Pxp_document.find ~deeply:false - (match_elt "div" "class" ~attr_value:"toc" ()) document in - let parts = - Pxp_document.find_all ~deeply:false - (match_elt "div" "class" ~attr_value:"chapter" ()) document in - let title = - Pxp_document.find ~deeply:true - (fun node -> node#node_type = Pxp_document.T_element "title") doc#root in - title#data, - titlepage :: toc :: parts - -let localize_ids parts = - let id2part = Hashtbl.create 1023 in - let part_ids = ref [] in - List.iter - (fun part -> - match Pxp_document.find_all ~deeply:true (match_elt "a" "id" ()) part with - | part_id :: ids -> - let part_id = part_id#required_string_attribute "id" in - part_ids := part_id :: !part_ids; - List.iter - (fun id -> - let id = id#required_string_attribute "id" in - Hashtbl.add id2part id part_id) - ids - | _ -> failwith "can't find part id") - parts; - !part_ids, id2part - -let fname_of_part part_name = part_name ^ ".html" - -let get_part_id part = - let id = - try - Pxp_document.find ~deeply:true (match_elt "a" "id" ()) part - with Not_found -> failwith "can't find part id" in - id#required_string_attribute "id" - -let get_part_title part = - let h2 = - Pxp_document.find ~deeply:true - (match_elt "h2" "class" ~attr_value:"title" ()) part in - let text = - List.find (fun node -> node#node_type = Pxp_document.T_data) h2#sub_nodes in - text#data - -let iter_xrefs f node = - let a_s = Pxp_document.find_all ~deeply:true (match_elt "a" "href" ()) node in - List.iter - (fun (node: 'a node) -> - let href = node#required_string_attribute "href" in - assert (String.length href > 0); - if href.[0] = '#' then - let xref = String.sub href 1 (String.length href - 1) in - f node xref) - a_s - -let patch_toc part_ids id2part toc = - iter_xrefs - (fun node xref -> - if List.mem xref part_ids then - node#set_attribute "href" (Pxp_types.Value (fname_of_part xref)) - else - try - let part = Hashtbl.find id2part xref in - node#set_attribute "href" - (Pxp_types.Value (fname_of_part part ^ "#" ^ xref)) - with Not_found -> ()) - toc - -let patch_part part_ids id2part part = - let part_name = get_part_id part in - iter_xrefs - (fun node xref -> - try - let xref_part = Hashtbl.find id2part xref in - if xref_part <> part_name then - node#set_attribute "href" - (Pxp_types.Value (fname_of_part xref_part ^ "#" ^ xref)) - with Not_found -> ()) - part - -let open_formatter fname = - Unix.open_process_out (sprintf "xmllint --format -o %s -" fname) - -let close_formatter oc = ignore (Unix.close_process_out oc) - -let output_index title (titlepage: 'a node) (toc: 'a node) fname = - let oc = open_formatter fname in - output_string oc (xhtml_header title); - titlepage#write (`Out_channel oc) `Enc_utf8; - toc#write (`Out_channel oc) `Enc_utf8; - output_string oc xhtml_trailer; - close_formatter oc - -let output_part title (part: 'a node) fname = - let oc = open_formatter fname in - output_string oc - (xhtml_header (sprintf "%s - %s" title (get_part_title part))); - part#write (`Out_channel oc) `Enc_utf8; - output_string oc xhtml_trailer; - close_formatter oc - -let main () = - let doc = parse_xml fname in - match slice doc with - | title, (titlepage :: toc :: parts) -> - let part_ids, id2part = localize_ids parts in - patch_toc part_ids id2part toc; - List.iter (patch_part part_ids id2part) parts; - output_index title titlepage toc "index.html"; - List.iter - (fun part -> output_part title part (get_part_id part ^ ".html")) - parts - | _ -> failwith "Unrecognized document structure" - -let _ = main () -