X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fwww%2Flambdadelta%2Fbin%2Findex%2Findex.ml;fp=helm%2Fwww%2Flambdadelta%2Fbin%2Findex%2Findex.ml;h=0000000000000000000000000000000000000000;hb=d2545ffd201b1aa49887313791386add78fa8603;hp=9496cc7d2e806635ba83826f8f06492c96254dac;hpb=57ae1762497a5f3ea75740e2908e04adb8642cc2;p=helm.git diff --git a/helm/www/lambdadelta/bin/index/index.ml b/helm/www/lambdadelta/bin/index/index.ml deleted file mode 100644 index 9496cc7d2..000000000 --- a/helm/www/lambdadelta/bin/index/index.ml +++ /dev/null @@ -1,123 +0,0 @@ -module KF = Filename -module KP = Printf -module KU = Unix - -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 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 " \n" oname base; - dirs - | KU.S_DIR -> - let oname = concats [st.bd; st.op; dname; name] in - KP.fprintf och " \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 st dname och = - let iname = concats [st.bd; st.ip; dname] in - let dir = Sys.readdir iname in - Array.sort String.compare dir; - KP.fprintf och " \n"; - let dirs = Array.fold_left (out_entry st dname och) [] dir in - KP.fprintf och " \n"; - dirs - -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"; - mk_path st och; - KP.fprintf och " \n"; - KP.fprintf och " \n"; - let dirs = list_dir st dname och in - KP.fprintf och " \n"; - KP.fprintf och " \n"; - KP.fprintf och "\n"; - dirs - -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 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 process dname = - out_dir !imp_st (normalize dname) - -let main = - Arg.parse [ - "-b", Arg.String set_b, help_b; - "-i", Arg.String set_i, help_i; - "-o", Arg.String set_o, help_o; - ] process help