1 files changed, 41 insertions, 5 deletions

diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml
index 485c626607..4eaf0cabe2 100644
--- a/ocamldoc/odoc_misc.ml
+++ b/ocamldoc/odoc_misc.ml
@@ -70,15 +70,51 @@ let string_of_type_list sep type_list =
       Format.fprintf Format.str_formatter "@]"
   end;
   Format.flush_str_formatter()
-    
-let string_of_module_type t =
-  Printtyp.modtype Format.str_formatter t;
+
+(** Return the given module type where methods and vals have been removed
+   from the signatures. Used when we don't want to print a too long module type.*)
+let simpl_module_type t =
+  let rec iter t =
+    match t with
+      Types.Tmty_ident p -> t
+    | Types.Tmty_signature _ -> Types.Tmty_signature []
+    | Types.Tmty_functor (id, mt1, mt2) ->
+	Types.Tmty_functor (id, iter mt1, iter mt2)
+  in
+  iter t
+
+let string_of_module_type ?(complete=false) t =
+  let t2 = if complete then t else simpl_module_type t in
+  Printtyp.modtype Format.str_formatter t2;
   let s = Format.flush_str_formatter () in
   s
 
-let string_of_class_type t = 
+
+(** Return the given class type where methods and vals have been removed
+   from the signatures. Used when we don't want to print a too long class type.*)
+let simpl_class_type t =
+  let rec iter t =
+    match t with
+      Types.Tcty_constr (p,texp_list,ct) -> t
+    | Types.Tcty_signature cs ->
+	(* on vire les vals et methods pour ne pas qu'elles soient imprimées
+	   quand on affichera le type *)
+	let tnil = { Types.desc = Types.Tnil ; Types.level = 0; Types.id = 0 } in
+	Types.Tcty_signature { Types.cty_self = { cs.Types.cty_self with 
+						  Types.desc = Types.Tobject (tnil, ref None) };
+			       Types.cty_vars = Types.Vars.empty ;
+			       Types.cty_concr = Types.Concr.empty ;
+			     }
+    | Types.Tcty_fun (l, texp, ct) ->
+	let new_ct = iter ct in
+	Types.Tcty_fun (l, texp, new_ct)
+  in
+  iter t
+
+let string_of_class_type ?(complete=false) t = 
+  let t2 = if complete then t else simpl_class_type t in
   (* A VOIR : ma propre version de Printtyp.class_type pour ne pas faire reset_names *)
-  Printtyp.class_type Format.str_formatter t;
+  Printtyp.class_type Format.str_formatter t2;
   let s = Format.flush_str_formatter () in
   s