The converter from readme documents to HTML +documents follows strictly the approach to define one class per element +type. The HTML code is similar to the readme source, +because of this most elements can be converted in the following way: Given the +input element + +
<e>content</e>+ +the conversion text is the concatenation of a computed prefix, the recursively +converted content, and a computed suffix.
Only one element type cannot be handled by this scheme: +footnote. Footnotes are collected while they are found in +the input text, and they are printed after the main text has been converted and +printed.
open Pxp_types +open Pxp_document
class type footnote_printer = + object + method footnote_to_html : store_type -> out_channel -> unit + end + +and store_type = + object + method alloc_footnote : footnote_printer -> int + method print_footnotes : out_channel -> unit + end +;;
The store is a container for footnotes. You can add a +footnote by invoking alloc_footnote; the argument is an +object of the class footnote_printer, the method returns the +number of the footnote. The interesting property of a footnote is that it can +be converted to HTML, so a footnote_printer is an object +with a method footnote_to_html. The class +footnote which is defined below has a compatible method +footnote_to_html such that objects created from it can be +used as footnote_printers.
The other method, print_footnotes prints the footnotes as +definition list, and is typically invoked after the main material of the page +has already been printed. Every item of the list is printed by +footnote_to_html.
class store = + object (self) + + val mutable footnotes = ( [] : (int * footnote_printer) list ) + val mutable next_footnote_number = 1 + + method alloc_footnote n = + let number = next_footnote_number in + next_footnote_number <- number+1; + footnotes <- footnotes @ [ number, n ]; + number + + method print_footnotes ch = + if footnotes <> [] then begin + output_string ch "<hr align=left noshade=noshade width=\"30%\">\n"; + output_string ch "<dl>\n"; + List.iter + (fun (_,n) -> + n # footnote_to_html (self : #store_type :> store_type) ch) + footnotes; + output_string ch "</dl>\n"; + end + + end +;;
This function converts the characters <, >, &, and " to their HTML +representation. For example, +escape_html "<>" = "<>". Other +characters are left unchanged. + +
let escape_html s = + Str.global_substitute + (Str.regexp "<\\|>\\|&\\|\"") + (fun s -> + match Str.matched_string s with + "<" -> "<" + | ">" -> ">" + | "&" -> "&" + | "\"" -> """ + | _ -> assert false) + s +;;
This virtual class is the abstract superclass of the extension classes shown +below. It defines the standard methods clone, +node, and set_node, and declares the type +of the virtual method to_html. This method recursively +traverses the whole element tree, and prints the converted HTML code to the +output channel passed as second argument. The first argument is the reference +to the global store object which collects the footnotes. + +
class virtual shared =
+ object (self)
+
+ (* --- default_ext --- *)
+
+ val mutable node = (None : shared node option)
+
+ method clone = {< >}
+ method node =
+ match node with
+ None ->
+ assert false
+ | Some n -> n
+ method set_node n =
+ node <- Some n
+
+ (* --- virtual --- *)
+
+ method virtual to_html : store -> out_channel -> unit
+
+ end
+;;This class defines to_html such that the character data of +the current node is converted to HTML. Note that self is an +extension object, self # node is the node object, and +self # node # data returns the character data of the node. + +
class only_data = + object (self) + inherit shared + + method to_html store ch = + output_string ch (escape_html (self # node # data)) + end +;;
This class converts elements of type readme to HTML. Such an +element is (by definition) always the root element of the document. First, the +HTML header is printed; the title attribute of the element +determines the title of the HTML page. Some aspects of the HTML page can be +configured by setting certain parameter entities, for example the background +color, the text color, and link colors. After the header, the +body tag, and the headline have been printed, the contents +of the page are converted by invoking to_html on all +children of the current node (which is the root node). Then, the footnotes are +appended to this by telling the global store object to print +the footnotes. Finally, the end tags of the HTML pages are printed.
This class is an example how to access the value of an attribute: The value is +determined by invoking self # node # attribute "title". As +this attribute has been declared as CDATA and as being required, the value has +always the form Value s where s is the +string value of the attribute.
You can also see how entity contents can be accessed. A parameter entity object +can be looked up by self # node # dtd # par_entity "name", +and by invoking replacement_text the value of the entity +is returned after inner parameter and character entities have been +processed. Note that you must use gen_entity instead of +par_entity to access general entities.
class readme = + object (self) + inherit shared + + method to_html store ch = + (* output header *) + output_string + ch "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">"; + output_string + ch "<!-- WARNING! This is a generated file, do not edit! -->\n"; + let title = + match self # node # attribute "title" with + Value s -> s + | _ -> assert false + in + let html_header, _ = + try (self # node # dtd # par_entity "readme:html:header") + # replacement_text + with WF_error _ -> "", false in + let html_trailer, _ = + try (self # node # dtd # par_entity "readme:html:trailer") + # replacement_text + with WF_error _ -> "", false in + let html_bgcolor, _ = + try (self # node # dtd # par_entity "readme:html:bgcolor") + # replacement_text + with WF_error _ -> "white", false in + let html_textcolor, _ = + try (self # node # dtd # par_entity "readme:html:textcolor") + # replacement_text + with WF_error _ -> "", false in + let html_alinkcolor, _ = + try (self # node # dtd # par_entity "readme:html:alinkcolor") + # replacement_text + with WF_error _ -> "", false in + let html_vlinkcolor, _ = + try (self # node # dtd # par_entity "readme:html:vlinkcolor") + # replacement_text + with WF_error _ -> "", false in + let html_linkcolor, _ = + try (self # node # dtd # par_entity "readme:html:linkcolor") + # replacement_text + with WF_error _ -> "", false in + let html_background, _ = + try (self # node # dtd # par_entity "readme:html:background") + # replacement_text + with WF_error _ -> "", false in + + output_string ch "<html><header><title>\n"; + output_string ch (escape_html title); + output_string ch "</title></header>\n"; + output_string ch "<body "; + List.iter + (fun (name,value) -> + if value <> "" then + output_string ch (name ^ "=\"" ^ escape_html value ^ "\" ")) + [ "bgcolor", html_bgcolor; + "text", html_textcolor; + "link", html_linkcolor; + "alink", html_alinkcolor; + "vlink", html_vlinkcolor; + ]; + output_string ch ">\n"; + output_string ch html_header; + output_string ch "<h1>"; + output_string ch (escape_html title); + output_string ch "</h1>\n"; + (* process main content: *) + List.iter + (fun n -> n # extension # to_html store ch) + (self # node # sub_nodes); + (* now process footnotes *) + store # print_footnotes ch; + (* trailer *) + output_string ch html_trailer; + output_string ch "</html>\n"; + + end +;;
As the conversion process is very similar, the conversion classes of the three +section levels are derived from the more general section +class. The HTML code of the section levels only differs in the type of the +headline, and because of this the classes describing the section levels can be +computed by replacing the class argument the_tag of +section by the HTML name of the headline tag.
Section elements are converted to HTML by printing a headline and then +converting the contents of the element recursively. More precisely, the first +sub-element is always a title element, and the other +elements are the contents of the section. This structure is declared in the +DTD, and it is guaranteed that the document matches the DTD. Because of this +the title node can be separated from the rest without any checks.
Both the title node, and the body nodes are then converted to HTML by calling +to_html on them.
class section the_tag =
+ object (self)
+ inherit shared
+
+ val tag = the_tag
+
+ method to_html store ch =
+ let sub_nodes = self # node # sub_nodes in
+ match sub_nodes with
+ title_node :: rest ->
+ output_string ch ("<" ^ tag ^ ">\n");
+ title_node # extension # to_html store ch;
+ output_string ch ("\n</" ^ tag ^ ">");
+ List.iter
+ (fun n -> n # extension # to_html store ch)
+ rest
+ | _ ->
+ assert false
+ end
+;;
+
+class sect1 = section "h1";;
+class sect2 = section "h3";;
+class sect3 = section "h4";;Several element types are converted to HTML by simply mapping them to +corresponding HTML element types. The class map_tag +implements this, and the class argument the_target_tag +determines the tag name to map to. The output consists of the start tag, the +recursively converted inner elements, and the end tag. + +
class map_tag the_target_tag =
+ object (self)
+ inherit shared
+
+ val target_tag = the_target_tag
+
+ method to_html store ch =
+ output_string ch ("<" ^ target_tag ^ ">\n");
+ List.iter
+ (fun n -> n # extension # to_html store ch)
+ (self # node # sub_nodes);
+ output_string ch ("\n</" ^ target_tag ^ ">");
+ end
+;;
+
+class p = map_tag "p";;
+class em = map_tag "b";;
+class ul = map_tag "ul";;
+class li = map_tag "li";;Element of type br are mapped to the same HTML type. Note +that HTML forbids the end tag of br. + +
class br = + object (self) + inherit shared + + method to_html store ch = + output_string ch "<br>\n"; + List.iter + (fun n -> n # extension # to_html store ch) + (self # node # sub_nodes); + end +;;
The code type is converted to a pre +section (preformatted text). As the meaning of tabs is unspecified in HTML, +tabs are expanded to spaces. + +
class code = + object (self) + inherit shared + + method to_html store ch = + let data = self # node # data in + (* convert tabs *) + let l = String.length data in + let rec preprocess i column = + (* this is very ineffective but comprehensive: *) + if i < l then + match data.[i] with + '\t' -> + let n = 8 - (column mod 8) in + String.make n ' ' ^ preprocess (i+1) (column + n) + | '\n' -> + "\n" ^ preprocess (i+1) 0 + | c -> + String.make 1 c ^ preprocess (i+1) (column + 1) + else + "" + in + output_string ch "<p><pre>"; + output_string ch (escape_html (preprocess 0 0)); + output_string ch "</pre></p>"; + + end +;;
Hyperlinks, expressed by the a element type, are converted +to the HTML a type. If the target of the hyperlink is given +by href, the URL of this attribute can be used +directly. Alternatively, the target can be given by +readmeref in which case the ".html" suffix must be added to +the file name.
Note that within a only #PCDATA is allowed, so the contents +can be converted directly by applying escape_html to the +character data contents. + +
class a =
+ object (self)
+ inherit shared
+
+ method to_html store ch =
+ output_string ch "<a ";
+ let href =
+ match self # node # attribute "href" with
+ Value v -> escape_html v
+ | Valuelist _ -> assert false
+ | Implied_value ->
+ begin match self # node # attribute "readmeref" with
+ Value v -> escape_html v ^ ".html"
+ | Valuelist _ -> assert false
+ | Implied_value ->
+ ""
+ end
+ in
+ if href <> "" then
+ output_string ch ("href=\"" ^ href ^ "\"");
+ output_string ch ">";
+ output_string ch (escape_html (self # node # data));
+ output_string ch "</a>";
+
+ end
+;;The footnote class has two methods: +to_html to convert the footnote reference to HTML, and +footnote_to_html to convert the footnote text itself.
The footnote reference is converted to a local hyperlink; more precisely, to +two anchor tags which are connected with each other. The text anchor points to +the footnote anchor, and the footnote anchor points to the text anchor.
The footnote must be allocated in the store object. By +allocating the footnote, you get the number of the footnote, and the text of +the footnote is stored until the end of the HTML page is reached when the +footnotes can be printed. The to_html method stores simply +the object itself, such that the footnote_to_html method is +invoked on the same object that encountered the footnote.
The to_html only allocates the footnote, and prints the +reference anchor, but it does not print nor convert the contents of the +note. This is deferred until the footnotes actually get printed, i.e. the +recursive call of to_html on the sub nodes is done by +footnote_to_html.
Note that this technique does not work if you make another footnote within a +footnote; the second footnote gets allocated but not printed.
class footnote =
+ object (self)
+ inherit shared
+
+ val mutable footnote_number = 0
+
+ method to_html store ch =
+ let number =
+ store # alloc_footnote (self : #shared :> footnote_printer) in
+ let foot_anchor =
+ "footnote" ^ string_of_int number in
+ let text_anchor =
+ "textnote" ^ string_of_int number in
+ footnote_number <- number;
+ output_string ch ( "<a name=\"" ^ text_anchor ^ "\" href=\"#" ^
+ foot_anchor ^ "\">[" ^ string_of_int number ^
+ "]</a>" )
+
+ method footnote_to_html store ch =
+ (* prerequisite: we are in a definition list <dl>...</dl> *)
+ let foot_anchor =
+ "footnote" ^ string_of_int footnote_number in
+ let text_anchor =
+ "textnote" ^ string_of_int footnote_number in
+ output_string ch ("<dt><a name=\"" ^ foot_anchor ^ "\" href=\"#" ^
+ text_anchor ^ "\">[" ^ string_of_int footnote_number ^
+ "]</a></dt>\n<dd>");
+ List.iter
+ (fun n -> n # extension # to_html store ch)
+ (self # node # sub_nodes);
+ output_string ch ("\n</dd>")
+
+ end
+;;This code sets up the hash table that connects element types with the exemplars +of the extension classes that convert the elements to HTML. + +
open Pxp_yacc + +let tag_map = + make_spec_from_alist + ~data_exemplar:(new data_impl (new only_data)) + ~default_element_exemplar:(new element_impl (new no_markup)) + ~element_alist: + [ "readme", (new element_impl (new readme)); + "sect1", (new element_impl (new sect1)); + "sect2", (new element_impl (new sect2)); + "sect3", (new element_impl (new sect3)); + "title", (new element_impl (new no_markup)); + "p", (new element_impl (new p)); + "br", (new element_impl (new br)); + "code", (new element_impl (new code)); + "em", (new element_impl (new em)); + "ul", (new element_impl (new ul)); + "li", (new element_impl (new li)); + "footnote", (new element_impl (new footnote : #shared :> shared)); + "a", (new element_impl (new a)); + ] + () +;;