add some custom html generators

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

3 files changed, 432 insertions, 0 deletions

diff --git a/ocamldoc/generators/.gitignore b/ocamldoc/generators/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/ocamldoc/generators/.gitignore
+++ /dev/null
diff --git a/ocamldoc/generators/odoc_literate.ml b/ocamldoc/generators/odoc_literate.ml
new file mode 100644
index 0000000000..e79b4f1a21
--- /dev/null
+++ b/ocamldoc/generators/odoc_literate.ml
@@ -0,0 +1,207 @@
+(***********************************************************************)
+(*                             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: odoc_literate.ml,v 1.1 2008/02/28 11:09:33 guesdon Exp $ *)
+
+open Odoc_info
+module Naming = Odoc_html.Naming
+open Odoc_info.Value
+open Odoc_info.Module
+
+let p = Printf.bprintf
+let bp = Printf.bprintf
+let bs = Buffer.add_string
+
+module Html =
+  (val
+   (
+   match !Odoc_args.current_generator with
+     None -> (module Odoc_html.Generator : Odoc_html.Html_generator)
+   | Some (Odoc_gen.Html m) -> m
+   | _ ->
+       failwith
+         "A non-html generator is already set. Cannot install the Todo-list html generator"
+  ) : Odoc_html.Html_generator)
+;;
+
+module Generator =
+struct
+class html =
+  object (self)
+    inherit Html.html as html
+
+    method private html_of_module_comment b text =
+      let br1, br2 =
+        match text with
+          [(Odoc_info.Title (n, l_opt, t))] -> false, false
+        | (Odoc_info.Title (n, l_opt, t)) :: _ -> false, true
+        | _ -> true, true
+      in
+      if br1 then p b "<br/>";
+      self#html_of_text b text;
+      if br2 then p b "<br/><br/>\n"
+
+    method private html_of_Title b n l_opt t =
+      let label1 = self#create_title_label (n, l_opt, t) in
+      p b "<a name=\"%s\"></a>\n" (Naming.label_target label1);
+      p b "<h%d>" n;
+      self#html_of_text b t;
+      p b "</h%d>" n
+
+    val mutable code_id = 0
+    method private code_block b code =
+      code_id <- code_id + 1;
+      Printf.bprintf b
+      "<span class=\"code_expand\" onclick=\"if(document.getElementById('code%d').style.display=='none') {document.getElementById('code%d').style.display='block';} else {document.getElementById('code%d').style.display='none';}\"><img src=\"expand_collapse.png\" alt=\"+/-\"/></span>" code_id code_id code_id;
+      Printf.bprintf b "<div id=\"code%d\" class=\"codeblock\">" code_id;
+      self#html_of_code b code;
+      Printf.bprintf b "</div>"
+
+    (** Print html code for a value. *)
+    method private html_of_value b v =
+      Odoc_info.reset_type_names ();
+      self#html_of_info b v.val_info;
+      bs b "<pre>";
+      bs b (self#keyword "val");
+      bs b " ";
+      (* html mark *)
+      bp b "<a name=\"%s\"></a>" (Naming.value_target v);
+      bs b (self#escape (Name.simple v.val_name));
+      bs b " : ";
+      self#html_of_type_expr b (Name.father v.val_name) v.val_type;
+      bs b "</pre>";
+      (
+       if !Odoc_html.with_parameter_list then
+         self#html_of_parameter_list b (Name.father v.val_name) v.val_parameters
+       else
+         self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters
+      );
+      (
+       match v.val_code with
+         None -> ()
+       | Some code ->
+           self#code_block b code
+      )
+(*
+    (** Print html code for a module. *)
+    method private html_of_module b ?(info=true) ?(complete=true) ?(with_link=true) m =
+      let (html_file, _) = Naming.html_files m.m_name in
+      let father = Name.father m.m_name in
+      bs b "<pre>";
+      bs b ((self#keyword "module")^" ");
+      (
+       if with_link then
+         bp b "<a href=\"%s\">%s</a>" html_file (Name.simple m.m_name)
+       else
+         bs b (Name.simple m.m_name)
+      );
+(*      A remettre quand on compilera avec ocaml 3.10
+         (
+       match m.m_kind with
+         Module_functor _ when !Odoc_info.Args.html_short_functors  ->
+           ()
+
+       | _ -> *) bs b ": ";
+      (*
+      );
+      *)
+      self#html_of_module_kind b father ~modu: m m.m_kind;
+      bs b "</pre>";
+      if info && complete then
+        self#html_of_info ~indent: false b m.m_info
+
+*)
+    initializer
+      default_style_options <-
+        ["a:visited {color : #416DFF; text-decoration : none; }" ;
+          "a:link {color : #416DFF; text-decoration : none;}" ;
+          "a:hover {color : Red; text-decoration : none; background-color: #5FFF88}" ;
+          "a:active {color : Red; text-decoration : underline; }" ;
+          ".keyword { font-weight : bold ; color : Red }" ;
+          ".keywordsign { color : #C04600 }" ;
+          ".superscript { font-size : 4 }" ;
+          ".subscript { font-size : 4 }" ;
+          ".comment { color : Green }" ;
+          ".constructor { color : Blue }" ;
+          ".type { color : #5C6585 }" ;
+          ".string { color : Maroon }" ;
+          ".warning { color : Red ; font-weight : bold }" ;
+          ".info { margin-top: 8px; }";
+          ".param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }" ;
+          ".code { color : #465F91 ; }" ;
+          "h1 { font-size : 20pt ; text-align: center; }" ;
+
+          "h2 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #90BDFF ;"^
+            "padding: 2px; }" ;
+
+          "h3 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #90DDFF ;"^
+            "padding: 2px; }" ;
+
+          "h4 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #90EDFF ;"^
+            "padding: 2px; }" ;
+
+          "h5 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #90FDFF ;"^
+            "padding: 2px; }" ;
+
+          "h6 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #C0FFFF ; "^
+            "padding: 2px; }" ;
+
+          "div.h7 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #E0FFFF ; "^
+            "padding: 2px; }" ;
+
+          "div.h8 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #F0FFFF ; "^
+            "padding: 2px; }" ;
+
+          "div.h9 { font-size : 20pt ; border: 1px solid #000000; "^
+            "margin-top: 5px; margin-bottom: 2px;"^
+            "text-align: center; background-color: #FFFFFF ; "^
+            "padding: 2px; }" ;
+
+          ".typetable { border-style : hidden }" ;
+          ".indextable { border-style : hidden }" ;
+          ".paramstable { border-style : hidden ; padding: 5pt 5pt}" ;
+          "body { background-color : White }" ;
+          "tr { background-color : White }" ;
+          "td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}" ;
+          "pre { margin-bottom: 4px ; margin-left: 1em; "^
+            "border-color: #27408b; border-style: solid; "^
+            "border-width: 1px 1px 1px 3px; "^
+            "padding: 4px; }" ;
+          "div.sig_block {margin-left: 2em}" ;
+
+          "div.codeblock { "^
+            "margin-left: 2em; margin-right: 1em; padding: 6px; "^
+            "margin-bottom: 8px; display: none; "^
+            "border-width: 1px 1px 1px 3px; border-style: solid; border-color: grey; }" ;
+
+          "span.code_expand { color: blue; text-decoration: underline; cursor: pointer; "^
+          "margin-left: 1em ; } ";
+        ];
+  end
+end
+
+let _ = Odoc_args.set_generator
+ (Odoc_gen.Html (module Generator : Odoc_html.Html_generator))
+ ;;
diff --git a/ocamldoc/generators/odoc_todo.ml b/ocamldoc/generators/odoc_todo.ml
new file mode 100644
index 0000000000..23e6c8892d
--- /dev/null
+++ b/ocamldoc/generators/odoc_todo.ml
@@ -0,0 +1,225 @@
+(***********************************************************************)
+(*                             OCamldoc                                *)
+(*                                                                     *)
+(*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
+(*                                                                     *)
+(*  Copyright 2010 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: odoc_todo.ml 411 2004-08-03 13:08:20Z guesdon $ *)
+
+(** An OCamldoc generator to retrieve information in "todo" tags and
+   generate an html page with all todo items. *)
+
+open Odoc_info
+module Naming = Odoc_html.Naming
+open Odoc_info.Value
+open Odoc_info.Module
+open Odoc_info.Type
+open Odoc_info.Exception
+open Odoc_info.Class
+
+let p = Printf.bprintf
+
+module Html =
+  (val
+   (
+   match !Odoc_args.current_generator with
+     None -> (module Odoc_html.Generator : Odoc_html.Html_generator)
+   | Some (Odoc_gen.Html m) -> m
+   | _ ->
+       failwith
+         "A non-html generator is already set. Cannot install the Todo-list html generator"
+  ) : Odoc_html.Html_generator)
+;;
+
+module Generator =
+struct
+  class scanner html =
+    object (self)
+      inherit Odoc_info.Scan.scanner
+
+    val b = Buffer.create 256
+    method buffer = b
+
+    method private gen_if_tag name target info_opt =
+      match info_opt with
+        None -> ()
+      |	Some i ->
+          let l =
+            List.fold_left
+              (fun acc (t, text) ->
+                 match t with
+                   "todo" ->
+                     begin
+                       match text with
+                         (Odoc_info.Code s) :: q ->
+                           (
+                            try
+                              let n = int_of_string s in
+                              let head =
+                                Odoc_info.Code (Printf.sprintf "[%d] " n)
+                              in
+                              (Some n, head::q) :: acc
+                            with _ -> (None, text) :: acc
+                           )
+                       | _ -> (None, text) :: acc
+
+                     end
+                 |	_ -> acc
+              )
+              []
+              i.i_custom
+          in
+          match l with
+            [] -> ()
+          | _ ->
+              let l = List.sort
+                (fun a b ->
+                   match a, b with
+                     (None, _), _ -> -1
+                   | _, (None, _) -> 1
+                   | (Some n1, _), (Some n2, _) -> compare n1 n2
+                )
+                l
+              in
+              p b "<pre><a href=\"%s\">%s</a></pre><div class=\"info\">"
+                target name;
+              let col = function
+                None -> "#000000"
+              | Some 1 -> "#FF0000"
+              | Some 2 -> "#AA5555"
+              | Some 3 -> "#44BB00"
+              | Some n -> Printf.sprintf "#%2x0000" (0xAA - (n * 0x10))
+              in
+              List.iter
+                (fun (n, e) ->
+                   Printf.bprintf b "<span style=\"color: %s\">" (col n);
+                   html#html_of_text b e;
+                   p b "</span><br/>\n";
+                )
+                l;
+              p b "</div>"
+
+    method scan_value v =
+      self#gen_if_tag
+        v.val_name
+        (Odoc_html.Naming.complete_value_target v)
+        v.val_info
+
+    method scan_type t =
+      self#gen_if_tag
+        t.ty_name
+        (Odoc_html.Naming.complete_type_target t)
+        t.ty_info
+
+    method scan_exception e =
+      self#gen_if_tag
+        e.ex_name
+        (Odoc_html.Naming.complete_exception_target e)
+        e.ex_info
+
+    method scan_attribute a =
+      self#gen_if_tag
+        a.att_value.val_name
+        (Odoc_html.Naming.complete_attribute_target a)
+        a.att_value.val_info
+
+    method scan_method m =
+      self#gen_if_tag
+        m.met_value.val_name
+        (Odoc_html.Naming.complete_method_target m)
+        m.met_value.val_info
+
+   (** This method scan the elements of the given module. *)
+    method scan_module_elements m =
+      List.iter
+        (fun ele ->
+          match ele with
+            Odoc_module.Element_module m -> self#scan_module m
+          | Odoc_module.Element_module_type mt -> self#scan_module_type mt
+          | Odoc_module.Element_included_module im -> self#scan_included_module im
+          | Odoc_module.Element_class c -> self#scan_class c
+          | Odoc_module.Element_class_type ct -> self#scan_class_type ct
+          | Odoc_module.Element_value v -> self#scan_value v
+          | Odoc_module.Element_exception e -> self#scan_exception e
+          | Odoc_module.Element_type t -> self#scan_type t
+          | Odoc_module.Element_module_comment t -> self#scan_module_comment t
+        )
+        (Odoc_module.module_elements ~trans: false m)
+
+    method scan_included_module _ = ()
+
+    method scan_class_pre c =
+      self#gen_if_tag
+        c.cl_name
+        (fst (Odoc_html.Naming.html_files c.cl_name))
+        c.cl_info;
+      true
+
+    method scan_class_type_pre ct =
+      self#gen_if_tag
+        ct.clt_name
+        (fst (Odoc_html.Naming.html_files ct.clt_name))
+        ct.clt_info;
+      true
+
+    method scan_module_pre m =
+      self#gen_if_tag
+        m.m_name
+        (fst (Odoc_html.Naming.html_files m.m_name))
+        m.m_info;
+      true
+
+    method scan_module_type_pre mt =
+      self#gen_if_tag
+        mt.mt_name
+        (fst (Odoc_html.Naming.html_files mt.mt_name))
+        mt.mt_info;
+      true
+  end
+
+  class html : Html.html =
+    object (self)
+      inherit Html.html as html
+
+      (** we have to hack a little because we cannot inherit from
+             scanner, since public method cannot be hidden and
+             our html class must respect the type of the default
+             html generator class *)
+      val mutable scanner = new scanner (new Html.html )
+
+      method generate modules =
+      (* prevent having the 'todo' tag signaled as not handled *)
+      tag_functions <-  ("todo", (fun _ -> "")) :: tag_functions;
+      (* generate doc as usual *)
+      html#generate modules;
+      (* then retrieve the todo tags and generate the todo.html page *)
+      let title =
+        match !Odoc_info.Global.title with
+          None -> ""
+        | Some s -> s
+      in
+      let b = Buffer.create 512 in
+      p b "<html>";
+      self#print_header b title ;
+      p b "<body><h1>%s</h1>" title;
+      scanner#scan_module_list modules;
+      Buffer.add_buffer b scanner#buffer;
+      let oc = open_out
+          (Filename.concat !Odoc_info.Global.target_dir "todo.html")
+      in
+      Buffer.output_buffer oc b;
+      close_out oc
+
+     initializer
+       scanner <- new scanner self
+  end
+end
+
+let _ = Odoc_args.set_generator
+ (Odoc_gen.Html (module Generator : Odoc_html.Html_generator))
+ ;;