1 <!ENTITY readme.code.header '
5 <!ENTITY readme.code.footnote-printer '
6 class type footnote_printer =
8 method footnote_to_html : store_type -> out_channel -> unit
13 method alloc_footnote : footnote_printer -> int
14 method print_footnotes : out_channel -> unit
18 <!ENTITY readme.code.store '
22 val mutable footnotes = ( [] : (int * footnote_printer) list )
23 val mutable next_footnote_number = 1
25 method alloc_footnote n =
26 let number = next_footnote_number in
27 next_footnote_number <- number+1;
28 footnotes <- footnotes @ [ number, n ];
31 method print_footnotes ch =
32 if footnotes <> [] then begin
33 output_string ch "<hr align=left noshade=noshade width=\"30&percent;\">\n";
34 output_string ch "<dl>\n";
37 n # footnote_to_html (self : #store_type :> store_type) ch)
39 output_string ch "</dl>\n";
45 <!ENTITY readme.code.escape-html '
48 (Str.regexp "<\\|>\\|&\\|\"")
50 match Str.matched_string s with
51 "<" -> "&lt;"
52 | ">" -> "&gt;"
53 | "&" -> "&amp;"
54 | "\"" -> "&quot;"
55 | _ -> assert false)
59 <!ENTITY readme.code.shared '
60 class virtual shared =
63 (* --- default_ext --- *)
65 val mutable node = (None : shared node option)
67 method clone = {< >}
78 method virtual to_html : store -> out_channel -> unit
83 <!ENTITY readme.code.only-data '
88 method to_html store ch =
89 output_string ch (escape_html (self # node # data))
93 <!ENTITY readme.code.no-markup '
98 method to_html store ch =
100 (fun n -> n # extension # to_html store ch)
101 (self # node # sub_nodes)
105 <!ENTITY readme.code.readme '
110 method to_html store ch =
113 ch "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">";
115 ch "<!-- WARNING! This is a generated file, do not edit! -->\n";
117 match self # node # attribute "title" with
119 | _ -> assert false
122 try (self # node # dtd # par_entity "readme:html:header")
124 with WF_error _ -> "", false in
125 let html_trailer, _ =
126 try (self # node # dtd # par_entity "readme:html:trailer")
128 with WF_error _ -> "", false in
129 let html_bgcolor, _ =
130 try (self # node # dtd # par_entity "readme:html:bgcolor")
132 with WF_error _ -> "white", false in
133 let html_textcolor, _ =
134 try (self # node # dtd # par_entity "readme:html:textcolor")
136 with WF_error _ -> "", false in
137 let html_alinkcolor, _ =
138 try (self # node # dtd # par_entity "readme:html:alinkcolor")
140 with WF_error _ -> "", false in
141 let html_vlinkcolor, _ =
142 try (self # node # dtd # par_entity "readme:html:vlinkcolor")
144 with WF_error _ -> "", false in
145 let html_linkcolor, _ =
146 try (self # node # dtd # par_entity "readme:html:linkcolor")
148 with WF_error _ -> "", false in
149 let html_background, _ =
150 try (self # node # dtd # par_entity "readme:html:background")
152 with WF_error _ -> "", false in
154 output_string ch "<html><header><title>\n";
155 output_string ch (escape_html title);
156 output_string ch "</title></header>\n";
157 output_string ch "<body ";
159 (fun (name,value) ->
160 if value <> "" then
161 output_string ch (name ^ "=\"" ^ escape_html value ^ "\" "))
162 [ "bgcolor", html_bgcolor;
163 "text", html_textcolor;
164 "link", html_linkcolor;
165 "alink", html_alinkcolor;
166 "vlink", html_vlinkcolor;
168 output_string ch ">\n";
169 output_string ch html_header;
170 output_string ch "<h1>";
171 output_string ch (escape_html title);
172 output_string ch "</h1>\n";
173 (* process main content: *)
175 (fun n -> n # extension # to_html store ch)
176 (self # node # sub_nodes);
177 (* now process footnotes *)
178 store # print_footnotes ch;
180 output_string ch html_trailer;
181 output_string ch "</html>\n";
186 <!ENTITY readme.code.section '
187 class section the_tag =
193 method to_html store ch =
194 let sub_nodes = self # node # sub_nodes in
196 title_node :: rest ->
197 output_string ch ("<" ^ tag ^ ">\n");
198 title_node # extension # to_html store ch;
199 output_string ch ("\n</" ^ tag ^ ">");
201 (fun n -> n # extension # to_html store ch)
208 class sect1 = section "h1";;
209 class sect2 = section "h3";;
210 class sect3 = section "h4";;
212 <!ENTITY readme.code.map-tag '
213 class map_tag the_target_tag =
217 val target_tag = the_target_tag
219 method to_html store ch =
220 output_string ch ("<" ^ target_tag ^ ">\n");
222 (fun n -> n # extension # to_html store ch)
223 (self # node # sub_nodes);
224 output_string ch ("\n</" ^ target_tag ^ ">");
228 class p = map_tag "p";;
229 class em = map_tag "b";;
230 class ul = map_tag "ul";;
231 class li = map_tag "li";;
233 <!ENTITY readme.code.br '
238 method to_html store ch =
239 output_string ch "<br>\n";
241 (fun n -> n # extension # to_html store ch)
242 (self # node # sub_nodes);
246 <!ENTITY readme.code.code '
251 method to_html store ch =
252 let data = self # node # data in
254 let l = String.length data in
255 let rec preprocess i column =
256 (* this is very ineffective but comprehensive: *)
260 let n = 8 - (column mod 8) in
261 String.make n ' ' ^ preprocess (i+1) (column + n)
262 | '\n' ->
263 "\n" ^ preprocess (i+1) 0
265 String.make 1 c ^ preprocess (i+1) (column + 1)
269 output_string ch "<p><pre>";
270 output_string ch (escape_html (preprocess 0 0));
271 output_string ch "</pre></p>";
276 <!ENTITY readme.code.a '
281 method to_html store ch =
282 output_string ch "<a ";
284 match self # node # attribute "href" with
285 Value v -> escape_html v
286 | Valuelist _ -> assert false
287 | Implied_value ->
288 begin match self # node # attribute "readmeref" with
289 Value v -> escape_html v ^ ".html"
290 | Valuelist _ -> assert false
291 | Implied_value ->
295 if href <> "" then
296 output_string ch ("href=\"" ^ href ^ "\"");
297 output_string ch ">";
298 output_string ch (escape_html (self # node # data));
299 output_string ch "</a>";
304 <!ENTITY readme.code.footnote '
309 val mutable footnote_number = 0
311 method to_html store ch =
313 store # alloc_footnote (self : #shared :> footnote_printer) in
315 "footnote" ^ string_of_int number in
317 "textnote" ^ string_of_int number in
318 footnote_number <- number;
319 output_string ch ( "<a name=\"" ^ text_anchor ^ "\" href=\"#" ^
320 foot_anchor ^ "\">[" ^ string_of_int number ^
323 method footnote_to_html store ch =
324 (* prerequisite: we are in a definition list <dl>...</dl> *)
326 "footnote" ^ string_of_int footnote_number in
328 "textnote" ^ string_of_int footnote_number in
329 output_string ch ("<dt><a name=\"" ^ foot_anchor ^ "\" href=\"#" ^
330 text_anchor ^ "\">[" ^ string_of_int footnote_number ^
331 "]</a></dt>\n<dd>");
333 (fun n -> n # extension # to_html store ch)
334 (self # node # sub_nodes);
335 output_string ch ("\n</dd>")
340 <!ENTITY readme.code.tag-map '
345 ~data_exemplar:(new data_impl (new only_data))
346 ~default_element_exemplar:(new element_impl (new no_markup))
348 [ "readme", (new element_impl (new readme));
349 "sect1", (new element_impl (new sect1));
350 "sect2", (new element_impl (new sect2));
351 "sect3", (new element_impl (new sect3));
352 "title", (new element_impl (new no_markup));
353 "p", (new element_impl (new p));
354 "br", (new element_impl (new br));
355 "code", (new element_impl (new code));
356 "em", (new element_impl (new em));
357 "ul", (new element_impl (new ul));
358 "li", (new element_impl (new li));
359 "footnote", (new element_impl (new footnote : #shared :> shared));
360 "a", (new element_impl (new a));