13 let myself = F.basename (Sys.argv.(0))
15 let msg = P.sprintf "This file was generated by %s, do not edit" myself
18 let str = S.make 4 'n' in
19 if cell.M.cb.T.n then str.[0] <- 's';
20 if cell.M.cb.T.e then str.[1] <- 's';
21 if cell.M.cb.T.s then str.[2] <- 's';
22 if cell.M.cb.T.w then str.[3] <- 's';
25 let text baseuri ext = function
27 | T.Link (true, uri, s) -> P.sprintf "<a href=\"%s\">%s</a>" uri s
28 | T.Link (false, uri, s) ->
29 let uri = !O.baseuri ^ baseuri ^ uri ^ ext in
30 P.sprintf "<a href=\"%s\">%s</a>" uri s
33 if cell.M.ck = [] then "<br/>" else S.concat "" (L.map (text cell.M.cu cell.M.cx) cell.M.ck)
35 let ind i = S.make (2 * i) ' '
37 let out_cell och cell =
38 let cc = border cell in
39 P.fprintf och "%s<td class=\"%s\">%s</td>\n"
40 (ind (i+4)) (S.concat " " cc) (key cell)
43 P.fprintf och "%s<tr>\n" (ind (i+3));
44 A.iter (out_cell och) row;
45 P.fprintf och "%s</tr>\n" (ind (i+3))
47 let out_space och (name, uri) =
48 let name = if name = "" then name else ":" ^ name in
49 P.fprintf och " xmlns%s=\"%s\"\n" name uri
51 (****************************************************************************)
53 let open_out name spaces =
54 let fname = F.concat !O.output_dir (P.sprintf "%s.xsl" name) in
55 let spaces = ("xsl", "http://www.w3.org/1999/XSL/Transform") :: spaces in
56 let och = open_out fname in
57 P.fprintf och "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\n";
58 P.fprintf och "<!-- %s -->\n\n" msg;
59 P.fprintf och "<xsl:stylesheet version=\"1.0\"\n";
60 L.iter (out_space och) spaces;
61 P.fprintf och ">\n\n";
64 let output och name matrix =
65 P.fprintf och "<xsl:template name=\"%s\">\n" name;
66 P.fprintf och "%s<table cellpadding=\"4\" cellspacing=\"0\">\n" (ind (i+1));
67 P.fprintf och "%s<tbody>\n" (ind (i+2));
68 A.iter (out_row och) matrix.M.m;
69 P.fprintf och "%s</tbody>\n" (ind (i+2));
70 P.fprintf och "%s</table>\n" (ind (i+1));
71 P.fprintf och "</xsl:template>\n\n"
74 P.fprintf och "</xsl:stylesheet>\n";
77 let map_incs och name =
78 P.fprintf och "<xsl:include href=\"%s.xsl\"/>\n" name
80 let map_tbls och name =
81 P.fprintf och "%s<xsl:when test=\"@name='%s'\">\n" (ind (i+2)) name;
82 P.fprintf och "%s<xsl:call-template name=\"%s\"/>\n" (ind (i+3)) name;
83 P.fprintf och "%s</xsl:when>\n" (ind (i+2))
85 let write_hook name incs tbls =
86 let och = open_out name [] in
87 L.iter (map_incs och) incs;
88 P.fprintf och "\n<xsl:template name=\"%s\">\n" name;
89 P.fprintf och "%s<xsl:choose>\n" (ind (i+1));
90 L.iter (map_tbls och) tbls;
91 P.fprintf och "%s</xsl:choose>\n" (ind (i+1));
92 P.fprintf och "</xsl:template>\n\n";