16 let initial_status = {
17 bd = ""; ip = ""; op = "";
21 let imp_st = ref initial_status
23 let i_ext = ".ld.ldw.xml"
24 let o_ext = ".ld.html"
27 List.fold_left KF.concat "" l
29 let concat st dname = {st with
30 ip = KF.concat st.ip dname; op = KF.concat st.op dname;
34 if dname = KF.current_dir_name then "" else dname
36 let mk_rlink s_to s_body =
37 KP.sprintf "<rlink to=\"%s\">%s</rlink>" s_to s_body
39 let out_entry st dname och dirs name =
40 let iname = concats [st.bd; st.ip; dname; name] in
41 let stats = KU.lstat iname in
42 match stats.KU.st_kind with
43 | KU.S_REG when KF.check_suffix name i_ext ->
44 let base = KF.chop_suffix name i_ext in
45 let oname = concats [st.bd; st.op; dname; base^o_ext] in
46 KP.fprintf och " <file class=\"global emph\" type=\"🗏\" to=\"%s\" name=\"%s.ld\"/>\n" oname base;
49 let oname = concats [st.bd; st.op; dname; name] in
50 KP.fprintf och " <file class=\"alpha emph\" type=\"🗁\" to=\"%s\" name=\"%s/\"/>\n" oname name;
56 let path = String.concat "/" (List.rev st.cp) in
57 KP.fprintf och " Contents of %s/\n" path
59 let list_dir st dname och =
60 let iname = concats [st.bd; st.ip; dname] in
61 let dir = Sys.readdir iname in
62 Array.sort String.compare dir;
63 KP.fprintf och " <index>\n";
64 let dirs = Array.fold_left (out_entry st dname och) [] dir in
65 KP.fprintf och " </index>\n";
68 let out_index st dname och =
69 KP.fprintf och "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\n";
70 KP.fprintf och "<page xmlns=\"http://lambdadelta.info/\"\n";
71 KP.fprintf och " description=\"\\lambda\\delta home page\"\n";
72 KP.fprintf och " title=\"\\lambda\\delta home page\"\n";
73 KP.fprintf och " head=\"λδ digital library (LDDL)\"\n";
75 KP.fprintf och " <sitemap name=\"sitemap\"/>\n";
76 KP.fprintf och " <section5 name=\"index\">Index</section5>\n";
77 KP.fprintf och " <subsection name=\"path\">\n";
79 KP.fprintf och " </subsection>\n";
80 KP.fprintf och " <body>\n";
81 let dirs = list_dir st dname och in
82 KP.fprintf och " </body>\n";
83 KP.fprintf och " <footer><img label=\"helena\"/></footer>\n";
84 KP.fprintf och "</page>\n";
87 let rec out_dir st dname =
90 then concats [st.bd; st.op], "ld:"
91 else concats [st.bd; st.op; dname], dname
93 let st = {st with cp = mk_rlink s_to s_body :: st.cp} in
94 let oname = concats [st.bd; st.ip; dname; "index.ldw.xml"] in
95 let och = open_out oname in
96 let dirs = out_index st dname och in
98 let map st = out_dir (concat st dname) in
99 List.iter (map st) dirs
101 let help_b = "<dir> Set this base directory"
102 let help_i = "<dir> Set this input prefix"
103 let help_o = "<dir> Set this output prefix"
104 let help = "Usage: index [ -bio <dir> | <dir> ]*"
107 imp_st := {!imp_st with bd = normalize bd}
110 imp_st := {!imp_st with ip = normalize ip}
113 imp_st := {!imp_st with op = normalize op}
116 out_dir !imp_st (normalize dname)
120 "-b", Arg.String set_b, help_b;
121 "-i", Arg.String set_i, help_i;
122 "-o", Arg.String set_o, help_o;