(* Copyright (C) 2000, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science * Department, University of Bologna, Italy. * * HELM is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * HELM is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with HELM; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, * MA 02111-1307, USA. * * For details, see the HELM World-Wide-Web page, * http://cs.unibo.it/helm/. *) module R = Helm_registry type script = { name: string; contents: Types.items } type status = { helm_dir: string; heading_path: string; heading_lines: int; package: string; base_uri: string; input_path: string; output_path: string; script_ext: string; files: string list; requires: (string * string) list; scripts: script array } let default_script = { name = ""; contents = [] } let default_scripts = 2 let load_registry registry = let suffix = ".conf.xml" in let registry = if Filename.check_suffix registry suffix then registry else registry ^ suffix in Printf.eprintf "reading configuration %s ...\n" registry; flush stderr; R.load_from registry let set_files st = let eof ich = try Some (input_line ich) with End_of_file -> None in let trim l = Filename.chop_extension (Str.string_after l 2) in let cmd = Printf.sprintf "cd %s && find -name *%s" st.input_path st.script_ext in let ich = Unix.open_process_in cmd in let rec aux files = match eof ich with | None -> List.rev files | Some l -> aux (trim l :: files) in let files = aux [] in let _ = Unix.close_process_in ich in {st with files = files} let set_requires st = let map file = (Filename.basename file, file) in let requires = List.rev_map map st.files in {st with requires = requires} let init () = let default_registry = "transcript" in load_registry default_registry let make registry = load_registry registry; let st = { helm_dir = R.get_string "transcript.helm_dir"; heading_path = R.get_string "transcript.heading_path"; heading_lines = R.get_int "transcript.heading_lines"; package = R.get_string "package.name"; base_uri = R.get_string "package.base_uri"; input_path = R.get_string "package.input_path"; output_path = R.get_string "package.output_path"; script_ext = R.get_string "package.script_type"; files = []; requires = []; scripts = Array.make default_scripts default_script } in prerr_endline "reading file names ..."; let st = set_files st in let st = set_requires st in st let get_index st name = let rec get_index name i = if i >= Array.length st.scripts then None else if st.scripts.(i).name = name then Some i else get_index name (succ i) in match get_index name 0, get_index "" 0 with | Some i, _ | _, Some i -> i | None, None -> failwith "not enought script entries" let set_items st name items = let i = get_index st name in let script = st.scripts.(i) in let contents = List.rev_append items script.contents in st.scripts.(i) <- {name = name; contents = contents} let set_heading st name = let heading = Filename.concat st.helm_dir st.heading_path, st.heading_lines in set_items st name [Types.Heading heading] let set_baseuri st name = let baseuri = Filename.concat st.base_uri name in set_items st name [Types.BaseUri baseuri] let commit st name = let i = get_index st name in let script = st.scripts.(i) in let path = Filename.concat st.output_path (Filename.dirname name) in let name = Filename.concat st.output_path (name ^ ".ma") in let cmd = Printf.sprintf "mkdir -p %s" path in let _ = Sys.command cmd in let och = open_out name in Grafite.commit och script.contents; close_out och; st.scripts.(i) <- default_script let produce st = let init name = set_heading st name; set_baseuri st name in let produce st name = Printf.eprintf "processing file name: %s ...\n" name; flush stderr; let file = Filename.concat st.input_path (name ^ st.script_ext) in let ich = open_in file in let lexbuf = Lexing.from_channel ich in try let items = V8Parser.items V8Lexer.token lexbuf in close_in ich; init name; set_items st name items; commit st name with e -> prerr_endline (Printexc.to_string e); close_in ich in init st.package; List.iter (produce st) st.files; commit st st.package