X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2Fwww%2Flambdadelta%2Fbin%2Findex%2Findex.ml;h=c22e290acd73f9befa4322f511ea591ec16866db;hp=c7fd48d908985101a5f690fb35bd36cfc0d60a06;hb=7bb7028a9aafcfd5c6570f4ad5ca472f19691bfc;hpb=cb9a85ca34af1e956c1e4714b0d64bd38c7feb18 diff --git a/helm/www/lambdadelta/bin/index/index.ml b/helm/www/lambdadelta/bin/index/index.ml index c7fd48d90..c22e290ac 100644 --- a/helm/www/lambdadelta/bin/index/index.ml +++ b/helm/www/lambdadelta/bin/index/index.ml @@ -2,48 +2,119 @@ module KF = Filename module KP = Printf module KU = Unix -let out_entry dname och dirs name = - let fname = KF.concat dname name in - let stats = KU.lstat fname in +type status = { +(* base directory *) + bd: string; +(* input prefix *) + ip: string; +(* output prefix *) + op: string; +(* current path *) + cp: string list +} + +let initial_status = { + bd = ""; ip = ""; op = ""; + cp = []; +} + +let imp_st = ref initial_status + +let i_ext = ".ld.ldw.xml" +let o_ext = ".ld.html" + +let concats l = + List.fold_left KF.concat "" l + +let concat st dname = {st with + ip = KF.concat st.ip dname; op = KF.concat st.op dname; +} + +let normalize dname = + if dname = KF.current_dir_name then "" else dname + +let mk_rlink s_to s_body = + KP.sprintf "%s" s_to s_body + +let out_entry st dname och dirs name = + let iname = concats [st.bd; st.ip; dname; name] in + let stats = KU.lstat iname in match stats.KU.st_kind with - | KU.S_REG -> - KP.fprintf och " %s\n" fname name; + | KU.S_REG when KF.check_suffix name i_ext -> + let base = KF.chop_suffix name i_ext in + let oname = concats [st.bd; st.op; dname; base^o_ext] in + KP.fprintf och " 🗏 %s.ld\n" oname base; dirs - | KU.S_DIR -> name :: dirs - | _ -> dirs + | KU.S_DIR -> + let oname = concats [st.bd; st.op; dname; name] in + KP.fprintf och " 🗁 %s/\n" oname name; + name :: dirs + | _ -> + dirs + +let mk_path st och = + let path = String.concat "/" (List.rev st.cp) in + KP.fprintf och " Contents of %s/\n" path -let list_dir dname och = - let dir = Sys.readdir dname in +let list_dir st dname och = + let iname = concats [st.bd; st.ip; dname] in + let dir = Sys.readdir iname in Array.sort String.compare dir; - Array.fold_left (out_entry dname och) [] dir + Array.fold_left (out_entry st dname och) [] dir -let out_index dname och = +let out_index st dname och = KP.fprintf och "\n\n"; - KP.fprintf och "\n"; KP.fprintf och " \n"; KP.fprintf och " Index\n"; - KP.fprintf och " \n"; - + KP.fprintf och " \n"; + mk_path st och; KP.fprintf och " \n"; KP.fprintf och " \n"; - let dirs = list_dir dname och in + let dirs = list_dir st dname och in KP.fprintf och " \n"; - KP.fprintf och " \n"; + KP.fprintf och " \n"; KP.fprintf och "\n"; dirs -let rec out_dir dname = - let och = open_out (KF.concat dname "index.ldw.xml") in - let dirs = out_index dname och in +let rec out_dir st dname = + let s_to, s_body = + if dname = "" + then concats [st.bd; st.op], "ld:" + else concats [st.bd; st.op; dname], dname + in + let st = {st with cp = mk_rlink s_to s_body :: st.cp} in + let oname = concats [st.bd; st.ip; dname; "index.ldw.xml"] in + let och = open_out oname in + let dirs = out_index st dname och in close_out och; - let map name = out_dir (KF.concat dname name) in - List.iter map dirs + let map st = out_dir (concat st dname) in + List.iter (map st) dirs + +let help_b = " Set this base directory" +let help_i = " Set this input prefix" +let help_o = " Set this output prefix" +let help = "Usage: index [ -bio | ]*" + +let set_b bd = + imp_st := {!imp_st with bd = normalize bd} + +let set_i ip = + imp_st := {!imp_st with ip = normalize ip} + +let set_o op = + imp_st := {!imp_st with op = normalize op} -let help = "Usage: index [ ]*" +let process dname = + out_dir !imp_st (normalize dname) let main = Arg.parse [ - ] out_dir help + "-b", Arg.String set_b, help_b; + "-i", Arg.String set_i, help_i; + "-o", Arg.String set_o, help_o; + ] process help