2 * ----------------------------------------------------------------------
7 (*$ readme.code.header *)
13 (*$ readme.code.footnote-printer *)
14 class type footnote_printer =
16 method footnote_to_html : store_type -> out_channel -> unit
21 method alloc_footnote : footnote_printer -> int
22 method print_footnotes : out_channel -> unit
28 (*$ readme.code.store *)
32 val mutable footnotes = ( [] : (int * footnote_printer) list )
33 val mutable next_footnote_number = 1
35 method alloc_footnote n =
36 let number = next_footnote_number in
37 next_footnote_number <- number+1;
38 footnotes <- footnotes @ [ number, n ];
41 method print_footnotes ch =
42 if footnotes <> [] then begin
43 output_string ch "<hr align=left noshade=noshade width=\"30%\">\n";
44 output_string ch "<dl>\n";
47 n # footnote_to_html (self : #store_type :> store_type) ch)
49 output_string ch "</dl>\n";
58 (*$ readme.code.escape-html *)
61 (Str.regexp "<\\|>\\|&\\|\"")
63 match Str.matched_string s with
74 (*$ readme.code.shared *)
75 class virtual shared =
78 (* --- default_ext --- *)
80 val mutable node = (None : shared node option)
93 method virtual to_html : store -> out_channel -> unit
100 (*$ readme.code.only-data *)
105 method to_html store ch =
106 output_string ch (escape_html (self # node # data))
112 (*$ readme.code.no-markup *)
117 method to_html store ch =
119 (fun n -> n # extension # to_html store ch)
120 (self # node # sub_nodes)
126 (*$ readme.code.readme *)
131 method to_html store ch =
134 ch "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">";
136 ch "<!-- WARNING! This is a generated file, do not edit! -->\n";
138 match self # node # attribute "title" with
143 try (self # node # dtd # par_entity "readme:html:header")
145 with WF_error _ -> "", false in
146 let html_trailer, _ =
147 try (self # node # dtd # par_entity "readme:html:trailer")
149 with WF_error _ -> "", false in
150 let html_bgcolor, _ =
151 try (self # node # dtd # par_entity "readme:html:bgcolor")
153 with WF_error _ -> "white", false in
154 let html_textcolor, _ =
155 try (self # node # dtd # par_entity "readme:html:textcolor")
157 with WF_error _ -> "", false in
158 let html_alinkcolor, _ =
159 try (self # node # dtd # par_entity "readme:html:alinkcolor")
161 with WF_error _ -> "", false in
162 let html_vlinkcolor, _ =
163 try (self # node # dtd # par_entity "readme:html:vlinkcolor")
165 with WF_error _ -> "", false in
166 let html_linkcolor, _ =
167 try (self # node # dtd # par_entity "readme:html:linkcolor")
169 with WF_error _ -> "", false in
170 let html_background, _ =
171 try (self # node # dtd # par_entity "readme:html:background")
173 with WF_error _ -> "", false in
175 output_string ch "<html><header><title>\n";
176 output_string ch (escape_html title);
177 output_string ch "</title></header>\n";
178 output_string ch "<body ";
182 output_string ch (name ^ "=\"" ^ escape_html value ^ "\" "))
183 [ "bgcolor", html_bgcolor;
184 "text", html_textcolor;
185 "link", html_linkcolor;
186 "alink", html_alinkcolor;
187 "vlink", html_vlinkcolor;
189 output_string ch ">\n";
190 output_string ch html_header;
191 output_string ch "<h1>";
192 output_string ch (escape_html title);
193 output_string ch "</h1>\n";
194 (* process main content: *)
196 (fun n -> n # extension # to_html store ch)
197 (self # node # sub_nodes);
198 (* now process footnotes *)
199 store # print_footnotes ch;
201 output_string ch html_trailer;
202 output_string ch "</html>\n";
209 (*$ readme.code.section *)
210 class section the_tag =
216 method to_html store ch =
217 let sub_nodes = self # node # sub_nodes in
219 title_node :: rest ->
220 output_string ch ("<" ^ tag ^ ">\n");
221 title_node # extension # to_html store ch;
222 output_string ch ("\n</" ^ tag ^ ">");
224 (fun n -> n # extension # to_html store ch)
231 class sect1 = section "h1";;
232 class sect2 = section "h3";;
233 class sect3 = section "h4";;
237 (*$ readme.code.map-tag *)
238 class map_tag the_target_tag =
242 val target_tag = the_target_tag
244 method to_html store ch =
245 output_string ch ("<" ^ target_tag ^ ">\n");
247 (fun n -> n # extension # to_html store ch)
248 (self # node # sub_nodes);
249 output_string ch ("\n</" ^ target_tag ^ ">");
253 class p = map_tag "p";;
254 class em = map_tag "b";;
255 class ul = map_tag "ul";;
256 class li = map_tag "li";;
260 (*$ readme.code.br *)
265 method to_html store ch =
266 output_string ch "<br>\n";
268 (fun n -> n # extension # to_html store ch)
269 (self # node # sub_nodes);
275 (*$ readme.code.code *)
280 method to_html store ch =
281 let data = self # node # data in
283 let l = String.length data in
284 let rec preprocess i column =
285 (* this is very ineffective but comprehensive: *)
289 let n = 8 - (column mod 8) in
290 String.make n ' ' ^ preprocess (i+1) (column + n)
292 "\n" ^ preprocess (i+1) 0
294 String.make 1 c ^ preprocess (i+1) (column + 1)
298 output_string ch "<p><pre>";
299 output_string ch (escape_html (preprocess 0 0));
300 output_string ch "</pre></p>";
312 method to_html store ch =
313 output_string ch "<a ";
315 match self # node # attribute "href" with
316 Value v -> escape_html v
317 | Valuelist _ -> assert false
319 begin match self # node # attribute "readmeref" with
320 Value v -> escape_html v ^ ".html"
321 | Valuelist _ -> assert false
327 output_string ch ("href=\"" ^ href ^ "\"");
328 output_string ch ">";
329 output_string ch (escape_html (self # node # data));
330 output_string ch "</a>";
337 (*$ readme.code.footnote *)
342 val mutable footnote_number = 0
344 method to_html store ch =
346 store # alloc_footnote (self : #shared :> footnote_printer) in
348 "footnote" ^ string_of_int number in
350 "textnote" ^ string_of_int number in
351 footnote_number <- number;
352 output_string ch ( "<a name=\"" ^ text_anchor ^ "\" href=\"#" ^
353 foot_anchor ^ "\">[" ^ string_of_int number ^
356 method footnote_to_html store ch =
357 (* prerequisite: we are in a definition list <dl>...</dl> *)
359 "footnote" ^ string_of_int footnote_number in
361 "textnote" ^ string_of_int footnote_number in
362 output_string ch ("<dt><a name=\"" ^ foot_anchor ^ "\" href=\"#" ^
363 text_anchor ^ "\">[" ^ string_of_int footnote_number ^
366 (fun n -> n # extension # to_html store ch)
367 (self # node # sub_nodes);
368 output_string ch ("\n</dd>")
375 (**********************************************************************)
377 (*$ readme.code.tag-map *)
382 ~data_exemplar:(new data_impl (new only_data))
383 ~default_element_exemplar:(new element_impl (new no_markup))
385 [ "readme", (new element_impl (new readme));
386 "sect1", (new element_impl (new sect1));
387 "sect2", (new element_impl (new sect2));
388 "sect3", (new element_impl (new sect3));
389 "title", (new element_impl (new no_markup));
390 "p", (new element_impl (new p));
391 "br", (new element_impl (new br));
392 "code", (new element_impl (new code));
393 "em", (new element_impl (new em));
394 "ul", (new element_impl (new ul));
395 "li", (new element_impl (new li));
396 "footnote", (new element_impl (new footnote : #shared :> shared));
397 "a", (new element_impl (new a));
404 (* ======================================================================
408 * Revision 1.1 2000/11/17 09:57:31 lpadovan
411 * Revision 1.6 2000/08/22 14:34:25 gerd
412 * Using make_spec_from_alist instead of make_spec_from_mapping.
414 * Revision 1.5 2000/08/18 21:15:14 gerd
415 * Update because of PXP API change: par_entity raises WF_error
416 * instead of Validation error if the entity is not defined.
417 * Further minor updates.
419 * Revision 1.4 2000/07/08 17:58:17 gerd
420 * Updated because of PXP API changes.
422 * Revision 1.3 2000/06/04 20:25:38 gerd
423 * Updates because of renamed PXP modules.
425 * Revision 1.2 1999/09/12 20:09:32 gerd
426 * Added section marks.
428 * Revision 1.1 1999/08/22 22:29:32 gerd