summaryrefslogtreecommitdiffstats
path: root/ocamldoc/odoc_man.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ocamldoc/odoc_man.ml')
-rw-r--r--ocamldoc/odoc_man.ml479
1 files changed, 326 insertions, 153 deletions
diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml
index 8a252d631..13733ba8e 100644
--- a/ocamldoc/odoc_man.ml
+++ b/ocamldoc/odoc_man.ml
@@ -15,6 +15,7 @@ open Odoc_info
open Parameter
open Value
open Type
+open Extension
open Exception
open Class
open Module
@@ -281,8 +282,8 @@ class man =
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
+ method man_of_text_element b txt =
+ match txt with
| Odoc_info.Raw s -> bs b (self#escape s)
| Odoc_info.Code s ->
bs b "\n.B ";
@@ -382,8 +383,14 @@ class man =
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
+ method man_of_cstr_args ?par b m_name sep l =
+ let s =
+ match l with
+ | Cstr_tuple l ->
+ Odoc_str.string_of_type_list ?par sep l
+ | Cstr_record l ->
+ Odoc_str.string_of_record 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);
@@ -421,6 +428,74 @@ class man =
self#man_of_info b v.val_info;
bs b "\n.sp\n"
+ (** Print groff string code for a type extension. *)
+ method man_of_type_extension b m_name te =
+ Odoc_info.reset_type_names () ;
+ bs b ".I type ";
+ (
+ match te.te_type_parameters with
+ [] -> ()
+ | l ->
+ let s = Odoc_str.string_of_type_extension_param_list te 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";
+ bs b ".I "
+ );
+ bs b (self#relative_idents m_name te.te_type_name);
+ bs b " \n";
+ bs b "+=";
+ if te.te_private = Asttypes.Private then bs b " private";
+ bs b "\n ";
+ List.iter
+ (fun x ->
+ let father = Name.father x.xt_name in
+ bs b ("| "^(Name.simple x.xt_name));
+ (
+ match x.xt_args, x.xt_ret with
+ | Cstr_tuple [], None -> bs b "\n"
+ | l, None ->
+ bs b "\n.B of ";
+ self#man_of_cstr_args ~par: false b father " * " l;
+ | Cstr_tuple [], Some r ->
+ bs b "\n.B : ";
+ self#man_of_type_expr b father r;
+ | l, Some r ->
+ bs b "\n.B : ";
+ self#man_of_cstr_args ~par: false b father " * " l;
+ bs b ".B -> ";
+ self#man_of_type_expr b father r;
+ );
+ (
+ match x.xt_alias with
+ None -> ()
+ | Some xa ->
+ bs b ".B = ";
+ bs b
+ (
+ match xa.xa_xt with
+ None -> xa.xa_name
+ | Some x -> x.xt_name
+ );
+ bs b "\n"
+ );
+ (
+ match x.xt_text with
+ None ->
+ bs b " "
+ | Some t ->
+ bs b ".I \" \"\n";
+ bs b "(* ";
+ self#man_of_info b (Some t);
+ bs b " *)\n "
+ )
+ )
+ te.te_constructors;
+ bs b "\n.sp\n";
+ self#man_of_info b te.te_info;
+ bs b "\n.sp\n"
+
(** Print groff string code for an exception. *)
method man_of_exception b e =
Odoc_info.reset_type_names () ;
@@ -428,13 +503,23 @@ class man =
bs b (Name.simple e.ex_name);
bs b " \n";
(
- match e.ex_args with
- [] -> ()
- | _ ->
+ match e.ex_args, e.ex_ret with
+ | Cstr_tuple [], None -> ()
+ | l, None ->
bs b ".B of ";
- self#man_of_type_expr_list
+ self#man_of_cstr_args
~par: false
b (Name.father e.ex_name) " * " e.ex_args
+ | Cstr_tuple [], Some r ->
+ bs b ".B : ";
+ self#man_of_type_expr b (Name.father e.ex_name) r
+ | l, Some r ->
+ bs b ".B : ";
+ self#man_of_cstr_args
+ ~par: false
+ b (Name.father e.ex_name) " * " l;
+ bs b ".B -> ";
+ self#man_of_type_expr b (Name.father e.ex_name) r
);
(
match e.ex_alias with
@@ -456,6 +541,13 @@ class man =
method man_of_type b t =
Odoc_info.reset_type_names () ;
let father = Name.father t.ty_name in
+ let field_comment = function
+ | None -> ()
+ | Some t ->
+ bs b " (* ";
+ self#man_of_info b (Some t);
+ bs b " *) "
+ in
bs b ".I type ";
self#man_of_type_expr_param_list b father t;
(
@@ -469,7 +561,18 @@ class man =
(
match t.ty_manifest with
None -> ()
- | Some typ ->
+ | Some (Object_type l) ->
+ bs b "= ";
+ if priv then bs b "private ";
+ bs b "<";
+ List.iter (fun r ->
+ bs b (r.of_name^" : ");
+ self#man_of_type_expr b father r.of_type;
+ bs b ";";
+ field_comment r.of_text ;
+ ) l;
+ bs b "\n >\n"
+ | Some (Other typ) ->
bs b "= ";
if priv then bs b "private ";
self#man_of_type_expr b father typ
@@ -478,80 +581,68 @@ class man =
match t.ty_kind with
Type_abstract -> ()
| Type_variant l ->
- 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,constr.vc_ret with
- | [], None, None -> bs b "\n "
- | [], (Some t), None ->
- bs b " (*\n";
- self#man_of_info b (Some t);
- bs b "*)\n "
- | l, None, None ->
- bs b "\n.B of ";
- self#man_of_type_expr_list ~par: false b father " * " l;
- bs b " "
- | l, (Some t), None ->
- bs b "\n.B of ";
- self#man_of_type_expr_list ~par: false b father " * " l;
- bs b ".I \" \"\n";
- bs b "(*\n";
- self#man_of_info b (Some t);
- bs b "*)\n"
- | [], None, Some r ->
- bs b "\n.B : ";
- self#man_of_type_expr b father r;
- bs b " "
- | [], (Some t), Some r ->
- bs b "\n.B : ";
- self#man_of_type_expr b father r;
- bs b ".I \" \"\n";
- bs b "(*\n";
- self#man_of_info b (Some t);
- bs b "*)\n "
- | l, None, Some r ->
- bs b "\n.B : ";
- self#man_of_type_expr_list ~par: false b father " * " l;
- bs b ".B -> ";
- self#man_of_type_expr b father r;
- bs b " "
- | l, (Some t), Some r ->
- bs b "\n.B of ";
- self#man_of_type_expr_list ~par: false b father " * " l;
- bs b ".B -> ";
- self#man_of_type_expr b father r;
- bs b ".I \" \"\n";
- bs b "(*\n";
- self#man_of_info b (Some t);
- bs b "*)\n "
- )
- )
- l
+ bs b "=";
+ if priv then bs b " private";
+ bs b "\n ";
+ List.iter (fun constr ->
+ bs b ("| "^constr.vc_name);
+ let print_text t =
+ bs b " (* ";
+ self#man_of_info b (Some t);
+ bs b " *)\n "
+ in
+ match constr.vc_args, constr.vc_text,constr.vc_ret with
+ | Cstr_tuple [], None, None -> bs b "\n "
+ | Cstr_tuple [], (Some t), None ->
+ print_text t
+ | l, None, None ->
+ bs b "\n.B of ";
+ self#man_of_cstr_args ~par: false b father " * " l;
+ bs b " "
+ | l, (Some t), None ->
+ bs b "\n.B of ";
+ self#man_of_cstr_args ~par: false b father " * " l;
+ bs b ".I \" \"\n";
+ print_text t
+ | Cstr_tuple [], None, Some r ->
+ bs b "\n.B : ";
+ self#man_of_type_expr b father r;
+ bs b " "
+ | Cstr_tuple [], (Some t), Some r ->
+ bs b "\n.B : ";
+ self#man_of_type_expr b father r;
+ bs b ".I \" \"\n";
+ print_text t
+ | l, None, Some r ->
+ bs b "\n.B : ";
+ self#man_of_cstr_args ~par: false b father " * " l;
+ bs b ".B -> ";
+ self#man_of_type_expr b father r;
+ bs b " "
+ | l, (Some t), Some r ->
+ bs b "\n.B of ";
+ self#man_of_cstr_args ~par: false b father " * " l;
+ bs b ".B -> ";
+ self#man_of_type_expr b father r;
+ bs b ".I \" \"\n";
+ print_text t
+ ) l
+
| Type_record l ->
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 " (*\n";
- self#man_of_info b (Some t);
- bs b "*) "
- );
- )
- l;
+ 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 ";";
+ field_comment r.rf_text ;
+ ) l;
bs b "\n }\n"
+ | Type_open ->
+ bs b "= ..";
+ bs b "\n"
);
bs b "\n.sp\n";
self#man_of_info b t.ty_info;
@@ -724,6 +815,34 @@ class man =
self#man_of_text b [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")];
bs b "\n.PP\n"
+ method man_of_recfield b modname f =
+ bs b ".I ";
+ if f.rf_mutable then bs b (Odoc_messages.mutab^" ");
+ bs b (f.rf_name^" : ");
+ self#man_of_type_expr b modname f.rf_type;
+ bs b "\n.sp\n";
+ self#man_of_info b f.rf_text;
+ bs b "\n.sp\n"
+
+ method man_of_const b modname c =
+ bs b ".I ";
+ bs b (c.vc_name^" ");
+ (match c.vc_args with
+ | Cstr_tuple [] -> ()
+ | Cstr_tuple (h::q) ->
+ bs b "of ";
+ self#man_of_type_expr b modname h;
+ List.iter
+ (fun ty ->
+ bs b " * ";
+ self#man_of_type_expr b modname ty)
+ q
+ | Cstr_record _ -> bs b "{ ... }"
+ );
+ bs b "\n.sp\n";
+ self#man_of_info b c.vc_text;
+ bs b "\n.sp\n"
+
(** Print groff string for an included module. *)
method man_of_included_module b m_name im =
bs b ".I include ";
@@ -858,6 +977,42 @@ class man =
incr Odoc_info.errors ;
prerr_endline s
+ method man_of_module_type_body b mt =
+ 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_type_extension te ->
+ self#man_of_type_extension b mt.mt_name te
+ | 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);
+
(** Generate the man file for the given module type.
@raise Failure if an error occurs.*)
method generate_for_module_type mt =
@@ -895,38 +1050,7 @@ class man =
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);
+ self#man_of_module_type_body b mt;
Buffer.output_buffer chanout b;
close_out chanout
@@ -936,6 +1060,42 @@ class man =
incr Odoc_info.errors ;
prerr_endline s
+ method man_of_module_body b m =
+ 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_type_extension te ->
+ self#man_of_type_extension b m.m_name te
+ | 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);
+
(** Generate the man file for the given module.
@raise Failure if an error occurs.*)
method generate_for_module m =
@@ -969,39 +1129,7 @@ class man =
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);
-
+ self#man_of_module_body b m;
Buffer.output_buffer chanout b;
close_out chanout
@@ -1010,7 +1138,7 @@ class man =
raise (Failure s)
(** Create the groups of elements to generate pages for. *)
- method create_groups module_list =
+ method create_groups mini module_list =
let name res_ele =
match res_ele with
Res_module m -> m.m_name
@@ -1019,6 +1147,7 @@ class man =
| Res_class_type ct -> ct.clt_name
| Res_value v -> Name.simple v.val_name
| Res_type t -> Name.simple t.ty_name
+ | Res_extension x -> Name.simple x.xt_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
@@ -1028,7 +1157,13 @@ class man =
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)
+ (fun r ->
+ match r with
+ Res_section _ -> false
+ | Res_module _ | Res_module_type _
+ | Res_class _ | Res_class_type _ -> true
+ | _ -> not mini
+ )
all_items_pre
in
let sorted_items = List.sort (fun e1 -> fun e2 -> compare (name e1) (name e2)) all_items in
@@ -1062,6 +1197,7 @@ class man =
| Res_class_type ct -> ct.clt_name
| Res_value v -> v.val_name
| Res_type t -> t.ty_name
+ | Res_extension x -> x.xt_name
| Res_exception e -> e.ex_name
| Res_attribute a -> a.att_value.val_name
| Res_method m -> m.met_value.val_name
@@ -1091,6 +1227,9 @@ class man =
| Res_type t ->
bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father t.ty_name)^"\n");
self#man_of_type b t
+ | Res_extension x ->
+ bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father x.xt_name)^"\n");
+ self#man_of_type_extension b (Name.father x.xt_name) x.xt_type_extension
| Res_exception e ->
bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father e.ex_name)^"\n");
self#man_of_exception b e
@@ -1106,7 +1245,45 @@ class man =
| Res_class_type ct ->
bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father ct.clt_name)^"\n");
self#man_of_class_type b ct
- | _ ->
+ | Res_recfield (ty,f) ->
+ bs b ("\n.SH Type "^(ty.ty_name)^"\n");
+ self#man_of_recfield b (Name.father ty.ty_name) f
+ | Res_const (ty,c) ->
+ bs b ("\n.SH Type "^(ty.ty_name)^"\n");
+ self#man_of_const b (Name.father ty.ty_name) c
+ | Res_module m ->
+ if Name.father m.m_name <> "" then
+ begin
+ bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father m.m_name)^"\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;
+ end
+ else
+ begin
+ bs b ("\n.SH "^Odoc_messages.modul^" "^m.m_name^"\n");
+ bs b " : ";
+ self#man_of_module_type b (Name.father m.m_name) m.m_type;
+ end;
+ bs b "\n.sp\n";
+ self#man_of_module_body b m
+
+ | Res_module_type mt ->
+ bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father mt.mt_name)^"\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_module_type_body b mt
+
+ | Res_section _ ->
(* normalement on ne peut pas avoir de module ici. *)
()
in
@@ -1120,8 +1297,8 @@ class man =
(** 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 sorted_module_list = List.sort (fun m1 m2 -> compare m1.m_name m2.m_name) module_list in
+ let groups = self#create_groups !man_mini sorted_module_list in
let f group =
match group with
[] ->
@@ -1130,11 +1307,7 @@ class man =
| [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 !man_mini then
- ()
- else
- self#generate_for_group l
+ | l -> self#generate_for_group l
in
List.iter f groups
end
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-21 07:40:51 +0000