diff options
Diffstat (limited to 'ocamldoc/odoc_man.ml')
| -rw-r--r-- | ocamldoc/odoc_man.ml | 988 |
1 files changed, 988 insertions, 0 deletions
diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml new file mode 100644 index 000000000..d295559d3 --- /dev/null +++ b/ocamldoc/odoc_man.ml @@ -0,0 +1,988 @@ +(***********************************************************************) +(* OCamldoc *) +(* *) +(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2001 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + + +(** The man pages generator. *) +open Odoc_info +open Parameter +open Value +open Type +open Exception +open Class +open Module +open Search + + +(** A class used to get a [text] for info structures. *) +class virtual info = + object (self) + (** The list of pairs [(tag, f)] where [f] is a function taking + the [text] associated to [tag] and returning man code. + Add a pair here to handle a tag.*) + val mutable tag_functions = ([] : (string * (Odoc_info.text -> string)) list) + + (** Return man code for a [text]. *) + method virtual man_of_text : Odoc_info.text -> string + + (** Groff string for an author list. *) + method man_of_author_list l = + match l with + [] -> + "" + | _ -> + ".B \""^Odoc_messages.authors^"\"\n:\n"^ + (String.concat ", " l)^ + "\n.sp\n" + + (** Groff string for the given optional version information.*) + method man_of_version_opt v_opt = + match v_opt with + None -> "" + | Some v -> ".B \""^Odoc_messages.version^"\"\n:\n"^v^"\n.sp\n" + + (** Groff string for the given optional since information.*) + method man_of_since_opt s_opt = + match s_opt with + None -> "" + | Some s -> ".B \""^Odoc_messages.since^"\"\n"^s^"\n.sp\n" + + (** Groff string for the given list of raised exceptions.*) + method man_of_raised_exceptions l = + match l with + [] -> "" + | (s, t) :: [] -> ".B \""^Odoc_messages.raises^" "^s^"\"\n"^(self#man_of_text t)^"\n.sp\n" + | _ -> + ".B \""^Odoc_messages.raises^"\"\n"^ + (String.concat "" + (List.map + (fun (ex, desc) -> ".TP\n.B \""^ex^"\"\n"^(self#man_of_text desc)^"\n") + l + ) + )^"\n.sp\n" + + (** Groff string for the given "see also" reference. *) + method man_of_see (see_ref, t) = + let t_ref = + match see_ref with + Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ] + | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t + | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t + in + self#man_of_text t_ref + + (** Groff string for the given list of "see also" references.*) + method man_of_sees l = + match l with + [] -> "" + | see :: [] -> ".B \""^Odoc_messages.see_also^"\"\n"^(self#man_of_see see)^"\n.sp\n" + | _ -> + ".B \""^Odoc_messages.see_also^"\"\n"^ + (String.concat "" + (List.map + (fun see -> ".TP\n \"\"\n"^(self#man_of_see see)^"\n") + l + ) + )^"\n.sp\n" + + (** Groff string for the given optional return information.*) + method man_of_return_opt return_opt = + match return_opt with + None -> "" + | Some s -> ".B "^Odoc_messages.returns^"\n"^(self#man_of_text s)^"\n.sp\n" + + (** Return man code for the given list of custom tagged texts. *) + method man_of_custom l = + let buf = Buffer.create 50 in + List.iter + (fun (tag, text) -> + try + let f = List.assoc tag tag_functions in + Buffer.add_string buf (f text) + with + Not_found -> + Odoc_info.warning (Odoc_messages.tag_not_handled tag) + ) + l; + Buffer.contents buf + + (** Return the groff string to display an optional info structure. *) + method man_of_info info_opt = + match info_opt with + None -> + "" + | Some info -> + let module M = Odoc_info in + (match info.M.i_deprecated with + None -> "" + | Some d -> ".B \""^Odoc_messages.deprecated^"\"\n"^(self#man_of_text d)^"\n.sp\n")^ + (match info.M.i_desc with + None -> "" + | Some d when d = [Odoc_info.Raw ""] -> "" + | Some d -> (self#man_of_text d)^"\n.sp\n" + )^ + (self#man_of_author_list info.M.i_authors)^ + (self#man_of_version_opt info.M.i_version)^ + (self#man_of_since_opt info.M.i_since)^ + (self#man_of_raised_exceptions info.M.i_raised_exceptions)^ + (self#man_of_return_opt info.M.i_return_value)^ + (self#man_of_sees info.M.i_sees)^ + (self#man_of_custom info.M.i_custom) + end + +(** This class is used to create objects which can generate a simple html documentation. *) +class man = + object (self) + inherit info + + (** Get a file name from a module or class complete name. *) + method file_name name = name^".man" + + (** Escape special sequences of characters in a string. *) + method escape (s : string) = s + + (** Open a file for output. Add the target directory.*) + method open_out file = + let f = Filename.concat !Odoc_args.target_dir file in + open_out f + + (** Return the groff string for a text, without correction of blanks. *) + method private man_of_text2 t = String.concat "" (List.map self#man_of_text_element t) + + (** Return the groff string for a text, with blanks corrected. *) + method man_of_text t = + let s = self#man_of_text2 t in + let s2 = Str.global_replace (Str.regexp "\n[ ]*") "\n" s in + Str.global_replace (Str.regexp "\n\n") "\n" s2 + + (** Return the groff string for a text element. *) + method man_of_text_element te = + match te with + | Odoc_info.Raw s -> s + | Odoc_info.Code s -> + let s2 = "\n.B "^(Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n" in + s2 + | Odoc_info.CodePre s -> + let s2 = "\n.B "^(Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n" in + s2 + | Odoc_info.Verbatim s -> self#escape s + | Odoc_info.Bold t + | Odoc_info.Italic t + | Odoc_info.Emphasize t + | Odoc_info.Center t + | Odoc_info.Left t + | Odoc_info.Right t -> self#man_of_text2 t + | Odoc_info.List tl -> + (String.concat "" + (List.map + (fun t -> ".TP\n \"\"\n"^(self#man_of_text2 t)^"\n") + tl + ) + )^"\n" + | Odoc_info.Enum tl -> + (String.concat "" + (List.map + (fun t -> ".TP\n \"\"\n"^(self#man_of_text2 t)^"\n") + tl + ) + )^"\n" + | Odoc_info.Newline -> + "\n.sp\n" + | Odoc_info.Block t -> + "\n.sp\n"^(self#man_of_text2 t)^"\n.sp\n" + | Odoc_info.Title (n, l_opt, t) -> + self#man_of_text2 [Odoc_info.Code (Odoc_info.string_of_text t)] + | Odoc_info.Latex _ -> + (* don't care about LaTeX stuff in HTML. *) + "" + | Odoc_info.Link (s, t) -> + self#man_of_text2 t + | Odoc_info.Ref (name, _) -> + self#man_of_text_element + (Odoc_info.Code (Odoc_info.use_hidden_modules name)) + | Odoc_info.Superscript t -> + "^{"^(self#man_of_text2 t) + | Odoc_info.Subscript t -> + "_{"^(self#man_of_text2 t) + + (** Groff string to display code. *) + method man_of_code s = self#man_of_text [ Code s ] + + (** Take a string and return the string where fully qualified idents + have been replaced by idents relative to the given module name.*) + method relative_idents m_name s = + let f str_t = + let match_s = Str.matched_string str_t in + Odoc_info.apply_if_equal + Odoc_info.use_hidden_modules + match_s + (Name.get_relative m_name match_s) + in + let s2 = Str.global_substitute + (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)") + f + s + in + s2 + + (** Groff string to display a [Types.type_expr].*) + method man_of_type_expr m_name t = + let s = String.concat "\n" + (Str.split (Str.regexp "\n") (Odoc_misc.string_of_type_expr t)) + in + let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in + "\n.B "^(self#relative_idents m_name s2)^"\n" + + (** Groff string to display a [Types.type_expr list].*) + method man_of_type_expr_list m_name sep l = + let s = Odoc_misc.string_of_type_list sep l in + let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in + "\n.B "^(self#relative_idents m_name s2)^"\n" + + (** Groff string to display a [Types.module_type]. *) + method man_of_module_type m_name t = + let s = String.concat "\n" + (Str.split (Str.regexp "\n") (Odoc_misc.string_of_module_type t)) + in + let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in + "\n.B "^(self#relative_idents m_name s2)^"\n" + + (** Groff string code for a value. *) + method man_of_value v = + Odoc_info.reset_type_names () ; + "\n.I val "^(Name.simple v.val_name)^" \n: "^ + (self#man_of_type_expr (Name.father v.val_name) v.val_type)^ + ".sp\n"^ + (self#man_of_info v.val_info)^ + "\n.sp\n" + + (** Groff string code for an exception. *) + method man_of_exception e = + Odoc_info.reset_type_names () ; + "\n.I exception "^(Name.simple e.ex_name)^" \n"^ + (match e.ex_args with + [] -> "" + | _ -> + ".B of "^ + (self#man_of_type_expr_list (Name.father e.ex_name) " * " e.ex_args) + )^ + (match e.ex_alias with + None -> "" + | Some ea -> " = "^ + ( + match ea.ea_ex with + None -> ea.ea_name + | Some e -> e.ex_name + ) + )^ + "\n.sp\n"^ + (self#man_of_info e.ex_info)^ + "\n.sp\n" + + (** Groff string for a type. *) + method man_of_type t = + Odoc_info.reset_type_names () ; + let father = Name.father t.ty_name in + ".I type "^ + (match t.ty_parameters with + [] -> "" + | tp :: [] -> (Odoc_misc.string_of_type_expr tp) + | l -> + (self#man_of_type_expr_list father ", " l) + )^ + (match t.ty_parameters with [] -> "" | _ -> ".I ")^(Name.simple t.ty_name)^" \n"^ + (match t.ty_manifest with None -> "" | Some typ -> "= "^(self#man_of_type_expr father typ))^ + (match t.ty_kind with + Type_abstract -> + "" + | Type_variant l -> + "=\n "^ + (String.concat "" + (List.map + (fun constr -> + "| "^constr.vc_name^ + (match constr.vc_args, constr.vc_text with + [], None -> "\n " + | [], (Some t) -> " (* "^(self#man_of_text t)^" *)\n " + | l, None -> + "\n.B of "^(self#man_of_type_expr_list father " * " l)^" " + | l, (Some t) -> + "\n.B of "^(self#man_of_type_expr_list father " * " l)^ + ".I \" \"\n"^ + "(* "^(self#man_of_text t)^" *)\n " + ) + ) + l + ) + ) + | Type_record l -> + "= {"^ + (String.concat "" + (List.map + (fun r -> + (if r.rf_mutable then "\n\n.B mutable \n" else "\n ")^ + r.rf_name^" : "^(self#man_of_type_expr father r.rf_type)^";"^ + (match r.rf_text with + None -> + "" + | Some t -> + " (* "^(self#man_of_text t)^" *) " + )^"" + ) + l + ) + )^ + "\n }\n" + )^ + "\n.sp\n"^(self#man_of_info t.ty_info)^ + "\n.sp\n" + + (** Groff string for a class attribute. *) + method man_of_attribute a = + ".I val "^ + (if a.att_mutable then Odoc_messages.mutab^" " else "")^ + (Name.simple a.att_value.val_name)^" : "^ + (self#man_of_type_expr (Name.father a.att_value.val_name) a.att_value.val_type)^ + "\n.sp\n"^(self#man_of_info a.att_value.val_info)^ + "\n.sp\n" + + (** Groff string for a class method. *) + method man_of_method m = + ".I method "^ + (if m.met_private then "private " else "")^ + (if m.met_virtual then "virtual " else "")^ + (Name.simple m.met_value.val_name)^" : "^ + (self#man_of_type_expr (Name.father m.met_value.val_name) m.met_value.val_type)^ + "\n.sp\n"^(self#man_of_info m.met_value.val_info)^ + "\n.sp\n" + + (** Groff for a list of parameters. *) + method man_of_parameter_list m_name l = + match l with + [] -> + "" + | _ -> + "\n.B "^Odoc_messages.parameters^": \n"^ + (String.concat "" + (List.map + (fun p -> + ".TP\n"^ + "\""^(Parameter.complete_name p)^"\"\n"^ + (self#man_of_type_expr m_name (Parameter.typ p))^"\n"^ + (self#man_of_parameter_description p)^"\n" + ) + l + ) + )^"\n" + + (** Groff for the description of a function parameter. *) + method man_of_parameter_description p = + match Parameter.names p with + [] -> + "" + | name :: [] -> + ( + (* Only one name, no need for label for the description. *) + match Parameter.desc_by_name p name with + None -> "" + | Some t -> "\n "^(self#man_of_text t) + ) + | l -> + (* A list of names, we display those with a description. *) + String.concat "" + (List.map + (fun n -> + match Parameter.desc_by_name p n with + None -> "" + | Some t -> (self#man_of_code (n^" : "))^(self#man_of_text t) + ) + l + ) + + (** Groff string for a list of module parameters. *) + method man_of_module_parameter_list m_name l = + match l with + [] -> + "" + | _ -> + ".B \""^Odoc_messages.parameters^":\"\n"^ + (String.concat "" + (List.map + (fun (p, desc_opt) -> + ".TP\n"^ + "\""^p.mp_name^"\"\n"^ + (self#man_of_module_type m_name p.mp_type)^"\n"^ + (match desc_opt with + None -> "" + | Some t -> self#man_of_text t)^ + "\n" + ) + l + ) + )^"\n\n" + + (** Groff string for a [class_kind]. *) + method man_of_class_kind ?(with_def_syntax=true) ckind = + match ckind with + Class_structure _ -> + (if with_def_syntax then " = " else "")^ + (self#man_of_code Odoc_messages.object_end) + + | Class_apply capp -> + (if with_def_syntax then " = " else "")^ + ( + match capp.capp_class with + None -> capp.capp_name + | Some cl -> cl.cl_name + )^ + " "^ + (String.concat " " + (List.map + (fun s -> self#man_of_code ("("^s^")")) + capp.capp_params_code)) + + | Class_constr cco -> + (if with_def_syntax then " = " else "")^ + ( + match cco.cco_type_parameters with + [] -> "" + | l -> "["^(Odoc_misc.string_of_type_list ", " l)^"] " + )^ + ( + match cco.cco_class with + None -> cco.cco_name + | Some cl -> cl.cl_name^" " + ) + | Class_constraint (ck, ctk) -> + (if with_def_syntax then " = " else "")^ + "( "^(self#man_of_class_kind ~with_def_syntax: false ck)^ + " : "^ + (self#man_of_class_type_kind ctk)^ + " )" + + (** Groff string for the given [class_type_kind].*) + method man_of_class_type_kind ?def_syntax ctkind = + match ctkind with + Class_type cta -> + (match def_syntax with + None -> "" + | Some s -> " "^s^" ")^ + ( + match cta.cta_class with + None -> cta.cta_name + | Some (Cltype (clt, _)) -> clt.clt_name + | Some (Cl cl) -> cl.cl_name + ) + | Class_signature _ -> + (match def_syntax with + None -> "" + | Some s -> " "^s^" ")^ + (self#man_of_code Odoc_messages.object_end) + + (** Groff string for a [module_kind]. *) + method man_of_module_kind ?(with_def_syntax=true) k = + match k with + Module_alias m_alias -> + (match m_alias.ma_module with + None -> + (if with_def_syntax then " = " else "")^ + m_alias.ma_name + | Some (Mod m) -> + (if with_def_syntax then " = " else "")^m.m_name + | Some (Modtype mt) -> + (if with_def_syntax then " : " else "")^mt.mt_name + ) + | Module_apply (k1, k2) -> + (if with_def_syntax then " = " else "")^ + (self#man_of_module_kind ~with_def_syntax: false k1)^ + " ( "^(self#man_of_module_kind ~with_def_syntax: false k2)^" ) " + + | Module_with (tk, code) -> + (if with_def_syntax then " : " else "")^ + (self#man_of_module_type_kind ~with_def_syntax: false tk)^ + (self#man_of_code code) + + | Module_constraint (k, tk) -> + (if with_def_syntax then " = " else "")^ + "( "^(self#man_of_module_kind ~with_def_syntax: false k)^" : "^ + (self#man_of_module_type_kind ~with_def_syntax: false tk)^" )" + + | Module_struct _ -> + (if with_def_syntax then " = " else "")^ + (self#man_of_code (Odoc_messages.struct_end^" ")) + + | Module_functor _ -> + (if with_def_syntax then " = " else "")^ + (self#man_of_code "functor ... ") + + (** Groff string for a [module_type_kind]. *) + method man_of_module_type_kind ?(with_def_syntax=true) tk = + match tk with + | Module_type_struct _ -> + (if with_def_syntax then " : " else "")^ + (self#man_of_code Odoc_messages.sig_end) + + | Module_type_functor (params, k) -> + let f p = "("^p.mp_name^" : "^(self#man_of_module_type "" p.mp_type)^") -> " in + let s1 = String.concat "" (List.map f params) in + let s2 = self#man_of_module_type_kind ~with_def_syntax: false k in + (if with_def_syntax then " : " else "")^s1^s2 + + | Module_type_with (tk2, code) -> (* we don't want to print nested with's *) + let s = self#man_of_module_type_kind ~with_def_syntax: false tk2 in + (if with_def_syntax then " : " else "")^ + s^(self#man_of_code code) + + | Module_type_alias mt_alias -> + (if with_def_syntax then " : " else "")^ + (match mt_alias.mta_module with + None -> + mt_alias.mta_name + | Some mt -> + mt.mt_name + ) + + (** Groff string for a class. *) + method man_of_class c = + Odoc_info.reset_type_names () ; + ".I class "^ + (if c.cl_virtual then "virtual " else "")^ + ( + match c.cl_type_parameters with + [] -> "" + | l -> "["^(Odoc_misc.string_of_type_list ", " l)^".I ] " + )^ + (Name.simple c.cl_name)^ + (match c.cl_parameters with [] -> "" | _ -> " ... ")^ + (self#man_of_class_kind c.cl_kind)^ + "\n.sp\n"^(self#man_of_info c.cl_info)^"\n.sp\n" + + (** Groff string for a class type. *) + method man_of_class_type ct = + Odoc_info.reset_type_names () ; + ".I class type "^ + (if ct.clt_virtual then "virtual " else "")^ + ( + match ct.clt_type_parameters with + [] -> "" + | l -> "["^(Odoc_misc.string_of_type_list ", " l)^".I ] " + )^ + (Name.simple ct.clt_name)^ + (self#man_of_class_type_kind ~def_syntax: ":" ct.clt_kind)^ + "\n.sp\n"^(self#man_of_info ct.clt_info)^"\n.sp\n" + + (** Groff string for a module. *) + method man_of_module m = + ".I module "^(Name.simple m.m_name)^ + (self#man_of_module_kind m.m_kind)^ + "\n.sp\n"^(self#man_of_info m.m_info)^"\n.sp\n" + + (** Groff string for a module type. *) + method man_of_modtype mt = + ".I module type "^(Name.simple mt.mt_name)^ + (match mt.mt_kind with None -> "" | Some k -> self#man_of_module_type_kind k)^ + "\n.sp\n"^(self#man_of_info mt.mt_info)^"\n.sp\n" + + (** Groff string for a module comment.*) + method man_of_module_comment text = + "\n.pp\n"^ + (self#man_of_text [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")])^ + "\n.pp\n" + + (** Groff string for a class comment.*) + method man_of_class_comment text = + "\n.pp\n"^ + (self#man_of_text [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")])^ + "\n.pp\n" + + (** Groff string for an included module. *) + method man_of_included_module m_name im = + ".I include "^ + ( + match im.im_module with + None -> im.im_name + | Some mmt -> + let name = + match mmt with + Mod m -> m.m_name + | Modtype mt -> mt.mt_name + in + self#relative_idents m_name name + )^ + "\n.sp\n" + + (** Generate the man page for the given class.*) + method generate_for_class cl = + Odoc_info.reset_type_names () ; + let date = Unix.time () in + let file = self#file_name cl.cl_name in + try + let chanout = self#open_out file in + output_string chanout + (".TH \""^Odoc_messages.clas^"\" "^ + cl.cl_name^" "^ + "\""^(Odoc_misc.string_of_date ~hour: false date)^"\" "^ + "Odoc "^ + "\""^(match !Odoc_args.title with Some t -> t | None -> "")^"\n"); + + output_string chanout + ( + ".SH "^Odoc_messages.clas^"\n"^ + Odoc_messages.clas^" "^cl.cl_name^"\n"^ + ".SH "^Odoc_messages.documentation^"\n"^ + ".sp\n"^ + Odoc_messages.clas^"\n"^ + (if cl.cl_virtual then ".B virtual \n" else "")^ + ".B \""^(Name.simple cl.cl_name)^"\"\n"^ + (self#man_of_class_kind cl.cl_kind )^ + "\n.sp\n"^ + (self#man_of_info cl.cl_info)^"\n"^ + ".sp\n" + ); + + (* parameters *) + output_string chanout + (self#man_of_parameter_list "" cl.cl_parameters); + (* a large blank *) + output_string chanout "\n.sp\n.sp\n"; + +(* + (* class inheritance *) + self#generate_class_inheritance_info chanout cl; +*) + (* the various elements *) + List.iter + (fun element -> + match element with + Class_attribute a -> + output_string chanout (self#man_of_attribute a) + | Class_method m -> + output_string chanout (self#man_of_method m) + | Class_comment t -> + output_string chanout (self#man_of_class_comment t) + ) + (Class.class_elements cl); + + close_out chanout + with + Sys_error s -> + incr Odoc_info.errors ; + prerr_endline s + + (** Generate the man page for the given class type.*) + method generate_for_class_type ct = + Odoc_info.reset_type_names () ; + let date = Unix.time () in + let file = self#file_name ct.clt_name in + try + let chanout = self#open_out file in + output_string chanout + (".TH \""^Odoc_messages.class_type^"\" "^ + ct.clt_name^" "^ + "\""^(Odoc_misc.string_of_date ~hour: false date)^"\" "^ + "Odoc "^ + "\""^(match !Odoc_args.title with Some t -> t | None -> "")^"\n"); + + output_string chanout + ( + ".SH "^Odoc_messages.class_type^"\n"^ + Odoc_messages.class_type^" "^ct.clt_name^"\n"^ + ".SH "^Odoc_messages.documentation^"\n"^ + ".sp\n"^ + Odoc_messages.class_type^"\n"^ + (if ct.clt_virtual then ".B virtual \n" else "")^ + ".B \""^(Name.simple ct.clt_name)^"\"\n"^ + (self#man_of_class_type_kind ~def_syntax: ":" ct.clt_kind )^ + "\n.sp\n"^ + (self#man_of_info ct.clt_info)^"\n"^ + ".sp\n" + ); + (* a large blank *) + output_string chanout "\n.sp\n.sp\n"; +(* + (* class inheritance *) + self#generate_class_inheritance_info chanout cl; +*) + (* the various elements *) + List.iter + (fun element -> + match element with + Class_attribute a -> + output_string chanout (self#man_of_attribute a) + | Class_method m -> + output_string chanout (self#man_of_method m) + | Class_comment t -> + output_string chanout (self#man_of_class_comment t) + ) + (Class.class_type_elements ct); + + close_out chanout + with + Sys_error s -> + incr Odoc_info.errors ; + prerr_endline s + + (** Generate the man file for the given module type. + @raise Failure if an error occurs.*) + method generate_for_module_type mt = + let date = Unix.time () in + let file = self#file_name mt.mt_name in + try + let chanout = self#open_out file in + output_string chanout + (".TH \""^Odoc_messages.module_type^"\" "^ + mt.mt_name^" "^ + "\""^(Odoc_misc.string_of_date ~hour: false date)^"\" "^ + "Odoc "^ + "\""^(match !Odoc_args.title with Some t -> t | None -> "")^"\n"); + + output_string chanout + ( + ".SH "^Odoc_messages.module_type^"\n"^ + Odoc_messages.module_type^" "^mt.mt_name^"\n"^ + ".SH "^Odoc_messages.documentation^"\n"^ + ".sp\n"^ + Odoc_messages.module_type^"\n"^ + ".BI \""^(Name.simple mt.mt_name)^"\"\n"^ + (match mt.mt_kind with None -> "" | Some k -> self#man_of_module_type_kind k)^ + "\n.sp\n"^ + (self#man_of_info mt.mt_info)^"\n"^ + ".sp\n" + ); + + (* parameters for functors *) + output_string chanout + (self#man_of_module_parameter_list "" (Module.module_type_parameters mt)); + (* a large blank *) + output_string chanout "\n.sp\n.sp\n"; + + (* module elements *) + List.iter + (fun ele -> + match ele with + Element_module m -> + output_string chanout (self#man_of_module m) + | Element_module_type mt -> + output_string chanout (self#man_of_modtype mt) + | Element_included_module im -> + output_string chanout (self#man_of_included_module mt.mt_name im) + | Element_class c -> + output_string chanout (self#man_of_class c) + | Element_class_type ct -> + output_string chanout (self#man_of_class_type ct) + | Element_value v -> + output_string chanout (self#man_of_value v) + | Element_exception e -> + output_string chanout (self#man_of_exception e) + | Element_type t -> + output_string chanout (self#man_of_type t) + | Element_module_comment text -> + output_string chanout (self#man_of_module_comment text) + ) + (Module.module_type_elements mt); + + close_out chanout + + with + Sys_error s -> + incr Odoc_info.errors ; + prerr_endline s + + (** Generate the man file for the given module. + @raise Failure if an error occurs.*) + method generate_for_module m = + let date = Unix.time () in + let file = self#file_name m.m_name in + try + let chanout = self#open_out file in + output_string chanout + (".TH \""^Odoc_messages.modul^"\" "^ + m.m_name^" "^ + "\""^(Odoc_misc.string_of_date ~hour: false date)^"\" "^ + "Odoc "^ + "\""^(match !Odoc_args.title with Some t -> t | None -> "")^"\n"); + + output_string chanout + ( + ".SH "^Odoc_messages.modul^"\n"^ + Odoc_messages.modul^" "^m.m_name^"\n"^ + ".SH "^Odoc_messages.documentation^"\n"^ + ".sp\n"^ + Odoc_messages.modul^"\n"^ + ".BI \""^(Name.simple m.m_name)^"\"\n"^ + (self#man_of_module_kind m.m_kind)^ + "\n.sp\n"^ + (self#man_of_info m.m_info)^"\n"^ + ".sp\n" + ); + + (* parameters for functors *) + output_string chanout + (self#man_of_module_parameter_list "" (Module.module_parameters m)); + (* a large blank *) + output_string chanout "\n.sp\n.sp\n"; + + (* module elements *) + List.iter + (fun ele -> + match ele with + Element_module m -> + output_string chanout (self#man_of_module m) + | Element_module_type mt -> + output_string chanout (self#man_of_modtype mt) + | Element_included_module im -> + output_string chanout (self#man_of_included_module m.m_name im) + | Element_class c -> + output_string chanout (self#man_of_class c) + | Element_class_type ct -> + output_string chanout (self#man_of_class_type ct) + | Element_value v -> + output_string chanout (self#man_of_value v) + | Element_exception e -> + output_string chanout (self#man_of_exception e) + | Element_type t -> + output_string chanout (self#man_of_type t) + | Element_module_comment text -> + output_string chanout (self#man_of_module_comment text) + ) + (Module.module_elements m); + + close_out chanout + + with + Sys_error s -> + raise (Failure s) + + (** Create the groups of elements to generate pages for. *) + method create_groups module_list = + let name res_ele = + match res_ele with + Res_module m -> m.m_name + | Res_module_type mt -> mt.mt_name + | Res_class c -> c.cl_name + | Res_class_type ct -> ct.clt_name + | Res_value v -> Name.simple v.val_name + | Res_type t -> Name.simple t.ty_name + | Res_exception e -> Name.simple e.ex_name + | Res_attribute a -> Name.simple a.att_value.val_name + | Res_method m -> Name.simple m.met_value.val_name + | Res_section s -> assert false + in + let all_items_pre = Odoc_info.Search.search_by_name module_list (Str.regexp ".*") in + let all_items = List.filter + (fun r -> match r with Res_section _ -> false | _ -> true) + all_items_pre + in + let sorted_items = List.sort (fun e1 -> fun e2 -> compare (name e1) (name e2)) all_items in + let rec f acc1 acc2 l = + match l with + [] -> acc2 :: acc1 + | h :: q -> + match acc2 with + [] -> f acc1 [h] q + | h2 :: q2 -> + if (name h) = (name h2) then + if List.mem h acc2 then + f acc1 acc2 q + else + f acc1 (acc2 @ [h]) q + else + f (acc2 :: acc1) [h] q + in + f [] [] sorted_items + + (** Generate a man page for a group of elements with the same name. + A group must not be empty.*) + method generate_for_group l = + let name = + Name.simple + ( + match List.hd l with + Res_module m -> m.m_name + | Res_module_type mt -> mt.mt_name + | Res_class c -> c.cl_name + | Res_class_type ct -> ct.clt_name + | Res_value v -> v.val_name + | Res_type t -> t.ty_name + | Res_exception e -> e.ex_name + | Res_attribute a -> a.att_value.val_name + | Res_method m -> m.met_value.val_name + | Res_section s -> s + ) + in + let date = Unix.time () in + let file = self#file_name name in + try + let chanout = self#open_out file in + output_string chanout + (".TH \""^name^"\" "^ + "man "^ + "\""^(Odoc_misc.string_of_date ~hour: false date)^"\" "^ + "Odoc "^ + "\""^(match !Odoc_args.title with Some t -> t | None -> "")^"\n"); + + let f ele = + match ele with + Res_value v -> + output_string chanout + ("\n.SH "^Odoc_messages.modul^" "^(Name.father v.val_name)^"\n"^ + (self#man_of_value v)) + | Res_type t -> + output_string chanout + ("\n.SH "^Odoc_messages.modul^" "^(Name.father t.ty_name)^"\n"^ + (self#man_of_type t)) + | Res_exception e -> + output_string chanout + ("\n.SH "^Odoc_messages.modul^" "^(Name.father e.ex_name)^"\n"^ + (self#man_of_exception e)) + | Res_attribute a -> + output_string chanout + ("\n.SH "^Odoc_messages.clas^" "^(Name.father a.att_value.val_name)^"\n"^ + (self#man_of_attribute a)) + | Res_method m -> + output_string chanout + ("\n.SH "^Odoc_messages.clas^" "^(Name.father m.met_value.val_name)^"\n"^ + (self#man_of_method m)) + | Res_class c -> + output_string chanout + ("\n.SH "^Odoc_messages.modul^" "^(Name.father c.cl_name)^"\n"^ + (self#man_of_class c)) + | Res_class_type ct -> + output_string chanout + ("\n.SH "^Odoc_messages.modul^" "^(Name.father ct.clt_name)^"\n"^ + (self#man_of_class_type ct)) + | _ -> + (* normalement on ne peut pas avoir de module ici. *) + () + in + List.iter f l; + close_out chanout + with + Sys_error s -> + incr Odoc_info.errors ; + prerr_endline s + + (** Generate all the man pages from a module list. *) + method generate module_list = + let sorted_module_list = Sort.list (fun m1 -> fun m2 -> m1.m_name < m2.m_name) module_list in + let groups = self#create_groups sorted_module_list in + let f group = + match group with + [] -> + () + | [Res_module m] -> self#generate_for_module m + | [Res_module_type mt] -> self#generate_for_module_type mt + | [Res_class cl] -> self#generate_for_class cl + | [Res_class_type ct] -> self#generate_for_class_type ct + | l -> + self#generate_for_group l + in + List.iter f groups + end |