diff options
Diffstat (limited to 'ocamldoc/odoc_html.ml')
| -rw-r--r-- | ocamldoc/odoc_html.ml | 641 |
1 files changed, 439 insertions, 202 deletions
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index ffaf4cf2de..cbba5228f6 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -169,6 +169,8 @@ module Naming = f end +module StringSet = Set.Make (struct type t = string let compare = compare end) + (** A class with a method to colorize a string which represents OCaml code. *) class ocaml_code = object(self) @@ -182,7 +184,7 @@ let bs = Buffer.add_string (** Generation of html code from text structures. *) -class text = +class virtual text = object (self) (** We want to display colorized code. *) inherit ocaml_code @@ -244,6 +246,8 @@ class text = | Odoc_info.Ref (name, ref_opt) -> self#html_of_Ref b name ref_opt | Odoc_info.Superscript t -> self#html_of_Superscript b t | Odoc_info.Subscript t -> self#html_of_Subscript b t + | Odoc_info.Module_list l -> self#html_of_Module_list b l + | Odoc_info.Index_list -> self#html_of_Index_list b method html_of_Raw b s = bs b (self#escape s) @@ -356,7 +360,7 @@ class text = method html_of_Link b s t = bs b "<a href=\""; bs b s ; - bs b ">"; + bs b "\">"; self#html_of_text b t; bs b "</a>" @@ -396,6 +400,65 @@ class text = self#html_of_text b t; bs b "</sub>" + method html_of_Module_list b l = + bs b "<br>\n<table class=\"indextable\">\n"; + List.iter + (fun name -> + bs b "<tr><td>"; + ( + try + let m = + List.find (fun m -> m.m_name = name) self#list_modules + in + let (html, _) = Naming.html_files m.m_name in + bp b "<a href=\"%s\">%s</a></td>" html m.m_name; + bs b "<td>"; + self#html_of_info_first_sentence b m.m_info; + with + Not_found -> + Odoc_messages.pwarning (Odoc_messages.cross_module_not_found name); + bp b "%s</td><td>" name + ); + bs b "</td></tr>\n" + ) + l; + bs b "</table>\n</body>\n</html>"; + + method html_of_Index_list b = + let index_if_not_empty l url m = + match l with + [] -> () + | _ -> bp b "<a href=\"%s\">%s</a><br>\n" url m + in + index_if_not_empty self#list_types self#index_types Odoc_messages.index_of_types; + index_if_not_empty self#list_exceptions self#index_exceptions Odoc_messages.index_of_exceptions; + index_if_not_empty self#list_values self#index_values Odoc_messages.index_of_values; + index_if_not_empty self#list_attributes self#index_attributes Odoc_messages.index_of_attributes; + index_if_not_empty self#list_methods self#index_methods Odoc_messages.index_of_methods; + index_if_not_empty self#list_classes self#index_classes Odoc_messages.index_of_classes; + index_if_not_empty self#list_class_types self#index_class_types Odoc_messages.index_of_class_types; + index_if_not_empty self#list_modules self#index_modules Odoc_messages.index_of_modules; + index_if_not_empty self#list_module_types self#index_module_types Odoc_messages.index_of_module_types + + method virtual list_types : Odoc_info.Type.t_type list + method virtual index_types : string + method virtual list_exceptions : Odoc_info.Exception.t_exception list + method virtual index_exceptions : string + method virtual list_values : Odoc_info.Value.t_value list + method virtual index_values : string + method virtual list_attributes : Odoc_info.Value.t_attribute list + method virtual index_attributes : string + method virtual list_methods : Odoc_info.Value.t_method list + method virtual index_methods : string + method virtual list_classes : Odoc_info.Class.t_class list + method virtual index_classes : string + method virtual list_class_types : Odoc_info.Class.t_class_type list + method virtual index_class_types : string + method virtual list_modules : Odoc_info.Module.t_module list + method virtual index_modules : string + method virtual list_module_types : Odoc_info.Module.t_module_type list + method virtual index_module_types : string + end (** A class used to generate html code for info structures. *) @@ -504,14 +567,17 @@ class virtual info = ) l - (** Print html code for a description, except for the [i_params] field. *) - method html_of_info b info_opt = + (** Print html code for a description, except for the [i_params] field. + @param indent can be specified not to use the style of info comments; + default is [true]. + *) + method html_of_info ?(indent=true) b info_opt = match info_opt with None -> () | Some info -> let module M = Odoc_info in - bs b "<div class=\"info\">\n"; + if indent then bs b "<div class=\"info\">\n"; ( match info.M.i_deprecated with None -> () @@ -535,7 +601,7 @@ class virtual info = self#html_of_return_opt b info.M.i_return_value; self#html_of_sees b info.M.i_sees; self#html_of_custom b info.M.i_custom; - bs b "</div>\n" + if indent then bs b "</div>\n" (** Print html code for the first sentence of a description. The titles and lists in this first sentence has been removed.*) @@ -577,6 +643,25 @@ let print_concat b sep f = in iter +let newline_to_indented_br s = + let len = String.length s in + let b = Buffer.create len in + for i = 0 to len - 1 do + match s.[i] with + '\n' -> Buffer.add_string b "<br> " + | c -> Buffer.add_char b c + done; + Buffer.contents b + +let remove_last_newline s = + let len = String.length s in + if len <= 0 then + s + else + match s.[len-1] with + '\n' -> String.sub s 0 (len-1) + | _ -> s + (** This class is used to create objects which can generate a simple html documentation. *) class html = object (self) @@ -649,6 +734,8 @@ class html = "tr { background-color : White }" ; "td.typefieldcomment { background-color : #FFFFFF }" ; "pre { margin-bottom: 4px }" ; + + "div.sig_block {margin-left: 2em}" ; ] (** The style file for all pages. *) @@ -660,58 +747,67 @@ class html = (** The known types names. Used to know if we must create a link to a type when printing a type. *) - val mutable known_types_names = [] + val mutable known_types_names = StringSet.empty (** The known class and class type names. Used to know if we must create a link to a class or class type or not when printing a type. *) - val mutable known_classes_names = [] + val mutable known_classes_names = StringSet.empty (** The known modules and module types names. Used to know if we must create a link to a type or not when printing a module type. *) - val mutable known_modules_names = [] + val mutable known_modules_names = StringSet.empty (** The main file. *) - val mutable index = "index.html" + method index = "index.html" (** The file for the index of values. *) - val mutable index_values = "index_values.html" + method index_values = "index_values.html" (** The file for the index of types. *) - val mutable index_types = "index_types.html" + method index_types = "index_types.html" (** The file for the index of exceptions. *) - val mutable index_exceptions = "index_exceptions.html" + method index_exceptions = "index_exceptions.html" (** The file for the index of attributes. *) - val mutable index_attributes = "index_attributes.html" + method index_attributes = "index_attributes.html" (** The file for the index of methods. *) - val mutable index_methods = "index_methods.html" + method index_methods = "index_methods.html" (** The file for the index of classes. *) - val mutable index_classes = "index_classes.html" + method index_classes = "index_classes.html" (** The file for the index of class types. *) - val mutable index_class_types = "index_class_types.html" + method index_class_types = "index_class_types.html" (** The file for the index of modules. *) - val mutable index_modules = "index_modules.html" + method index_modules = "index_modules.html" (** The file for the index of module types. *) - val mutable index_module_types = "index_module_types.html" + method index_module_types = "index_module_types.html" (** The list of attributes. Filled in the [generate] method. *) val mutable list_attributes = [] + method list_attributes = list_attributes (** The list of methods. Filled in the [generate] method. *) val mutable list_methods = [] + method list_methods = list_methods (** The list of values. Filled in the [generate] method. *) val mutable list_values = [] + method list_values = list_values (** The list of exceptions. Filled in the [generate] method. *) val mutable list_exceptions = [] + method list_exceptions = list_exceptions (** The list of types. Filled in the [generate] method. *) val mutable list_types = [] + method list_types = list_types (** The list of modules. Filled in the [generate] method. *) val mutable list_modules = [] + method list_modules = list_modules (** The list of module types. Filled in the [generate] method. *) val mutable list_module_types = [] + method list_module_types = list_module_types (** The list of classes. Filled in the [generate] method. *) val mutable list_classes = [] + method list_classes = list_classes (** The list of class types. Filled in the [generate] method. *) val mutable list_class_types = [] + method list_class_types = list_class_types (** The header of pages. Must be prepared by the [prepare_header] method.*) val mutable header = fun b -> fun ?(nav=None) -> fun ?(comments=[]) -> fun _ -> () @@ -767,7 +863,7 @@ class html = bs b "<head>\n"; bs b style; bs b "<link rel=\"Start\" href=\""; - bs b index; + bs b self#index; bs b "\">\n" ; ( match nav with @@ -787,19 +883,19 @@ class html = ); ( let father = Name.father name in - let href = if father = "" then index else fst (Naming.html_files father) in + let href = if father = "" then self#index else fst (Naming.html_files father) in bp b "<link rel=\"Up\" href=\"%s\">\n" href ) ); - link_if_not_empty list_types Odoc_messages.index_of_types index_types; - link_if_not_empty list_exceptions Odoc_messages.index_of_exceptions index_exceptions; - link_if_not_empty list_values Odoc_messages.index_of_values index_values; - link_if_not_empty list_attributes Odoc_messages.index_of_attributes index_attributes; - link_if_not_empty list_methods Odoc_messages.index_of_methods index_methods; - link_if_not_empty list_classes Odoc_messages.index_of_classes index_classes; - link_if_not_empty list_class_types Odoc_messages.index_of_class_types index_class_types; - link_if_not_empty list_modules Odoc_messages.index_of_modules index_modules; - link_if_not_empty list_module_types Odoc_messages.index_of_module_types index_module_types; + link_if_not_empty self#list_types Odoc_messages.index_of_types self#index_types; + link_if_not_empty self#list_exceptions Odoc_messages.index_of_exceptions self#index_exceptions; + link_if_not_empty self#list_values Odoc_messages.index_of_values self#index_values; + link_if_not_empty self#list_attributes Odoc_messages.index_of_attributes self#index_attributes; + link_if_not_empty self#list_methods Odoc_messages.index_of_methods self#index_methods; + link_if_not_empty self#list_classes Odoc_messages.index_of_classes self#index_classes; + link_if_not_empty self#list_class_types Odoc_messages.index_of_class_types self#index_class_types; + link_if_not_empty self#list_modules Odoc_messages.index_of_modules self#index_modules; + link_if_not_empty self#list_module_types Odoc_messages.index_of_module_types self#index_module_types; let print_one m = let html_file = fst (Naming.html_files m.m_name) in bp b "<link title=\"%s\" rel=\"Chapter\" href=\"%s\">" @@ -854,6 +950,7 @@ class html = print_lines "Section" section_titles ; print_lines "Subsection" subsection_titles + (** Html code for navigation bar. @param pre optional name for optional previous module/class @param post optional name for optional next module/class @@ -870,7 +967,7 @@ class html = ); bs b " "; let father = Name.father name in - let href = if father = "" then index else fst (Naming.html_files father) in + let href = if father = "" then self#index else fst (Naming.html_files father) in bp b "<a href=\"%s\">%s</a>\n" href Odoc_messages.up; bs b " "; ( @@ -919,12 +1016,12 @@ class html = match_s rel in - if List.mem match_s known_types_names then + if StringSet.mem match_s known_types_names then "<a href=\""^(Naming.complete_target Naming.mark_type match_s)^"\">"^ s_final^ "</a>" else - if List.mem match_s known_classes_names then + if StringSet.mem match_s known_classes_names then let (html_file, _) = Naming.html_files match_s in "<a href=\""^html_file^"\">"^s_final^"</a>" else @@ -942,11 +1039,17 @@ class html = method create_fully_qualified_module_idents_links m_name s = let f str_t = let match_s = Str.matched_string str_t in - if List.mem match_s known_modules_names then + let rel = Name.get_relative m_name match_s in + let s_final = Odoc_info.apply_if_equal + Odoc_info.use_hidden_modules + match_s + rel + in + if StringSet.mem match_s known_modules_names then let (html_file, _) = Naming.html_files match_s in - "<a href=\""^html_file^"\">"^(Name.get_relative m_name match_s)^"</a>" + "<a href=\""^html_file^"\">"^s_final^"</a>" else - match_s + s_final in let s2 = Str.global_substitute (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)") @@ -957,30 +1060,18 @@ class html = (** Print html code to display a [Types.type_expr]. *) method html_of_type_expr b m_name t = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_type_expr t)) - in - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in - bs b "<code class=\"type\">"; - bs b (self#create_fully_qualified_idents_links m_name s2); - bs b "</code>" - - (** Print html code to display a [Types.class_type].*) - method html_of_class_type_expr b m_name t = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type t)) - in - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in + let s = remove_last_newline (Odoc_info.string_of_type_expr t) in + let s2 = newline_to_indented_br s in bs b "<code class=\"type\">"; bs b (self#create_fully_qualified_idents_links m_name s2); bs b "</code>" (** Print html code to display a [Types.type_expr list]. *) - method html_of_type_expr_list b m_name sep l = + method html_of_type_expr_list ?par b m_name sep l = print_DEBUG "html#html_of_type_expr_list"; - let s = Odoc_info.string_of_type_list sep l in + let s = Odoc_info.string_of_type_list ?par sep l in print_DEBUG "html#html_of_type_expr_list: 1"; - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in + let s2 = newline_to_indented_br s in print_DEBUG "html#html_of_type_expr_list: 2"; bs b "<code class=\"type\">"; bs b (self#create_fully_qualified_idents_links m_name s2); @@ -990,43 +1081,149 @@ class html = of a class of class type. *) method html_of_class_type_param_expr_list b m_name l = let s = Odoc_info.string_of_class_type_param_list l in - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in - bs b "<code class=\"type\">"; + let s2 = newline_to_indented_br s in + bs b "<code class=\"type\">["; bs b (self#create_fully_qualified_idents_links m_name s2); - bs b "</code>" + bs b "]</code>" (** Print html code to display a list of type parameters for the given type.*) method html_of_type_expr_param_list b m_name t = let s = Odoc_info.string_of_type_param_list t in - let s2 = Str.global_replace (Str.regexp "\n") "<br> " s in + let s2 = newline_to_indented_br s in bs b "<code class=\"type\">"; bs b (self#create_fully_qualified_idents_links m_name s2); bs b "</code>" (** Print html code to display a [Types.module_type]. *) - method html_of_module_type b m_name t = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type t)) - in + method html_of_module_type b ?code m_name t = + let s = remove_last_newline (Odoc_info.string_of_module_type ?code t) in bs b "<code class=\"type\">"; bs b (self#create_fully_qualified_module_idents_links m_name s); bs b "</code>" - + + (** Print html code to display the given module kind. *) + method html_of_module_kind b father ?modu kind = + match kind with + Module_struct eles -> + self#html_of_text b [Code "sig"]; + ( + match modu with + None -> + bs b "<div class=\"sig_block\">"; + List.iter (self#html_of_module_element b father) eles; + bs b "</div>" + | Some m -> + let (html_file, _) = Naming.html_files m.m_name in + bp b " <a href=\"%s\">..</a> " html_file + ); + self#html_of_text b [Code "end"] + | Module_alias a -> + bs b "<code class=\"type\">"; + bs b (self#create_fully_qualified_module_idents_links father a.ma_name); + bs b "</code>" + | Module_functor (p, k) -> + bs b "<div class=\"sig_block\">"; + self#html_of_module_parameter b father p; + self#html_of_module_kind b father ?modu k; + bs b "</div>" + | Module_apply (k1, k2) -> + (* TODO: l'application n'est pas correcte dans un .mli. + Que faire ? -> afficher le module_type du typedtree *) + self#html_of_module_kind b father k1; + self#html_of_text b [Code "("]; + self#html_of_module_kind b father k2; + self#html_of_text b [Code ")"] + | Module_with (k, s) -> + (* TODO: à modifier quand Module_with sera plus détaillé *) + self#html_of_module_type_kind b father ?modu k; + bs b "<code class=\"type\"> "; + bs b (self#create_fully_qualified_module_idents_links father s); + bs b "</code>" + | Module_constraint (k, tk) -> + (* TODO: on affiche quoi ? *) + self#html_of_module_kind b father ?modu k + + method html_of_module_parameter b father p = + self#html_of_text b + [ + Code "functor ("; + Code p.mp_name ; + Code " : "; + ] ; + self#html_of_module_type_kind b father p.mp_kind; + self#html_of_text b [ Code ") -> "] + + method html_of_module_element b father ele = + match ele with + Element_module m -> + self#html_of_module b ~complete: false m + | Element_module_type mt -> + self#html_of_modtype b ~complete: false mt + | Element_included_module im -> + self#html_of_included_module b im + | Element_class c -> + self#html_of_class b ~complete: false c + | Element_class_type ct -> + self#html_of_class_type b ~complete: false ct + | Element_value v -> + self#html_of_value b v + | Element_exception e -> + self#html_of_exception b e + | Element_type t -> + self#html_of_type b t + | Element_module_comment text -> + self#html_of_module_comment b text + + (** Print html code to display the given module type kind. *) + method html_of_module_type_kind b father ?modu ?mt kind = + match kind with + Module_type_struct eles -> + self#html_of_text b [Code "sig"]; + ( + match mt with + None -> + ( + match modu with + None -> + bs b "<div class=\"sig_block\">"; + List.iter (self#html_of_module_element b father) eles; + bs b "</div>" + | Some m -> + let (html_file, _) = Naming.html_files m.m_name in + bp b " <a href=\"%s\">..</a> " html_file + ) + | Some mt -> + let (html_file, _) = Naming.html_files mt.mt_name in + bp b " <a href=\"%s\">..</a> " html_file + ); + self#html_of_text b [Code "end"] + | Module_type_functor (p, k) -> + self#html_of_module_parameter b father p; + self#html_of_module_type_kind b father ?modu ?mt k + | Module_type_alias a -> + bs b "<code class=\"type\">"; + bs b (self#create_fully_qualified_module_idents_links father a.mta_name); + bs b "</code>" + | Module_type_with (k, s) -> + self#html_of_module_type_kind b father ?modu ?mt k; + bs b "<code class=\"type\"> "; + bs b (self#create_fully_qualified_module_idents_links father s); + bs b "</code>" + + (** Print html code to display the type of a module parameter.. *) + method html_of_module_parameter_type b m_name p = + self#html_of_module_type b m_name ~code: p.mp_type_code p.mp_type + (** Generate a file containing the module type in the given file name. *) method output_module_type in_title file mtyp = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type ~complete: true mtyp)) - in + let s = remove_last_newline (Odoc_info.string_of_module_type ~complete: true mtyp) in self#output_code in_title file s (** Generate a file containing the class type in the given file name. *) method output_class_type in_title file ctyp = - let s = String.concat "\n" - (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type ~complete: true ctyp)) - in + let s = remove_last_newline(Odoc_info.string_of_class_type ~complete: true ctyp) in self#output_code in_title file s - (** Print html code for a value. *) method html_of_value b v = Odoc_info.reset_type_names (); @@ -1069,7 +1266,8 @@ class html = [] -> () | _ -> bs b (" "^(self#keyword "of")^" "); - self#html_of_type_expr_list b (Name.father e.ex_name) " * " e.ex_args + self#html_of_type_expr_list + ~par: false b (Name.father e.ex_name) " * " e.ex_args ); ( match e.ex_alias with @@ -1137,7 +1335,7 @@ class html = [] -> () | l -> bs b (" " ^ (self#keyword "of") ^ " "); - self#html_of_type_expr_list b father " * " l; + self#html_of_type_expr_list ~par: false b father " * " l; ); bs b "</code></td>\n"; ( @@ -1365,7 +1563,7 @@ class html = bs b "</code></td>\n" ; bs b "<td align=\"center\" valign=\"top\">:</td>\n"; bs b "<td>" ; - self#html_of_module_type b m_name p.mp_type; + self#html_of_module_parameter_type b m_name p; bs b "\n"; ( match desc_opt with @@ -1392,12 +1590,12 @@ class html = bs b (Name.simple m.m_name) ); bs b ": "; - self#html_of_module_type b father m.m_type; + self#html_of_module_kind b father ~modu: m m.m_kind; bs b "</pre>"; if info then ( if complete then - self#html_of_info + self#html_of_info ~indent: false else self#html_of_info_first_sentence ) b m.m_info @@ -1416,17 +1614,17 @@ class html = else bs b (Name.simple mt.mt_name) ); - (match mt.mt_type with + (match mt.mt_kind with None -> () - | Some mtyp -> + | Some k -> bs b " = "; - self#html_of_module_type b father mtyp + self#html_of_module_type_kind b father ~mt k ); bs b "</pre>"; if info then ( if complete then - self#html_of_info + self#html_of_info ~indent: false else self#html_of_info_first_sentence ) b mt.mt_info @@ -1456,6 +1654,99 @@ class html = bs b "</pre>\n"; self#html_of_info b im.im_info + method html_of_class_element b element = + match element with + Class_attribute a -> + self#html_of_attribute b a + | Class_method m -> + self#html_of_method b m + | Class_comment t -> + self#html_of_class_comment b t + + method html_of_class_kind b father ?cl kind = + match kind with + Class_structure (inh, eles) -> + self#html_of_text b [Code "object"]; + ( + match cl with + None -> + bs b "\n"; + ( + match inh with + [] -> () + | _ -> + self#generate_inheritance_info b inh + ); + List.iter (self#html_of_class_element b) eles; + | Some cl -> + let (html_file, _) = Naming.html_files cl.cl_name in + bp b " <a href=\"%s\">..</a> " html_file + ); + self#html_of_text b [Code "end"] + + | Class_apply capp -> + (* TODO: afficher le type final à partir du typedtree *) + self#html_of_text b [Raw "class application not handled yet"] + + | Class_constr cco -> + ( + match cco.cco_type_parameters with + [] -> () + | l -> + self#html_of_class_type_param_expr_list b father l; + bs b " " + ); + self#html_of_text b + [Code (self#create_fully_qualified_idents_links father cco.cco_name)] + + | Class_constraint (ck, ctk) -> + self#html_of_text b [Code "( "] ; + self#html_of_class_kind b father ck; + self#html_of_text b [Code " : "] ; + self#html_of_class_type_kind b father ctk; + self#html_of_text b [Code " )"] + + method html_of_class_type_kind b father ?ct kind = + match kind with + Class_type cta -> + ( + match cta.cta_type_parameters with + [] -> () + | l -> + self#html_of_class_type_param_expr_list b father l; + bs b " " + ); + self#html_of_text b + [Code (self#create_fully_qualified_idents_links father cta.cta_name)] + + | Class_signature (inh, eles) -> + self#html_of_text b [Code "object"]; + ( + match ct with + None -> + bs b "\n"; + ( + match inh with + [] -> () + | _ -> self#generate_inheritance_info b inh + ); + List.iter (self#html_of_class_element b) eles + | Some ct -> + let (html_file, _) = Naming.html_files ct.clt_name in + bp b " <a href=\"%s\">..</a> " html_file + ); + self#html_of_text b [Code "end"] + + method html_of_class_parameter b father p = + self#html_of_type_expr b father (Parameter.typ p) + + method html_of_class_parameter_list b father params = + List.iter + (fun p -> + self#html_of_class_parameter b father p; + bs b " -> ") + params + (** Print html code for a class. *) method html_of_class b ?(complete=true) ?(with_link=true) c = let father = Name.father c.cl_name in @@ -1492,12 +1783,13 @@ class html = ); bs b " : " ; - self#html_of_class_type_expr b father c.cl_type; + self#html_of_class_parameter_list b father c.cl_parameters ; + self#html_of_class_kind b father ~cl: c c.cl_kind; bs b "</pre>" ; print_DEBUG "html#html_of_class : info" ; ( if complete then - self#html_of_info + self#html_of_info ~indent: false else self#html_of_info_first_sentence ) b c.cl_info @@ -1535,11 +1827,11 @@ class html = bs b (Name.simple ct.clt_name); bs b " = "; - self#html_of_class_type_expr b father ct.clt_type; + self#html_of_class_type_kind b father ~ct ct.clt_kind; bs b "</pre>"; ( if complete then - self#html_of_info + self#html_of_info ~indent: false else self#html_of_info_first_sentence ) b ct.clt_info @@ -1738,16 +2030,7 @@ class html = (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* the various elements *) - List.iter - (fun element -> - match element with - Class_attribute a -> - self#html_of_attribute b a - | Class_method m -> - self#html_of_method b m - | Class_comment t -> - self#html_of_class_comment b t - ) + List.iter (self#html_of_class_element b) (Class.class_elements ~trans:false cl); bs b "</body></html>"; Buffer.output_buffer chanout b; @@ -1792,16 +2075,7 @@ class html = (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* the various elements *) - List.iter - (fun element -> - match element with - Class_attribute a -> - self#html_of_attribute b a - | Class_method m -> - self#html_of_method b m - | Class_comment t -> - self#html_of_class_comment b t - ) + List.iter (self#html_of_class_element b) (Class.class_type_elements ~trans: false clt); bs b "</body></html>"; Buffer.output_buffer chanout b; @@ -1844,32 +2118,14 @@ class html = self#html_of_modtype b ~with_link: false mt; (* parameters for functors *) - self#html_of_module_parameter_list b "" (Module.module_type_parameters mt); + self#html_of_module_parameter_list b + (Name.father mt.mt_name) + (Module.module_type_parameters mt); (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* module elements *) - List.iter - (fun ele -> - match ele with - Element_module m -> - self#html_of_module b ~complete: false m - | Element_module_type mt -> - self#html_of_modtype b ~complete: false mt - | Element_included_module im -> - self#html_of_included_module b im - | Element_class c -> - self#html_of_class b ~complete: false c - | Element_class_type ct -> - self#html_of_class_type b ~complete: false ct - | Element_value v -> - self#html_of_value b v - | Element_exception e -> - self#html_of_exception b e - | Element_type t -> - self#html_of_type b t - | Element_module_comment text -> - self#html_of_module_comment b text - ) + List.iter + (self#html_of_module_element b (Name.father mt.mt_name)) (Module.module_type_elements mt); bs b "</body></html>"; @@ -1937,35 +2193,16 @@ class html = self#html_of_module b ~with_link: false modu; (* parameters for functors *) - self#html_of_module_parameter_list b "" (Module.module_parameters modu); + self#html_of_module_parameter_list b + (Name.father modu.m_name) + (Module.module_parameters modu); (* a horizontal line *) bs b "<hr width=\"100%\">\n"; (* module elements *) List.iter - (fun ele -> - print_DEBUG "html#generate_for_module : ele ->"; - match ele with - Element_module m -> - self#html_of_module b ~complete: false m - | Element_module_type mt -> - self#html_of_modtype b ~complete: false mt - | Element_included_module im -> - self#html_of_included_module b im - | Element_class c -> - self#html_of_class b ~complete: false c - | Element_class_type ct -> - self#html_of_class_type b ~complete: false ct - | Element_value v -> - self#html_of_value b v - | Element_exception e -> - self#html_of_exception b e - | Element_type t -> - self#html_of_type b t - | Element_module_comment text -> - self#html_of_module_comment b text - ) + (self#html_of_module_element b (Name.father modu.m_name)) (Module.module_elements modu); bs b "</body></html>"; @@ -2002,14 +2239,9 @@ class html = @raise Failure if an error occurs.*) method generate_index module_list = try - let chanout = open_out (Filename.concat !Args.target_dir index) in + let chanout = open_out (Filename.concat !Args.target_dir self#index) in let b = new_buf () in let title = match !Args.title with None -> "" | Some t -> self#escape t in - let index_if_not_empty l url m = - match l with - [] -> () - | _ -> bp b "<a href=\"%s\">%s</a><br>\n" url m - in bs b "<html>\n"; self#print_header b self#title; bs b "<body>\n"; @@ -2019,28 +2251,15 @@ class html = let info = Odoc_info.apply_opt Odoc_info.info_of_comment_file !Odoc_info.Args.intro_file in - self#html_of_info b info; - (match info with None -> () | Some _ -> bs b "<br/>"); - index_if_not_empty list_types index_types Odoc_messages.index_of_types; - index_if_not_empty list_exceptions index_exceptions Odoc_messages.index_of_exceptions; - index_if_not_empty list_values index_values Odoc_messages.index_of_values; - index_if_not_empty list_attributes index_attributes Odoc_messages.index_of_attributes; - index_if_not_empty list_methods index_methods Odoc_messages.index_of_methods; - index_if_not_empty list_classes index_classes Odoc_messages.index_of_classes; - index_if_not_empty list_class_types index_class_types Odoc_messages.index_of_class_types; - index_if_not_empty list_modules index_modules Odoc_messages.index_of_modules; - index_if_not_empty list_module_types index_module_types Odoc_messages.index_of_module_types; - bs b "<br>\n<table class=\"indextable\">\n"; - List.iter - (fun m -> - let (html, _) = Naming.html_files m.m_name in - bp b "<tr><td><a href=\"%s\">%s</a></td>" html m.m_name; - bs b "<td>"; - self#html_of_info_first_sentence b m.m_info; - bs b "</td></tr>\n" - ) - module_list; - bs b "</table>\n</body>\n</html>"; + ( + match info with + None -> + self#html_of_Index_list b; + bs b "<br/>"; + self#html_of_Module_list b + (List.map (fun m -> m.m_name) module_list) + | Some i -> self#html_of_info ~indent: false b info + ); Buffer.output_buffer chanout b; close_out chanout with @@ -2050,93 +2269,93 @@ class html = (** Generate the values index in the file [index_values.html]. *) method generate_values_index module_list = self#generate_elements_index - list_values + self#list_values (fun v -> v.val_name) (fun v -> v.val_info) Naming.complete_value_target Odoc_messages.index_of_values - index_values + self#index_values (** Generate the exceptions index in the file [index_exceptions.html]. *) method generate_exceptions_index module_list = self#generate_elements_index - list_exceptions + self#list_exceptions (fun e -> e.ex_name) (fun e -> e.ex_info) Naming.complete_exception_target Odoc_messages.index_of_exceptions - index_exceptions + self#index_exceptions (** Generate the types index in the file [index_types.html]. *) method generate_types_index module_list = self#generate_elements_index - list_types + self#list_types (fun t -> t.ty_name) (fun t -> t.ty_info) Naming.complete_type_target Odoc_messages.index_of_types - index_types + self#index_types (** Generate the attributes index in the file [index_attributes.html]. *) method generate_attributes_index module_list = self#generate_elements_index - list_attributes + self#list_attributes (fun a -> a.att_value.val_name) (fun a -> a.att_value.val_info) Naming.complete_attribute_target Odoc_messages.index_of_attributes - index_attributes + self#index_attributes (** Generate the methods index in the file [index_methods.html]. *) method generate_methods_index module_list = self#generate_elements_index - list_methods + self#list_methods (fun m -> m.met_value.val_name) (fun m -> m.met_value.val_info) Naming.complete_method_target Odoc_messages.index_of_methods - index_methods + self#index_methods (** Generate the classes index in the file [index_classes.html]. *) method generate_classes_index module_list = self#generate_elements_index - list_classes + self#list_classes (fun c -> c.cl_name) (fun c -> c.cl_info) (fun c -> fst (Naming.html_files c.cl_name)) Odoc_messages.index_of_classes - index_classes + self#index_classes (** Generate the class types index in the file [index_class_types.html]. *) method generate_class_types_index module_list = self#generate_elements_index - list_class_types + self#list_class_types (fun ct -> ct.clt_name) (fun ct -> ct.clt_info) (fun ct -> fst (Naming.html_files ct.clt_name)) Odoc_messages.index_of_class_types - index_class_types + self#index_class_types (** Generate the modules index in the file [index_modules.html]. *) method generate_modules_index module_list = self#generate_elements_index - list_modules + self#list_modules (fun m -> m.m_name) (fun m -> m.m_info) (fun m -> fst (Naming.html_files m.m_name)) Odoc_messages.index_of_modules - index_modules + self#index_modules (** Generate the module types index in the file [index_module_types.html]. *) method generate_module_types_index module_list = let module_types = Odoc_info.Search.module_types module_list in self#generate_elements_index - list_module_types + self#list_module_types (fun mt -> mt.mt_name) (fun mt -> mt.mt_info) (fun mt -> fst (Naming.html_files mt.mt_name)) Odoc_messages.index_of_module_types - index_module_types + self#index_module_types (** Generate all the html files from a module list. The main file is [index.html]. *) @@ -2158,20 +2377,38 @@ class html = self#prepare_header module_list ; (* Get the names of all known types. *) let types = Odoc_info.Search.types module_list in - let type_names = List.map (fun t -> t.ty_name) types in - known_types_names <- type_names ; + known_types_names <- + List.fold_left + (fun acc t -> StringSet.add t.ty_name acc) + known_types_names + types ; (* Get the names of all class and class types. *) let classes = Odoc_info.Search.classes module_list in let class_types = Odoc_info.Search.class_types module_list in - let class_names = List.map (fun c -> c.cl_name) classes in - let class_type_names = List.map (fun ct -> ct.clt_name) class_types in - known_classes_names <- class_names @ class_type_names ; + known_classes_names <- + List.fold_left + (fun acc c -> StringSet.add c.cl_name acc) + known_classes_names + classes ; + known_classes_names <- + List.fold_left + (fun acc ct -> StringSet.add ct.clt_name acc) + known_classes_names + class_types ; (* Get the names of all known modules and module types. *) let module_types = Odoc_info.Search.module_types module_list in let modules = Odoc_info.Search.modules module_list in - let module_type_names = List.map (fun mt -> mt.mt_name) module_types in - let module_names = List.map (fun m -> m.m_name) modules in - known_modules_names <- module_type_names @ module_names ; + known_modules_names <- + List.fold_left + (fun acc m -> StringSet.add m.m_name acc) + known_modules_names + modules ; + known_modules_names <- + List.fold_left + (fun acc mt -> StringSet.add mt.mt_name acc) + known_modules_names + module_types ; + (* generate html for each module *) if not !Args.index_only then self#generate_elements self#generate_for_module module_list ; |