planned dehyphenation of lambdadelta eventually took place!

[helm.git] / helm / www / lambdadelta / bin / xhtbl / xmlUnparser.ml

diff --git a/helm/www/lambdadelta/bin/xhtbl/xmlUnparser.ml b/helm/www/lambdadelta/bin/xhtbl/xmlUnparser.ml
new file mode 100644 (file)
index 0000000..3583c2f
--- /dev/null
+++ b/helm/www/lambdadelta/bin/xhtbl/xmlUnparser.ml
@@ -0,0 +1,82 @@
+module A = Array
+module F = Filename
+module L = List
+module P = Printf
+module S = String
+
+module O = Options
+module T = Table
+module M = Matrix
+
+let i = 0
+
+let myself = F.basename (Sys.argv.(0))
+
+let msg = P.sprintf "This file was generated by %s, do not edit" myself
+
+let border cell =
+   let str = S.make 4 'n' in
+   if cell.M.cb.T.n then str.[0] <- 's';   
+   if cell.M.cb.T.e then str.[1] <- 's';
+   if cell.M.cb.T.s then str.[2] <- 's';
+   if cell.M.cb.T.w then str.[3] <- 's';
+   str :: cell.M.cc
+
+let key cell =
+   if cell.M.ck = [] then "<br/>" else S.concat " " cell.M.ck
+
+let ind i = S.make (2 * i) ' '
+
+let out_cell och cell =
+   let cc = border cell in
+   P.fprintf och "%s<td class=\"%s\">%s</td>\n"
+      (ind (i+4)) (S.concat " " cc) (key cell)
+
+let out_row och row =
+   P.fprintf och "%s<tr>\n" (ind (i+3));
+   A.iter (out_cell och) row;
+   P.fprintf och "%s</tr>\n" (ind (i+3))
+
+(****************************************************************************)
+
+let open_out html name =
+   let fname = F.concat !O.output_dir (P.sprintf "%s.xsl" name) in
+   let och = open_out fname in
+   P.fprintf och "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\n";
+   P.fprintf och "<!-- %s -->\n\n" msg;   
+   P.fprintf och "<xsl:stylesheet version=\"1.0\"\n";
+   P.fprintf och "                xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\"\n";
+   if html then P.fprintf och "                xmlns=\"http://www.w3.org/1999/xhtml\"\n";
+   P.fprintf och ">\n\n";
+   och
+
+let output och name matrix =
+   P.fprintf och "<xsl:template name=\"%s\">\n" name;
+   P.fprintf och "%s<table cellpadding=\"4\" cellspacing=\"0\">\n" (ind (i+1));
+   P.fprintf och "%s<tbody>\n" (ind (i+2));
+   A.iter (out_row och) matrix.M.m; 
+   P.fprintf och "%s</tbody>\n" (ind (i+2));
+   P.fprintf och "%s</table>\n" (ind (i+1));
+   P.fprintf och "</xsl:template>\n\n"
+
+let close_out och =
+   P.fprintf och "</xsl:stylesheet>\n";
+   close_out och
+
+let map_incs och name =
+   P.fprintf och "<xsl:include href=\"%s.xsl\"/>\n" name
+
+let map_tbls och name =
+   P.fprintf och "%s<xsl:when test=\"@name='%s'\">\n" (ind (i+2)) name;
+   P.fprintf och "%s<xsl:call-template name=\"%s\"/>\n" (ind (i+3)) name;
+   P.fprintf och "%s</xsl:when>\n" (ind (i+2))
+
+let write_hook name incs tbls =
+   let och = open_out false name in
+   L.iter (map_incs och) incs;
+   P.fprintf och "\n<xsl:template name=\"%s\">\n" name;
+   P.fprintf och "%s<xsl:choose>\n" (ind (i+1));
+   L.iter (map_tbls och) tbls;   
+   P.fprintf och "%s</xsl:choose>\n" (ind (i+1));
+   P.fprintf och "</xsl:template>\n\n";
+   close_out och