PR#6425: fix generation of man pages, handling variant constructors and record fields

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14902 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 150 insertions, 78 deletions

diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml
index 74f3ae977d..6904a61c7a 100644
--- a/ocamldoc/odoc_man.ml
+++ b/ocamldoc/odoc_man.ml
@@ -806,6 +806,33 @@ 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
+         [] -> ()
+       | 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
+      );
+      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 ";
@@ -940,6 +967,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 =
@@ -977,40 +1040,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_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);
+        self#man_of_module_type_body b mt;
 
         Buffer.output_buffer chanout b;
         close_out chanout
@@ -1020,6 +1050,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 =
@@ -1053,41 +1119,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_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);
-
+        self#man_of_module_body b m;
         Buffer.output_buffer chanout b;
         close_out chanout
 
@@ -1096,7 +1128,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
@@ -1115,7 +1147,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
@@ -1197,7 +1235,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
@@ -1212,7 +1288,7 @@ 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 groups = self#create_groups !man_mini sorted_module_list in
       let f group =
         match group with
           [] ->
@@ -1221,11 +1297,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