OK - generate html from module_kind rather than from module_type

OK   + same for classes and class types
OK - fix: class parameters are no correctly displayed in latex


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

4 files changed, 135 insertions, 55 deletions

diff --git a/ocamldoc/Changes.txt b/ocamldoc/Changes.txt
index c04041f59..4faea1085 100644
--- a/ocamldoc/Changes.txt
+++ b/ocamldoc/Changes.txt
@@ -1,4 +1,7 @@
 Current :
+OK - generate html from module_kind rather than from module_type
+OK   + same for classes and class types
+OK - add the kind to module parameters (the way the parameter was build in the parsetree)
 OK - fix: the generated ocamldoc.sty is more robust for paragraphs in
      ocamldocdescription environment
 OK - fix: when generating separated files in latex, generate them in
@@ -48,12 +51,9 @@ OK - fix: bad display of type parameters for class and class types
 
 TODO:
  - need to fix display of type parameters for inherited classes/class types
-OK - add the kind to module parameters (the way the parameter was build in the parsetree)
- - generate html from module_kind rather than from module_type
-   + pareil pour les classes et class types 
-OK + utilisation de blocs div pour indenter
- - latex: style latex pour indenter dans les module kind
-
+ - latex: style latex pour indenter dans les module kind et les class kind
+OK - latex: il manque la génération des paramètres de classe
+ - latex: types variant polymorphes dépassent de la page quand ils sont trop longs
 
 ======
 
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index 253ccc739..fda03a08d 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -1162,6 +1162,8 @@ module Analyser =
           )
 
       | Parsetree.Pstr_recmodule mods ->
+	  (* A VOIR ICI ca merde avec /work/tmp/graph.ml: pas de lien avec les module type 
+	     dans les contraintes sur les modules *)
 	  let new_env =
             List.fold_left 
               (fun acc_env (name, _, mod_exp) ->
@@ -1383,7 +1385,10 @@ module Analyser =
       let complete_name = Name.concat current_module_name module_name in
       let pos_start = p_module_expr.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in
       let pos_end = p_module_expr.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in
-      let modtype = tt_module_expr.Typedtree.mod_type in
+      let modtype = 
+        (* A VOIR : Odoc_env.subst_module_type env  ? *)
+	tt_module_expr.Typedtree.mod_type 
+      in
       let m_code_intf =
 	match p_module_expr.Parsetree.pmod_desc with
 	  Parsetree.Pmod_constraint (_, pmodule_type) ->
@@ -1396,7 +1401,7 @@ module Analyser =
       let m_base =
         {
           m_name = complete_name ;
-          m_type = tt_module_expr.Typedtree.mod_type ;
+          m_type = modtype ;
           m_info = comment_opt ;
           m_is_interface = false ;
           m_file = !file_name ;
@@ -1438,8 +1443,8 @@ module Analyser =
 	       mp_kind = mp_kind ;
              } 
            in
+           let dummy_complete_name = (*Name.concat "__"*) param.mp_name in
 	   (* TODO: A VOIR CE __ *)
-           let dummy_complete_name = Name.concat "__" param.mp_name in
            let new_env = Odoc_env.add_module env dummy_complete_name in
            let m_base2 = analyse_module 
                new_env
@@ -1479,6 +1484,8 @@ module Analyser =
 
       | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype), 
          Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _)) ->
+	  print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name);
+
           (* we create the module with p_module_expr2 and tt_module_expr2 
              but we change its type according to the constraint. 
              A VOIR : est-ce que c'est bien ?
@@ -1498,7 +1505,7 @@ module Analyser =
           in
           { 
             m_base with
-            m_type = tt_modtype ; 
+            m_type = Odoc_env.subst_module_type env tt_modtype ; 
             m_kind = Module_constraint (m_base2.m_kind, 
                                         mtkind)
 
@@ -1513,11 +1520,16 @@ module Analyser =
 	    tt_modtype, _)
 	) ->
 	  (* needed for recursive modules *)
+
+	  print_DEBUG ("Odoc_ast: case Parsetree.Pmod_structure + Typedtree.Tmod_constraint "^module_name);
 	  let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in
           (* we must complete the included modules *)
           let included_modules_from_tt = tt_get_included_module_list tt_structure in
           let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
-          { m_base with m_kind = Module_struct elements2 }
+          { m_base with 
+	    m_type = Odoc_env.subst_module_type env tt_modtype ;
+	    m_kind = Module_struct elements2 ;
+	  }
 
       | (parsetree, typedtree) ->
           let s_parse = 
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index fa368e446..9603daf0f 100644
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -993,14 +993,6 @@ class html =
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
 
-    (** Print html code to display a [Types.class_type].*)
-    method html_of_class_type_expr b m_name t =
-      let s = remove_last_newline (Odoc_info.string_of_class_type t) in
-      let s2 = newline_to_indented_br s in
-      bs b "<code class=\"type\">";
-      bs b (self#create_fully_qualified_idents_links m_name s2);
-      bs b "</code>"
-
     (** Print html code to display a [Types.type_expr list]. *)
     method html_of_type_expr_list ?par b m_name sep l =
       print_DEBUG "html#html_of_type_expr_list";
@@ -1017,9 +1009,9 @@ class html =
     method html_of_class_type_param_expr_list b m_name l =
       let s = Odoc_info.string_of_class_type_param_list l in
       let s2 = newline_to_indented_br s in
-      bs b "<code class=\"type\">";
+      bs b "<code class=\"type\">[";
       bs b (self#create_fully_qualified_idents_links m_name s2);
-      bs b "</code>"
+      bs b "]</code>"
 
     (** Print html code to display a list of type parameters for the given type.*)
     method html_of_type_expr_param_list b m_name t =
@@ -1049,7 +1041,7 @@ class html =
 	       bs b "</div>"
 	   | Some m ->
 	       let (html_file, _) = Naming.html_files m.m_name in
-	       bp b " <a href=\"%s\">..</a> " html_file	       
+	       bp b " <a href=\"%s\">..</a> " html_file
 	  );
 	  self#html_of_text b [Code "end"]
       | Module_alias a ->
@@ -1159,7 +1151,6 @@ class html =
       let s = remove_last_newline(Odoc_info.string_of_class_type ~complete: true ctyp) in
       self#output_code in_title file s
 
-
     (** Print html code for a value. *)
     method html_of_value b v =
       Odoc_info.reset_type_names ();
@@ -1590,6 +1581,99 @@ class html =
       bs b "</pre>\n";
       self#html_of_info b im.im_info
 
+    method html_of_class_element b element =
+      match element with
+        Class_attribute a ->
+          self#html_of_attribute b a
+      | Class_method m ->
+          self#html_of_method b m
+      | Class_comment t ->
+          self#html_of_class_comment b t
+
+    method html_of_class_kind b father ?cl kind =
+      match kind with
+        Class_structure (inh, eles) -> 
+	  self#html_of_text b [Code "object"];
+	  (
+	   match cl with
+	     None ->
+	       bs b "\n";
+	       (
+		match inh with
+		  [] -> ()
+		| _ -> 
+		    self#generate_inheritance_info b inh
+	       );
+	       List.iter (self#html_of_class_element b) eles;
+	   | Some cl ->
+	       let (html_file, _) = Naming.html_files cl.cl_name in
+	       bp b " <a href=\"%s\">..</a> " html_file
+	  );
+	  self#html_of_text b [Code "end"]
+
+      | Class_apply capp ->
+	  (* TODO: afficher le type final à partir du typedtree *)
+	  self#html_of_text b [Raw "class application not handled yet"]
+            
+      | Class_constr cco ->
+	  (
+           match cco.cco_type_parameters with
+             [] -> ()
+           | l -> 
+               self#html_of_class_type_param_expr_list b father l;
+	       bs b " "
+	  );
+	  self#html_of_text b
+	    [Code (self#create_fully_qualified_idents_links father cco.cco_name)]
+
+      | Class_constraint (ck, ctk) ->
+          self#html_of_text b [Code "( "] ;
+          self#html_of_class_kind b father ck;
+          self#html_of_text b [Code " : "] ;
+          self#html_of_class_type_kind b father ctk;
+          self#html_of_text b [Code " )"]
+
+    method html_of_class_type_kind b father ?ct kind =
+      match kind with
+        Class_type cta -> 
+          (
+           match cta.cta_type_parameters with
+             [] -> ()
+           | l -> 
+	       self#html_of_class_type_param_expr_list b father l;
+	       bs b " "
+          );
+          self#html_of_text b
+	    [Code (self#create_fully_qualified_idents_links father cta.cta_name)]
+
+      | Class_signature (inh, eles) -> 
+	  self#html_of_text b [Code "object"];
+	  (
+	   match ct with
+	     None ->
+	       bs b "\n";
+	       (
+		match inh with
+		  [] -> ()
+		| _ -> self#generate_inheritance_info b inh
+	       );
+	       List.iter (self#html_of_class_element b) eles
+	   | Some ct ->
+	       let (html_file, _) = Naming.html_files ct.clt_name in
+	       bp b " <a href=\"%s\">..</a> " html_file
+	  );
+	  self#html_of_text b [Code "end"]
+
+    method html_of_class_parameter b father p =
+      self#html_of_type_expr b father (Parameter.typ p)
+
+    method html_of_class_parameter_list b father params =
+      List.iter
+	(fun p -> 
+	  self#html_of_class_parameter b father p;
+	  bs b " -&gt; ")
+	params
+
     (** Print html code for a class. *)
     method html_of_class b ?(complete=true) ?(with_link=true) c =
       let father = Name.father c.cl_name in
@@ -1626,7 +1710,8 @@ class html =
       );
 
       bs b " : " ;
-      self#html_of_class_type_expr b father c.cl_type;
+      self#html_of_class_parameter_list b father c.cl_parameters ;
+      self#html_of_class_kind b father ~cl: c c.cl_kind;
       bs b "</pre>" ;
       print_DEBUG "html#html_of_class : info" ;
       (
@@ -1669,7 +1754,7 @@ class html =
         bs b (Name.simple ct.clt_name);
 
       bs b " = ";
-      self#html_of_class_type_expr b father ct.clt_type;
+      self#html_of_class_type_kind b father ~ct ct.clt_kind;
       bs b "</pre>";
       (
        if complete then 
@@ -1872,16 +1957,7 @@ class html =
         (* a horizontal line *)
         bs b "<hr width=\"100%\">\n";
         (* the various elements *)
-        List.iter 
-          (fun element ->
-            match element with
-              Class_attribute a ->
-                self#html_of_attribute b a
-            | Class_method m ->
-                self#html_of_method b m
-            | Class_comment t ->
-                self#html_of_class_comment b t
-          )
+        List.iter (self#html_of_class_element b)
           (Class.class_elements ~trans:false cl);
         bs b "</body></html>";
 	Buffer.output_buffer chanout b;
@@ -1926,16 +2002,7 @@ class html =
         (* a horizontal line *)
         bs b "<hr width=\"100%\">\n";
         (* the various elements *)
-        List.iter 
-          (fun element ->
-            match element with
-              Class_attribute a ->
-                self#html_of_attribute b a
-            | Class_method m ->
-                self#html_of_method b m
-            | Class_comment t ->
-                self#html_of_class_comment b t
-          )
+        List.iter (self#html_of_class_element b)
           (Class.class_type_elements ~trans: false clt);
         bs b "</body></html>";
 	Buffer.output_buffer chanout b;
diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml
index ebd51a96d..786581ddc 100644
--- a/ocamldoc/odoc_latex.ml
+++ b/ocamldoc/odoc_latex.ml
@@ -631,6 +631,15 @@ class latex =
 	  (* TODO: on affiche quoi ? *)
 	  self#latex_of_module_kind fmt father k
 
+    method latex_of_class_parameter fmt father p =
+      ps fmt (self#normal_type father (Parameter.typ p))
+
+    method latex_of_class_parameter_list fmt father params =
+      List.iter
+	(fun p -> 
+	  self#latex_of_class_parameter fmt father p;
+	  ps fmt " -> ")
+	params
 
     method latex_of_class_kind fmt father kind =
       match kind with
@@ -641,7 +650,7 @@ class latex =
 	  self#latex_of_text fmt [Code "end"]
 
       | Class_apply capp ->
-	  (* TODO: afficher le type final à partirdu typedtree *)
+	  (* TODO: afficher le type final à partir du typedtree *)
 	  self#latex_of_text fmt [Raw "class application not handled yet"]
             
       | Class_constr cco ->
@@ -866,7 +875,7 @@ class latex =
 	] 
       in
       self#latex_of_text fmt t;
-
+      self#latex_of_class_parameter_list fmt father c.cl_parameters;
       self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
       self#latex_for_class_label fmt c;
       self#latex_for_class_index fmt c;
@@ -987,14 +996,6 @@ class latex =
       | Class_type _ ->
           ()
 
-    (** Generate the LaTeX code for the given class, in the given buffer. *)
-    method generate_for_class fmt c =
-      self#generate_class_inheritance_info fmt c
-
-    (** Generate the LaTeX code for the given class type, in the given buffer. *)
-    method generate_for_class_type fmt ct =
-      self#generate_class_type_inheritance_info fmt ct
-
     (** Generate the LaTeX code for the given top module, in the given buffer. *)
     method generate_for_top_module fmt m =
       let (first_t, rest_t) = self#first_and_rest_of_info m.m_info in