--- /dev/null
+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
+ match stats.KU.st_kind with
+ | KU.S_REG ->
+ KP.fprintf och " <rlink to=\"%s\">%s</rlink>\n" fname name;
+ dirs
+ | KU.S_DIR -> name :: dirs
+ | _ -> dirs
+
+let list_dir dname och =
+ let dir = Sys.readdir dname in
+ Array.sort String.compare dir;
+ Array.fold_left (out_entry dname och) [] dir
+
+let out_index dname och =
+ KP.fprintf och "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\n";
+ KP.fprintf och "<page description=\"\\lambda\\delta home page\"\n";
+ KP.fprintf och " title=\"\\lambda\\delta home page\"\n";
+ KP.fprintf och " head=\"λδ digital library (LDDL)\"\n";
+ KP.fprintf och ">\n";
+ KP.fprintf och " <sitemap name=\"sitemap\"/>\n";
+ KP.fprintf och " <section5 name=\"index\">Index</section5>\n";
+ KP.fprintf och " <subsection name=\"current\">\n";
+
+ KP.fprintf och " </subsection>\n";
+ KP.fprintf och " <body>\n";
+ let dirs = list_dir dname och in
+ KP.fprintf och " </body>\n";
+ KP.fprintf och " <footer><helena-label/></footer>\n";
+ KP.fprintf och "</page>\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
+ close_out och;
+ let map name = out_dir (KF.concat dname name) in
+ List.iter map dirs
+
+let help = "Usage: index [ <dir> ]*"
+
+let main =
+ Arg.parse [
+ ] out_dir help
projects / helm.git / commitdiff