1044 lines
32 KiB
OCaml
1044 lines
32 KiB
OCaml
(***********************************************************************)
|
|
(* 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. *)
|
|
(* *)
|
|
(***********************************************************************)
|
|
|
|
(* $Id$ *)
|
|
|
|
(** The man pages generator. *)
|
|
open Odoc_info
|
|
open Parameter
|
|
open Value
|
|
open Type
|
|
open Exception
|
|
open Class
|
|
open Module
|
|
open Search
|
|
|
|
let new_buf () = Buffer.create 1024
|
|
let bp = Printf.bprintf
|
|
let bs = Buffer.add_string
|
|
|
|
(** 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 : Buffer.t -> Odoc_info.text -> unit
|
|
|
|
(** Print groff string for an author list. *)
|
|
method man_of_author_list b l =
|
|
match l with
|
|
[] -> ()
|
|
| _ ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.authors;
|
|
bs b "\"\n:\n";
|
|
bs b (String.concat ", " l);
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for the given optional version information.*)
|
|
method man_of_version_opt b v_opt =
|
|
match v_opt with
|
|
None -> ()
|
|
| Some v ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.version;
|
|
bs b "\"\n:\n";
|
|
bs b v;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for the given optional since information.*)
|
|
method man_of_since_opt b s_opt =
|
|
match s_opt with
|
|
None -> ()
|
|
| Some s ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.since;
|
|
bs b "\"\n";
|
|
bs b s;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for the given list of raised exceptions.*)
|
|
method man_of_raised_exceptions b l =
|
|
match l with
|
|
[] -> ()
|
|
| (s, t) :: [] ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.raises;
|
|
bs b (" "^s^"\"\n");
|
|
self#man_of_text b t;
|
|
bs b "\n.sp\n"
|
|
| _ ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.raises;
|
|
bs b "\"\n";
|
|
List.iter
|
|
(fun (ex, desc) ->
|
|
bs b ".TP\n.B \"";
|
|
bs b ex;
|
|
bs b "\"\n";
|
|
self#man_of_text b desc;
|
|
bs b "\n"
|
|
)
|
|
l;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for the given "see also" reference. *)
|
|
method man_of_see b (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 b t_ref
|
|
|
|
(** Print groff string for the given list of "see also" references.*)
|
|
method man_of_sees b l =
|
|
match l with
|
|
[] -> ()
|
|
| see :: [] ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.see_also;
|
|
bs b "\"\n";
|
|
self#man_of_see b see;
|
|
bs b "\n.sp\n"
|
|
| _ ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.see_also;
|
|
bs b "\"\n";
|
|
List.iter
|
|
(fun see ->
|
|
bs b ".TP\n \"\"\n";
|
|
self#man_of_see b see;
|
|
bs b "\n"
|
|
)
|
|
l;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for the given optional return information.*)
|
|
method man_of_return_opt b return_opt =
|
|
match return_opt with
|
|
None -> ()
|
|
| Some s ->
|
|
bs b ".B ";
|
|
bs b Odoc_messages.returns;
|
|
bs b "\n";
|
|
self#man_of_text b s;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print man code for the given list of custom tagged texts. *)
|
|
method man_of_custom b 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
|
|
|
|
(** Print the groff string to display an optional info structure. *)
|
|
method man_of_info b info_opt =
|
|
match info_opt with
|
|
None -> ()
|
|
| Some info ->
|
|
let module M = Odoc_info in
|
|
(
|
|
match info.M.i_deprecated with
|
|
None -> ()
|
|
| Some d ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.deprecated;
|
|
bs b "\"\n";
|
|
self#man_of_text b d;
|
|
bs b "\n.sp\n"
|
|
);
|
|
(
|
|
match info.M.i_desc with
|
|
None -> ()
|
|
| Some d when d = [Odoc_info.Raw ""] -> ()
|
|
| Some d ->
|
|
self#man_of_text b d;
|
|
bs b "\n.sp\n"
|
|
);
|
|
self#man_of_author_list b info.M.i_authors;
|
|
self#man_of_version_opt b info.M.i_version;
|
|
self#man_of_since_opt b info.M.i_since;
|
|
self#man_of_raised_exceptions b info.M.i_raised_exceptions;
|
|
self#man_of_return_opt b info.M.i_return_value;
|
|
self#man_of_sees b info.M.i_sees;
|
|
self#man_of_custom b info.M.i_custom
|
|
end
|
|
|
|
(** This class is used to create objects which can generate a simple html documentation. *)
|
|
class man =
|
|
let re_slash = Str.regexp_string "/" in
|
|
object (self)
|
|
inherit info
|
|
|
|
(** Get a file name from a complete name. *)
|
|
method file_name name =
|
|
let s = Printf.sprintf "%s.%s" name !Args.man_suffix in
|
|
Str.global_replace re_slash "slash" s
|
|
|
|
(** 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 !Args.target_dir file in
|
|
open_out f
|
|
|
|
(** Print groff string for a text, without correction of blanks. *)
|
|
method private man_of_text2 b t =
|
|
List.iter (self#man_of_text_element b) t
|
|
|
|
(** Print the groff string for a text, with blanks corrected. *)
|
|
method man_of_text b t =
|
|
let b2 = new_buf () in
|
|
self#man_of_text2 b2 t ;
|
|
let s = Buffer.contents b2 in
|
|
let s2 = Str.global_replace (Str.regexp "\n[ ]*") "\n" s in
|
|
bs b (Str.global_replace (Str.regexp "\n\n") "\n" s2)
|
|
|
|
(** Return the given string without no newlines. *)
|
|
method remove_newlines s =
|
|
Str.global_replace (Str.regexp "[ ]*\n[ ]*") " " s
|
|
|
|
(** Print the groff string for a text element. *)
|
|
method man_of_text_element b te =
|
|
match te with
|
|
| Odoc_info.Raw s -> bs b s
|
|
| Odoc_info.Code s ->
|
|
bs b "\n.B ";
|
|
bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n")
|
|
| Odoc_info.CodePre s ->
|
|
bs b "\n.B ";
|
|
bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n")
|
|
| Odoc_info.Verbatim s ->
|
|
bs b (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 b t
|
|
| Odoc_info.List tl ->
|
|
List.iter
|
|
(fun t -> bs b ".TP\n \"\"\n"; self#man_of_text2 b t; bs b "\n")
|
|
tl;
|
|
bs b "\n"
|
|
| Odoc_info.Enum tl ->
|
|
List.iter
|
|
(fun t -> bs b ".TP\n \"\"\n"; self#man_of_text2 b t; bs b "\n")
|
|
tl;
|
|
bs b "\n"
|
|
| Odoc_info.Newline ->
|
|
bs b "\n.sp\n"
|
|
| Odoc_info.Block t ->
|
|
bs b "\n.sp\n";
|
|
self#man_of_text2 b t;
|
|
bs b "\n.sp\n"
|
|
| Odoc_info.Title (n, l_opt, t) ->
|
|
self#man_of_text2 b [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 b t
|
|
| Odoc_info.Ref (name, _) ->
|
|
self#man_of_text_element b
|
|
(Odoc_info.Code (Odoc_info.use_hidden_modules name))
|
|
| Odoc_info.Superscript t ->
|
|
bs b "^{"; self#man_of_text2 b t
|
|
| Odoc_info.Subscript t ->
|
|
bs b "_{"; self#man_of_text2 b t
|
|
| Odoc_info.Module_list _ ->
|
|
()
|
|
| Odoc_info.Index_list ->
|
|
()
|
|
|
|
(** Print groff string to display code. *)
|
|
method man_of_code b s = self#man_of_text b [ 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
|
|
|
|
(** Print groff string to display a [Types.type_expr].*)
|
|
method man_of_type_expr b m_name t =
|
|
let s = String.concat "\n"
|
|
(Str.split (Str.regexp "\n") (Odoc_print.string_of_type_expr t))
|
|
in
|
|
let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
|
|
bs b "\n.B ";
|
|
bs b (self#relative_idents m_name s2);
|
|
bs b "\n"
|
|
|
|
(** Print groff string to display a [Types.class_type].*)
|
|
method man_of_class_type_expr b m_name t =
|
|
let s = String.concat "\n"
|
|
(Str.split (Str.regexp "\n") (Odoc_print.string_of_class_type t))
|
|
in
|
|
let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
|
|
bs b "\n.B ";
|
|
bs b (self#relative_idents m_name s2);
|
|
bs b "\n"
|
|
|
|
(** Print groff string to display a [Types.type_expr list].*)
|
|
method man_of_type_expr_list ?par b m_name sep l =
|
|
let s = Odoc_str.string_of_type_list ?par sep l in
|
|
let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
|
|
bs b "\n.B ";
|
|
bs b (self#relative_idents m_name s2);
|
|
bs b "\n"
|
|
|
|
(** Print groff string to display the parameters of a type.*)
|
|
method man_of_type_expr_param_list b m_name t =
|
|
match t.ty_parameters with
|
|
[] -> ()
|
|
| l ->
|
|
let s = Odoc_str.string_of_type_param_list t in
|
|
let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
|
|
bs b "\n.B ";
|
|
bs b (self#relative_idents m_name s2);
|
|
bs b "\n"
|
|
|
|
(** Print groff string to display a [Types.module_type]. *)
|
|
method man_of_module_type b m_name t =
|
|
let s = String.concat "\n"
|
|
(Str.split (Str.regexp "\n") (Odoc_print.string_of_module_type t))
|
|
in
|
|
let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
|
|
bs b "\n.B ";
|
|
bs b (self#relative_idents m_name s2);
|
|
bs b "\n"
|
|
|
|
(** Print groff string code for a value. *)
|
|
method man_of_value b v =
|
|
Odoc_info.reset_type_names () ;
|
|
bs b "\n.I val ";
|
|
bs b (Name.simple v.val_name);
|
|
bs b " \n: ";
|
|
self#man_of_type_expr b (Name.father v.val_name) v.val_type;
|
|
bs b ".sp\n";
|
|
self#man_of_info b v.val_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string code for an exception. *)
|
|
method man_of_exception b e =
|
|
Odoc_info.reset_type_names () ;
|
|
bs b "\n.I exception ";
|
|
bs b (Name.simple e.ex_name);
|
|
bs b " \n";
|
|
(
|
|
match e.ex_args with
|
|
[] -> ()
|
|
| _ ->
|
|
bs b ".B of ";
|
|
self#man_of_type_expr_list
|
|
~par: false
|
|
b (Name.father e.ex_name) " * " e.ex_args
|
|
);
|
|
(
|
|
match e.ex_alias with
|
|
None -> ()
|
|
| Some ea ->
|
|
bs b " = ";
|
|
bs b
|
|
(
|
|
match ea.ea_ex with
|
|
None -> ea.ea_name
|
|
| Some e -> e.ex_name
|
|
)
|
|
);
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b e.ex_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for a type. *)
|
|
method man_of_type b t =
|
|
Odoc_info.reset_type_names () ;
|
|
let father = Name.father t.ty_name in
|
|
bs b ".I type ";
|
|
self#man_of_type_expr_param_list b father t;
|
|
(
|
|
match t.ty_parameters with
|
|
[] -> ()
|
|
| _ -> bs b ".I "
|
|
);
|
|
bs b (Name.simple t.ty_name);
|
|
bs b " \n";
|
|
(
|
|
match t.ty_manifest with
|
|
None -> ()
|
|
| Some typ ->
|
|
bs b "= ";
|
|
self#man_of_type_expr b father typ
|
|
);
|
|
(
|
|
match t.ty_kind with
|
|
Type_abstract -> ()
|
|
| Type_variant (l, priv) ->
|
|
bs b "=";
|
|
if priv then bs b " private";
|
|
bs b "\n ";
|
|
List.iter
|
|
(fun constr ->
|
|
bs b ("| "^constr.vc_name);
|
|
(
|
|
match constr.vc_args, constr.vc_text with
|
|
[], None -> bs b "\n "
|
|
| [], (Some t) ->
|
|
bs b " (* ";
|
|
self#man_of_text b t;
|
|
bs b " *)\n "
|
|
| l, None ->
|
|
bs b "\n.B of ";
|
|
self#man_of_type_expr_list ~par: false b father " * " l;
|
|
bs b " "
|
|
| l, (Some t) ->
|
|
bs b "\n.B of ";
|
|
self#man_of_type_expr_list ~par: false b father " * " l;
|
|
bs b ".I \" \"\n";
|
|
bs b "(* ";
|
|
self#man_of_text b t;
|
|
bs b " *)\n "
|
|
)
|
|
)
|
|
l
|
|
| Type_record (l, priv) ->
|
|
bs b "= ";
|
|
if priv then bs b "private ";
|
|
bs b "{";
|
|
List.iter
|
|
(fun r ->
|
|
bs b (if r.rf_mutable then "\n\n.B mutable \n" else "\n ");
|
|
bs b (r.rf_name^" : ");
|
|
self#man_of_type_expr b father r.rf_type;
|
|
bs b ";";
|
|
(
|
|
match r.rf_text with
|
|
None -> ()
|
|
| Some t ->
|
|
bs b " (* ";
|
|
self#man_of_text b t;
|
|
bs b " *) "
|
|
);
|
|
)
|
|
l;
|
|
bs b "\n }\n"
|
|
);
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b t.ty_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for a class attribute. *)
|
|
method man_of_attribute b a =
|
|
bs b ".I val ";
|
|
if a.att_mutable then bs b (Odoc_messages.mutab^" ");
|
|
bs b ((Name.simple a.att_value.val_name)^" : ");
|
|
self#man_of_type_expr b (Name.father a.att_value.val_name) a.att_value.val_type;
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b a.att_value.val_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for a class method. *)
|
|
method man_of_method b m =
|
|
bs b ".I method ";
|
|
if m.met_private then bs b "private ";
|
|
if m.met_virtual then bs b "virtual ";
|
|
bs b ((Name.simple m.met_value.val_name)^" : ");
|
|
self#man_of_type_expr b
|
|
(Name.father m.met_value.val_name) m.met_value.val_type;
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b m.met_value.val_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Groff for a list of parameters. *)
|
|
method man_of_parameter_list b m_name l =
|
|
match l with
|
|
[] -> ()
|
|
| _ ->
|
|
bs b "\n.B ";
|
|
bs b Odoc_messages.parameters;
|
|
bs b ": \n";
|
|
List.iter
|
|
(fun p ->
|
|
bs b ".TP\n";
|
|
bs b "\"";
|
|
bs b (Parameter.complete_name p);
|
|
bs b "\"\n";
|
|
self#man_of_type_expr b m_name (Parameter.typ p);
|
|
bs b "\n";
|
|
self#man_of_parameter_description b p;
|
|
bs b "\n"
|
|
)
|
|
l;
|
|
bs b "\n"
|
|
|
|
(** Groff for the description of a function parameter. *)
|
|
method man_of_parameter_description b 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 -> bs b "\n "; self#man_of_text b t
|
|
)
|
|
| l ->
|
|
(* A list of names, we display those with a description. *)
|
|
List.iter
|
|
(fun n ->
|
|
match Parameter.desc_by_name p n with
|
|
None -> ()
|
|
| Some t ->
|
|
self#man_of_code b (n^" : ");
|
|
self#man_of_text b t
|
|
)
|
|
l
|
|
|
|
(** Print groff string for a list of module parameters. *)
|
|
method man_of_module_parameter_list b m_name l =
|
|
match l with
|
|
[] -> ()
|
|
| _ ->
|
|
bs b ".B \"";
|
|
bs b Odoc_messages.parameters;
|
|
bs b ":\"\n";
|
|
List.iter
|
|
(fun (p, desc_opt) ->
|
|
bs b ".TP\n";
|
|
bs b ("\""^p.mp_name^"\"\n");
|
|
self#man_of_module_type b m_name p.mp_type;
|
|
bs b "\n";
|
|
(
|
|
match desc_opt with
|
|
None -> ()
|
|
| Some t -> self#man_of_text b t
|
|
);
|
|
bs b "\n"
|
|
)
|
|
l;
|
|
bs b "\n\n"
|
|
|
|
(** Print groff string for a class. *)
|
|
method man_of_class b c =
|
|
Odoc_info.reset_type_names () ;
|
|
let father = Name.father c.cl_name in
|
|
bs b ".I class ";
|
|
if c.cl_virtual then bs b "virtual ";
|
|
(
|
|
match c.cl_type_parameters with
|
|
[] -> ()
|
|
| l ->
|
|
bs b (Odoc_str.string_of_class_type_param_list l);
|
|
bs b " "
|
|
);
|
|
bs b (Name.simple c.cl_name);
|
|
bs b " : " ;
|
|
self#man_of_class_type_expr b father c.cl_type;
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b c.cl_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for a class type. *)
|
|
method man_of_class_type b ct =
|
|
Odoc_info.reset_type_names () ;
|
|
bs b ".I class type ";
|
|
if ct.clt_virtual then bs b "virtual " ;
|
|
(
|
|
match ct.clt_type_parameters with
|
|
[] -> ()
|
|
| l ->
|
|
bs b (Odoc_str.string_of_class_type_param_list l);
|
|
bs b " "
|
|
);
|
|
bs b (Name.simple ct.clt_name);
|
|
bs b " = " ;
|
|
self#man_of_class_type_expr b (Name.father ct.clt_name) ct.clt_type;
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b ct.clt_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for a module. *)
|
|
method man_of_module b m =
|
|
bs b ".I module ";
|
|
bs b (Name.simple m.m_name);
|
|
bs b " : ";
|
|
self#man_of_module_type b (Name.father m.m_name) m.m_type;
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b m.m_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for a module type. *)
|
|
method man_of_modtype b mt =
|
|
bs b ".I module type ";
|
|
bs b (Name.simple mt.mt_name);
|
|
bs b " = ";
|
|
(match mt.mt_type with
|
|
None -> ()
|
|
| Some t ->
|
|
self#man_of_module_type b (Name.father mt.mt_name) t
|
|
);
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b mt.mt_info;
|
|
bs b "\n.sp\n"
|
|
|
|
(** Print groff string for a module comment.*)
|
|
method man_of_module_comment b text =
|
|
bs b "\n.pp\n";
|
|
self#man_of_text b [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")];
|
|
bs b "\n.pp\n"
|
|
|
|
(** Print groff string for a class comment.*)
|
|
method man_of_class_comment b text =
|
|
bs b "\n.pp\n";
|
|
self#man_of_text b [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")];
|
|
bs b "\n.pp\n"
|
|
|
|
(** Print groff string for an included module. *)
|
|
method man_of_included_module b m_name im =
|
|
bs b ".I include ";
|
|
(
|
|
match im.im_module with
|
|
None -> bs b im.im_name
|
|
| Some mmt ->
|
|
let name =
|
|
match mmt with
|
|
Mod m -> m.m_name
|
|
| Modtype mt -> mt.mt_name
|
|
in
|
|
bs b (self#relative_idents m_name name)
|
|
);
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b im.im_info;
|
|
bs b "\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
|
|
let b = new_buf () in
|
|
bs b ".TH \"";
|
|
bs b Odoc_messages.clas;
|
|
bs b ("\" "^cl.cl_name^" ");
|
|
bs b ("\""^(Odoc_misc.string_of_date ~hour: false date)^"\" ");
|
|
bs b "OCamldoc ";
|
|
bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
|
|
|
|
let abstract =
|
|
match cl.cl_info with
|
|
None | Some { i_desc = None } -> "no description"
|
|
| Some { i_desc = Some t } ->
|
|
let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in
|
|
self#remove_newlines s
|
|
in
|
|
|
|
bs b ".SH NAME\n";
|
|
bs b (cl.cl_name^" \\- "^abstract^"\n");
|
|
bs b (".SH "^Odoc_messages.clas^"\n");
|
|
bs b (Odoc_messages.clas^" "^cl.cl_name^"\n");
|
|
bs b (".SH "^Odoc_messages.documentation^"\n");
|
|
bs b ".sp\n";
|
|
self#man_of_class b cl;
|
|
|
|
(* parameters *)
|
|
self#man_of_parameter_list b "" cl.cl_parameters;
|
|
(* a large blank *)
|
|
bs b "\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 ->
|
|
self#man_of_attribute b a
|
|
| Class_method m ->
|
|
self#man_of_method b m
|
|
| Class_comment t ->
|
|
self#man_of_class_comment b t
|
|
)
|
|
(Class.class_elements cl);
|
|
|
|
Buffer.output_buffer chanout b;
|
|
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
|
|
let b = new_buf () in
|
|
bs b (".TH \""^Odoc_messages.class_type^"\" ");
|
|
bs b (ct.clt_name^" ");
|
|
bs b ("\""^(Odoc_misc.string_of_date ~hour: false date)^"\" ");
|
|
bs b "OCamldoc ";
|
|
bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
|
|
|
|
let abstract =
|
|
match ct.clt_info with
|
|
None | Some { i_desc = None } -> "no description"
|
|
| Some { i_desc = Some t } ->
|
|
let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in
|
|
self#remove_newlines s
|
|
in
|
|
|
|
bs b ".SH NAME\n";
|
|
bs b (ct.clt_name^" \\- "^abstract^"\n");
|
|
bs b (".SH "^Odoc_messages.class_type^"\n");
|
|
bs b (Odoc_messages.class_type^" "^ct.clt_name^"\n");
|
|
bs b (".SH "^Odoc_messages.documentation^"\n");
|
|
bs b ".sp\n";
|
|
|
|
self#man_of_class_type b ct;
|
|
|
|
(* a large blank *)
|
|
bs b "\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 ->
|
|
self#man_of_attribute b a
|
|
| Class_method m ->
|
|
self#man_of_method b m
|
|
| Class_comment t ->
|
|
self#man_of_class_comment b t
|
|
)
|
|
(Class.class_type_elements ct);
|
|
|
|
Buffer.output_buffer chanout b;
|
|
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
|
|
let b = new_buf () in
|
|
bs b (".TH \""^Odoc_messages.module_type^"\" ");
|
|
bs b (mt.mt_name^" ");
|
|
bs b ("\""^(Odoc_misc.string_of_date ~hour: false date)^"\" ");
|
|
bs b "OCamldoc ";
|
|
bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
|
|
|
|
let abstract =
|
|
match mt.mt_info with
|
|
None | Some { i_desc = None } -> "no description"
|
|
| Some { i_desc = Some t } ->
|
|
let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in
|
|
self#remove_newlines s
|
|
in
|
|
bs b ".SH NAME\n";
|
|
bs b (mt.mt_name^" \\- "^abstract^"\n");
|
|
bs b (".SH "^Odoc_messages.module_type^"\n");
|
|
bs b (Odoc_messages.module_type^" "^mt.mt_name^"\n");
|
|
bs b (".SH "^Odoc_messages.documentation^"\n");
|
|
bs b ".sp\n";
|
|
bs b (Odoc_messages.module_type^"\n");
|
|
bs b (".BI \""^(Name.simple mt.mt_name)^"\"\n");
|
|
bs b " = ";
|
|
(
|
|
match mt.mt_type with
|
|
None -> ()
|
|
| Some t ->
|
|
self#man_of_module_type b (Name.father mt.mt_name) t
|
|
);
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b mt.mt_info;
|
|
bs b "\n.sp\n";
|
|
|
|
(* parameters for functors *)
|
|
self#man_of_module_parameter_list b "" (Module.module_type_parameters mt);
|
|
(* a large blank *)
|
|
bs b "\n.sp\n.sp\n";
|
|
|
|
(* module elements *)
|
|
List.iter
|
|
(fun ele ->
|
|
match ele with
|
|
Element_module m ->
|
|
self#man_of_module b m
|
|
| Element_module_type mt ->
|
|
self#man_of_modtype b mt
|
|
| Element_included_module im ->
|
|
self#man_of_included_module b mt.mt_name im
|
|
| Element_class c ->
|
|
self#man_of_class b c
|
|
| Element_class_type ct ->
|
|
self#man_of_class_type b ct
|
|
| Element_value v ->
|
|
self#man_of_value b v
|
|
| Element_exception e ->
|
|
self#man_of_exception b e
|
|
| Element_type t ->
|
|
self#man_of_type b t
|
|
| Element_module_comment text ->
|
|
self#man_of_module_comment b text
|
|
)
|
|
(Module.module_type_elements mt);
|
|
|
|
Buffer.output_buffer chanout b;
|
|
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
|
|
let b = new_buf () in
|
|
bs b ".TH \"";
|
|
bs b Odoc_messages.modul;
|
|
bs b "\" ";
|
|
bs b (m.m_name^" ");
|
|
bs b ("\""^(Odoc_misc.string_of_date ~hour: false date)^"\" ");
|
|
bs b "OCamldoc ";
|
|
bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
|
|
|
|
let abstract =
|
|
match m.m_info with
|
|
None | Some { i_desc = None } -> "no description"
|
|
| Some { i_desc = Some t } ->
|
|
let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in
|
|
self#remove_newlines s
|
|
in
|
|
|
|
bs b ".SH NAME\n";
|
|
bs b (m.m_name^" \\- "^abstract^"\n");
|
|
bs b (".SH "^Odoc_messages.modul^"\n");
|
|
bs b (Odoc_messages.modul^" "^m.m_name^"\n");
|
|
bs b (".SH "^Odoc_messages.documentation^"\n");
|
|
bs b ".sp\n";
|
|
bs b (Odoc_messages.modul^"\n");
|
|
bs b (".BI \""^(Name.simple m.m_name)^"\"\n");
|
|
bs b " : ";
|
|
self#man_of_module_type b (Name.father m.m_name) m.m_type;
|
|
bs b "\n.sp\n";
|
|
self#man_of_info b m.m_info;
|
|
bs b "\n.sp\n";
|
|
|
|
(* parameters for functors *)
|
|
self#man_of_module_parameter_list b "" (Module.module_parameters m);
|
|
(* a large blank *)
|
|
bs b "\n.sp\n.sp\n";
|
|
|
|
(* module elements *)
|
|
List.iter
|
|
(fun ele ->
|
|
match ele with
|
|
Element_module m ->
|
|
self#man_of_module b m
|
|
| Element_module_type mt ->
|
|
self#man_of_modtype b mt
|
|
| Element_included_module im ->
|
|
self#man_of_included_module b m.m_name im
|
|
| Element_class c ->
|
|
self#man_of_class b c
|
|
| Element_class_type ct ->
|
|
self#man_of_class_type b ct
|
|
| Element_value v ->
|
|
self#man_of_value b v
|
|
| Element_exception e ->
|
|
self#man_of_exception b e
|
|
| Element_type t ->
|
|
self#man_of_type b t
|
|
| Element_module_comment text ->
|
|
self#man_of_module_comment b text
|
|
)
|
|
(Module.module_elements m);
|
|
|
|
Buffer.output_buffer chanout b;
|
|
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 _ -> 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
|
|
let b = new_buf () in
|
|
bs b (".TH \""^name^"\" ");
|
|
bs b "man ";
|
|
bs b ("\""^(Odoc_misc.string_of_date ~hour: false date)^"\" ");
|
|
bs b "OCamldoc ";
|
|
bs b ("\""^(match !Args.title with Some t -> t | None -> "")^"\"\n");
|
|
bs b ".SH NAME\n";
|
|
bs b (name^" \\- all "^name^" elements\n\n");
|
|
|
|
let f ele =
|
|
match ele with
|
|
Res_value v ->
|
|
bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father v.val_name)^"\n");
|
|
self#man_of_value b v
|
|
| Res_type t ->
|
|
bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father t.ty_name)^"\n");
|
|
self#man_of_type b t
|
|
| Res_exception e ->
|
|
bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father e.ex_name)^"\n");
|
|
self#man_of_exception b e
|
|
| Res_attribute a ->
|
|
bs b ("\n.SH "^Odoc_messages.clas^" "^(Name.father a.att_value.val_name)^"\n");
|
|
self#man_of_attribute b a
|
|
| Res_method m ->
|
|
bs b ("\n.SH "^Odoc_messages.clas^" "^(Name.father m.met_value.val_name)^"\n");
|
|
self#man_of_method b m
|
|
| Res_class c ->
|
|
bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father c.cl_name)^"\n");
|
|
self#man_of_class b c
|
|
| Res_class_type ct ->
|
|
bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father ct.clt_name)^"\n");
|
|
self#man_of_class_type b ct
|
|
| _ ->
|
|
(* normalement on ne peut pas avoir de module ici. *)
|
|
()
|
|
in
|
|
List.iter f l;
|
|
Buffer.output_buffer chanout b;
|
|
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 ->
|
|
if !Args.man_mini then
|
|
()
|
|
else
|
|
self#generate_for_group l
|
|
in
|
|
List.iter f groups
|
|
end
|