(***********************************************************************)
(*                             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$ *)

(** Generation of LaTeX documentation. *)

let print_DEBUG s = print_string s ; print_newline ()

open Odoc_info
open Parameter
open Value
open Type
open Exception
open Class
open Module

let new_buf () = Buffer.create 1024
let new_fmt () =
  let b = new_buf () in
  let fmt = Format.formatter_of_buffer b in
  (fmt,
   fun () ->
    Format.pp_print_flush fmt ();
    let s = Buffer.contents b in
    Buffer.reset b;
    s
  )

let p = Format.fprintf
let ps f s = Format.fprintf f "%s" s


let bp = Printf.bprintf
let bs = Buffer.add_string

let print_concat fmt sep f =
  let rec iter = function
      [] -> ()
    | [c] -> f c
    | c :: q ->
        f c;
        ps fmt sep;
        iter q
  in
  iter

(** Generation of LaTeX code from text structures. *)
class text =
  object (self)
    (** Return latex code to make a sectionning according to the given level,
       and with the given latex code. *)
    method section_style level s =
      try
        let sec = List.assoc level !Args.latex_titles in
        "\\"^sec^"{"^s^"}\n"
      with Not_found -> s

    (** Associations of strings to subsitute in latex code. *)
    val mutable subst_strings = [
      ("MAXENCE"^"ZZZ", "\\$");
      ("MAXENCE"^"YYY", "\\&");
      ("MAXENCE"^"XXX", "{\\textbackslash}") ;
      ("à", "\\`a") ;
      ("â", "\\^a") ;
      ("é", "\\'e") ;
      ("è", "\\`e") ;
      ("ê", "\\^e") ;
      ("ë", "\\\"e") ;
      ("ç", "\\c{c}") ;
      ("ô", "\\^o") ;
      ("ö", "\\\"o") ;
      ("î", "\\^i") ;
      ("ï", "\\\"i") ;
      ("ù", "\\`u") ;
      ("û", "\\^u") ;
      ("%", "\\%") ;
      ("_", "\\_");
      ("\\.\\.\\.", "$\\ldots$");
      ("~", "\\~{}");
      ("#", "\\verb`#`");
      ("}", "\\}");
      ("{", "\\{");
      ("&", "\\&");
      (">", "$>$");
      ("<", "$<$");
      ("=", "$=$");
      (">=", "$\\geq$");
      ("<=", "$\\leq$");
      ("->", "$\\rightarrow$") ;
      ("<-", "$\\leftarrow$");
      ("|", "\\textbar ");
      ("\\^", "\\textasciicircum ") ;
      ("\\.\\.\\.", "$\\ldots$");
      ("\\\\", "MAXENCE"^"XXX") ;
      ("&", "MAXENCE"^"YYY") ;
      ("\\$", "MAXENCE"^"ZZZ");
    ]

    val mutable subst_strings_simple =
      [
        ("MAXENCE"^"XXX", "{\\textbackslash}") ;
        "}", "\\}" ;
        "{", "\\{" ;
        ("\\\\", "MAXENCE"^"XXX") ;
      ]

    val mutable subst_strings_code = [
      ("MAXENCE"^"ZZZ", "\\$");
      ("MAXENCE"^"YYY", "\\&");
      ("MAXENCE"^"XXX", "{\\textbackslash}") ;
      ("%", "\\%") ;
      ("_", "\\_");
      ("~", "\\~{}");
      ("#", "\\verb`#`");
      ("}", "\\}");
      ("{", "\\{");
      ("&", "\\&");
      ("\\^", "\\textasciicircum ") ;
      ("&", "MAXENCE"^"YYY") ;
      ("\\$", "MAXENCE"^"ZZZ") ;
      ("\\\\", "MAXENCE"^"XXX") ;
     ]

    method subst l s =
      List.fold_right
        (fun (s, s2) -> fun acc -> Str.global_replace (Str.regexp s) s2 acc)
        l
        s

    (** Escape the strings which would clash with LaTeX syntax. *)
    method escape s = self#subst subst_strings s

    (** Escape the ['\'], ['{'] and ['}'] characters. *)
    method escape_simple s = self#subst subst_strings_simple s

    (** Escape some characters for the code style. *)
    method escape_code s = self#subst subst_strings_code s

    (** Make a correct latex label from a name. *)
    (* The following characters are forbidden in LaTeX \index:
       \ { } $ & # ^ _ % ~ ! " @ | (" to close the double quote)
       The following characters are forbidden in LaTeX \label:
       \ { } $ & # ^ _ % ~
       So we will use characters not forbidden in \index if no_ = true.
    *)
    method label ?(no_=true) name =
      let len = String.length name in
      let buf = Buffer.create len in
      for i = 0 to len - 1 do
        let (s_no_, s) =
          match name.[i] with
          '_' -> ("-underscore", "_")
        | '~' -> ("-tilde", "~")
        | '%' -> ("-percent", "%")
        | '@' -> ("-at", "\"@")
        | '!' -> ("-bang", "\"!")
        | '|' -> ("-pipe", "\"|")
        | '<' -> ("-lt", "<")
        | '>' -> ("-gt", ">")
        | '^' -> ("-exp", "^")
        | '&' -> ("-ampersand", "&")
        | '+' -> ("-plus", "+")
        | '-' -> ("-minus", "-")
        | '*' -> ("-star", "*")
        | '/' -> ("-slash", "/")
        | '$' -> ("-dollar", "$")
        | '=' -> ("-equal", "=")
        | ':' -> ("-colon", ":")
        | c -> (String.make 1 c, String.make 1 c)
        in
        Buffer.add_string buf (if no_ then s_no_ else s)
      done;
      Buffer.contents buf

    (** Make a correct label from a value name. *)
    method value_label ?no_ name = !Args.latex_value_prefix^(self#label ?no_ name)

    (** Make a correct label from an attribute name. *)
    method attribute_label ?no_ name = !Args.latex_attribute_prefix^(self#label ?no_ name)

    (** Make a correct label from a method name. *)
    method method_label ?no_ name = !Args.latex_method_prefix^(self#label ?no_ name)

    (** Make a correct label from a class name. *)
    method class_label ?no_ name = !Args.latex_class_prefix^(self#label ?no_ name)

    (** Make a correct label from a class type name. *)
    method class_type_label ?no_ name = !Args.latex_class_type_prefix^(self#label ?no_ name)

    (** Make a correct label from a module name. *)
    method module_label ?no_ name = !Args.latex_module_prefix^(self#label ?no_ name)

    (** Make a correct label from a module type name. *)
    method module_type_label ?no_ name = !Args.latex_module_type_prefix^(self#label ?no_ name)

    (** Make a correct label from an exception name. *)
    method exception_label ?no_ name = !Args.latex_exception_prefix^(self#label ?no_ name)

    (** Make a correct label from a type name. *)
    method type_label ?no_ name = !Args.latex_type_prefix^(self#label ?no_ name)

    (** Return latex code for the label of a given label. *)
    method make_label label = "\\label{"^label^"}"

    (** Return latex code for the ref to a given label. *)
    method make_ref label = "\\ref{"^label^"}"

    (** Print the LaTeX code corresponding to the [text] parameter.*)
    method latex_of_text fmt t =
      List.iter (self#latex_of_text_element fmt) t

    (** Print the LaTeX code for the [text_element] in parameter. *)
    method latex_of_text_element fmt te =
      match te with
      | Odoc_info.Raw s -> self#latex_of_Raw fmt s
      | Odoc_info.Code s -> self#latex_of_Code fmt s
      | Odoc_info.CodePre s -> self#latex_of_CodePre fmt s
      | Odoc_info.Verbatim s -> self#latex_of_Verbatim fmt s
      | Odoc_info.Bold t -> self#latex_of_Bold fmt t
      | Odoc_info.Italic t -> self#latex_of_Italic fmt t
      | Odoc_info.Emphasize t -> self#latex_of_Emphasize fmt t
      | Odoc_info.Center t -> self#latex_of_Center fmt t
      | Odoc_info.Left t -> self#latex_of_Left fmt t
      | Odoc_info.Right t -> self#latex_of_Right fmt t
      | Odoc_info.List tl -> self#latex_of_List fmt tl
      | Odoc_info.Enum tl -> self#latex_of_Enum fmt tl
      | Odoc_info.Newline -> self#latex_of_Newline fmt
      | Odoc_info.Block t -> self#latex_of_Block fmt t
      | Odoc_info.Title (n, l_opt, t) -> self#latex_of_Title fmt n l_opt t
      | Odoc_info.Latex s -> self#latex_of_Latex fmt s
      | Odoc_info.Link (s, t) -> self#latex_of_Link fmt s t
      | Odoc_info.Ref (name, ref_opt, text_opt) ->
          self#latex_of_Ref fmt name ref_opt text_opt
      | Odoc_info.Superscript t -> self#latex_of_Superscript fmt t
      | Odoc_info.Subscript t -> self#latex_of_Subscript fmt t
      | Odoc_info.Module_list _ -> ()
      | Odoc_info.Index_list -> ()
      | Odoc_info.Custom (s,t) -> self#latex_of_custom_text fmt s t
      | Odoc_info.Target (target, code) -> self#latex_of_Target fmt ~target ~code

    method latex_of_custom_text fmt s t = ()

    method latex_of_Target fmt ~target ~code =
      if String.lowercase target = "latex" then
        self#latex_of_Latex fmt code
      else
        ()

    method latex_of_Raw fmt s =
      ps fmt (self#escape s)

    method latex_of_Code fmt s =
      let s2 = self#escape_code s in
      let s3 = Str.global_replace (Str.regexp "\n") ("\\\\\n") s2 in
      p fmt "{\\tt{%s}}" s3

    method latex_of_CodePre fmt s =
      ps fmt "\\begin{ocamldoccode}\n";
      ps fmt (self#escape_simple s);
      ps fmt "\n\\end{ocamldoccode}\n"

    method latex_of_Verbatim fmt s =
      ps fmt "\\begin{verbatim}";
      ps fmt s;
      ps fmt "\\end{verbatim}"

    method latex_of_Bold fmt t =
      ps fmt "{\\bf ";
      self#latex_of_text fmt t;
      ps fmt "}"

    method latex_of_Italic fmt t =
      ps fmt "{\\it ";
      self#latex_of_text fmt t;
      ps fmt "}"

    method latex_of_Emphasize fmt t =
      ps fmt "{\\em ";
      self#latex_of_text fmt t;
      ps fmt "}"

    method latex_of_Center fmt t =
      ps fmt "\\begin{center}\n";
      self#latex_of_text fmt t;
      ps fmt "\\end{center}\n"

    method latex_of_Left fmt t =
      ps fmt "\\begin{flushleft}\n";
      self#latex_of_text fmt t;
      ps fmt "\\end{flushleft}\n"

    method latex_of_Right fmt t =
      ps fmt "\\begin{flushright}\n";
      self#latex_of_text fmt t;
      ps fmt "\\end{flushright}\n"

    method latex_of_List fmt tl =
      ps fmt "\\begin{itemize}\n";
      List.iter
        (fun t ->
          ps fmt "\\item ";
          self#latex_of_text fmt t;
          ps fmt "\n"
        )
        tl;
      ps fmt "\\end{itemize}\n"

    method latex_of_Enum fmt tl =
      ps fmt "\\begin{enumerate}\n";
      List.iter
        (fun t ->
          ps fmt "\\item ";
          self#latex_of_text fmt t;
          ps fmt "\n"
        )
        tl;
      ps fmt "\\end{enumerate}\n"

    method latex_of_Newline fmt = ps fmt "\n\n"

    method latex_of_Block fmt t =
      ps fmt "\\begin{ocamldocdescription}\n";
      self#latex_of_text fmt t;
      ps fmt "\n\\end{ocamldocdescription}\n"

    method latex_of_Title fmt n label_opt t =
      let (fmt2, flush) = new_fmt () in
      self#latex_of_text fmt2 t;
      let s_title2 = self#section_style n (flush ()) in
      ps fmt s_title2;
      (
       match label_opt with
         None -> ()
       | Some l ->
           ps fmt (self#make_label (self#label ~no_: false l))
      )

    method latex_of_Latex fmt s = ps fmt s

    method latex_of_Link fmt s t =
      self#latex_of_text fmt t ;
      ps fmt "[\\url{";
      ps fmt s ;
      ps fmt "}]"

    method latex_of_Ref fmt name ref_opt text_opt =
      match ref_opt with
        None ->
          self#latex_of_text fmt
          (match text_opt with
             None ->
               [Odoc_info.Code (Odoc_info.use_hidden_modules name)]
           | Some t -> t
           )
      | Some (RK_section _) ->
          self#latex_of_text_element fmt
            (Latex ("["^(self#make_ref (self#label ~no_:false (Name.simple name)))^"]"))
      | Some kind ->
          let f_label =
            match kind with
              Odoc_info.RK_module -> self#module_label
            | Odoc_info.RK_module_type -> self#module_type_label
            | Odoc_info.RK_class -> self#class_label
            | Odoc_info.RK_class_type -> self#class_type_label
            | Odoc_info.RK_value -> self#value_label
            | Odoc_info.RK_type -> self#type_label
            | Odoc_info.RK_exception -> self#exception_label
            | Odoc_info.RK_attribute -> self#attribute_label
            | Odoc_info.RK_method -> self#method_label
            | Odoc_info.RK_section _ -> assert false
          in
          let text =
            match text_opt with
              None -> [Odoc_info.Code (Odoc_info.use_hidden_modules name)]
            | Some t -> t
          in
          self#latex_of_text fmt
             (text @ [Latex ("["^(self#make_ref (f_label name))^"]")])

    method latex_of_Superscript fmt t =
      ps fmt "$^{";
      self#latex_of_text fmt t;
      ps fmt "}$"

    method latex_of_Subscript fmt t =
      ps fmt "$_{";
      self#latex_of_text fmt t;
      ps fmt "}$"

  end

(** A class used to generate LaTeX code for info structures. *)
class virtual info =
  object (self)
    (** The method used to get LaTeX code from a [text]. *)
    method virtual latex_of_text : Format.formatter -> Odoc_info.text -> unit

    (** The method used to get a [text] from an optionel info structure. *)
    method virtual text_of_info : ?block: bool -> Odoc_info.info option -> Odoc_info.text

    (** Print LaTeX code for a description, except for the [i_params] field. *)
    method latex_of_info fmt ?(block=false) info_opt =
      self#latex_of_text fmt
        (self#text_of_info ~block info_opt)
  end

(** This class is used to create objects which can generate a simple LaTeX documentation. *)
class latex =
  object (self)
    inherit text
    inherit Odoc_to_text.to_text as to_text
    inherit info

    (** Get the first sentence and the rest of a description,
       from an optional [info] structure. The first sentence
       can be empty if it would not appear right in a title.
       In the first sentence, the titles and lists has been removed,
       since it is used in LaTeX titles and would make LaTeX complain
       if we has two nested \section commands.
    *)
    method first_and_rest_of_info i_opt =
      match i_opt with
        None -> ([], [])
      | Some i ->
            match i.Odoc_info.i_desc with
              None -> ([], self#text_of_info ~block: true i_opt)
            | Some t ->
                let (first,_) = Odoc_info.first_sentence_and_rest_of_text t in
                let (_, rest) = Odoc_info.first_sentence_and_rest_of_text (self#text_of_info ~block: false i_opt) in
                (Odoc_info.text_no_title_no_list first, rest)

    (** Print LaTeX code for a value. *)
    method latex_of_value fmt v =
      Odoc_info.reset_type_names () ;
      let label = self#value_label v.val_name in
      let latex = self#make_label label in
      self#latex_of_text fmt
        ((Latex latex) ::
         (to_text#text_of_value v))

    (** Print LaTeX code for a class attribute. *)
    method latex_of_attribute fmt a =
      self#latex_of_text fmt
        ((Latex (self#make_label (self#attribute_label a.att_value.val_name))) ::
         (to_text#text_of_attribute a))

    (** Print LaTeX code for a class method. *)
    method latex_of_method fmt m =
      self#latex_of_text fmt
        ((Latex (self#make_label (self#method_label m.met_value.val_name))) ::
         (to_text#text_of_method m))

    (** Print LaTeX code for the parameters of a type. *)
    method latex_of_type_params fmt m_name t =
      let print_one (p, co, cn) =
        ps fmt (Odoc_info.string_of_variance t (co,cn));
        ps fmt (self#normal_type m_name p)
      in
      match t.ty_parameters with
        [] -> ()
      | [(p,co,cn)] -> print_one (p, co, cn)
      | l ->
          ps fmt "(";
          print_concat fmt ", " print_one t.ty_parameters;
          ps fmt ")"

    method latex_of_class_parameter_list fmt father c =
      self#latex_of_text fmt
        (self#text_of_class_params father c)

    (** Print LaTeX code for a type. *)
    method latex_of_type fmt t =
      let s_name = Name.simple t.ty_name in
      let text =
        let (fmt2, flush2) = new_fmt () in
        Odoc_info.reset_type_names () ;
        let mod_name = Name.father t.ty_name in
        Format.fprintf fmt2 "@[<h 2>type ";
        self#latex_of_type_params fmt2 mod_name t;
        (match t.ty_parameters with [] -> () | _ -> ps fmt2 " ");
        ps fmt2 s_name;
        let priv = t.ty_private = Asttypes.Private in
        (
         match t.ty_manifest with
           None -> ()
         | Some typ ->
             p fmt2 " = %s%s" (if priv then "private " else "") (self#normal_type mod_name typ)
        );
        let s_type3 =
          p fmt2
            " %s"
            (
             match t.ty_kind with
               Type_abstract -> ""
             | Type_variant _ -> "="^(if priv then " private" else "")
             | Type_record _ -> "= "^(if priv then "private " else "")^"{"
            ) ;
          flush2 ()
        in

        let defs =
          match t.ty_kind with
            Type_abstract -> []
          | Type_variant l ->
              (List.flatten
               (List.map
                  (fun constr ->
                    let s_cons =
                      p fmt2 "@[<h 6>  | %s" constr.vc_name;
                      (
                       match constr.vc_args with
                         [] -> ()
                       | l ->
                           p fmt2 " %s@ %s"
                             "of"
                             (self#normal_type_list ~par: false mod_name " * " l)
                      );
                      flush2 ()
                    in
                    [ CodePre s_cons ] @
                    (match constr.vc_text with
                      None -> []
                    | Some t ->
                        let s =
                          ps fmt2 "\\begin{ocamldoccomment}\n";
                          self#latex_of_text fmt2 t;
                          ps fmt2 "\n\\end{ocamldoccomment}\n";
                          flush2 ()
                        in
                        [ Latex s]
                    )
                  )
                  l
               )
              )
          | Type_record l ->
              (List.flatten
                 (List.map
                    (fun r ->
                      let s_field =
                        p fmt2
                          "@[<h 6>  %s%s :@ %s ;"
                          (if r.rf_mutable then "mutable " else "")
                          r.rf_name
                          (self#normal_type mod_name r.rf_type);
                        flush2 ()
                      in
                      [ CodePre s_field ] @
                      (match r.rf_text with
                        None -> []
                      | Some t ->
                          let s =
                            ps fmt2 "\\begin{ocamldoccomment}\n";
                            self#latex_of_text fmt2 t;
                            ps fmt2 "\n\\end{ocamldoccomment}\n";
                            flush2 ()
                        in
                        [ Latex s]
                      )
                    )
                    l
                 )
              ) @
              [ CodePre "}" ]
        in
        let defs2 = (CodePre s_type3) :: defs in
        let rec iter = function
            [] -> []
          | [e] -> [e]
          | (CodePre s1) :: (CodePre s2) :: q ->
              iter ((CodePre (s1^"\n"^s2)) :: q)
          | e :: q ->
              e :: (iter q)
        in
        (iter defs2) @
        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
        (self#text_of_info t.ty_info)
      in
      self#latex_of_text fmt
        ((Latex (self#make_label (self#type_label t.ty_name))) :: text)

    (** Print LaTeX code for an exception. *)
    method latex_of_exception fmt e =
      Odoc_info.reset_type_names () ;
      self#latex_of_text fmt
        ((Latex (self#make_label (self#exception_label e.ex_name))) ::
         (to_text#text_of_exception e))

    method latex_of_module_parameter fmt m_name p =
      self#latex_of_text fmt
        [
          Code "functor (";
          Code p.mp_name ;
          Code " : ";
        ] ;
      self#latex_of_module_type_kind fmt m_name p.mp_kind;
      self#latex_of_text fmt [ Code ") -> "]


    method latex_of_module_type_kind fmt father kind =
      match kind with
        Module_type_struct eles ->
          self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"];
          List.iter (self#latex_of_module_element fmt father) eles;
          self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"]
      | Module_type_functor (p, k) ->
          self#latex_of_module_parameter fmt father p;
          self#latex_of_module_type_kind fmt father k
      | Module_type_alias a ->
          self#latex_of_text fmt
            [Code (self#relative_module_idents father a.mta_name)]
      | Module_type_with (k, s) ->
          self#latex_of_module_type_kind fmt father k;
          self#latex_of_text fmt
            [ Code " ";
              Code (self#relative_idents father s);
            ]
      | Module_type_typeof s ->
          self#latex_of_text fmt
            [ Code "module type of ";
              Code (self#relative_idents father s);
            ]

    method latex_of_module_kind fmt father kind =
      match kind with
        Module_struct eles ->
          self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"];
          List.iter (self#latex_of_module_element fmt father) eles;
          self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"]
      | Module_alias a ->
          self#latex_of_text fmt
            [Code (self#relative_module_idents father a.ma_name)]
      | Module_functor (p, k) ->
          self#latex_of_module_parameter fmt father p;
          self#latex_of_module_kind fmt father k
      | Module_apply (k1, k2) ->
          (* TODO: l'application n'est pas correcte dans un .mli.
             Que faire ? -> afficher le module_type du typedtree  *)
          self#latex_of_module_kind fmt father k1;
          self#latex_of_text fmt [Code "("];
          self#latex_of_module_kind fmt father k2;
          self#latex_of_text fmt [Code ")"]
      | Module_with (k, s) ->
          (* TODO: à modifier quand Module_with sera plus détaillé *)
          self#latex_of_module_type_kind fmt father k;
          self#latex_of_text fmt
            [ Code " ";
              Code (self#relative_idents father s) ;
            ]
      | Module_constraint (k, tk) ->
          (* TODO: on affiche quoi ? *)
          self#latex_of_module_kind fmt father k
      | Module_typeof s ->
          self#latex_of_text fmt
            [ Code "module type of ";
              Code (self#relative_idents father s);
            ]
      | Module_unpack (s, _) ->
          self#latex_of_text fmt
            [
              Code (self#relative_idents father s);
            ]

    method latex_of_class_kind fmt father kind =
      match kind with
        Class_structure (inh, eles) ->
          self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"];
          self#generate_inheritance_info fmt inh;
          List.iter (self#latex_of_class_element fmt father) eles;
          self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"]

      | Class_apply capp ->
          (* TODO: afficher le type final à partir du typedtree *)
          self#latex_of_text fmt [Raw "class application not handled yet"]

      | Class_constr cco ->
          (
           match cco.cco_type_parameters with
             [] -> ()
           | l ->
               self#latex_of_text fmt
                 (
                  Code "[" ::
                  (self#text_of_class_type_param_expr_list father l) @
                  [Code "] "]
                 )
          );
          self#latex_of_text fmt
            [Code (self#relative_idents father cco.cco_name)]

      | Class_constraint (ck, ctk) ->
          self#latex_of_text fmt [Code "( "] ;
          self#latex_of_class_kind fmt father ck;
          self#latex_of_text fmt [Code " : "] ;
          self#latex_of_class_type_kind fmt father ctk;
          self#latex_of_text fmt [Code " )"]

    method latex_of_class_type_kind fmt father kind =
      match kind with
        Class_type cta ->
          (
           match cta.cta_type_parameters with
             [] -> ()
           | l ->
               self#latex_of_text fmt
                 (Code "[" ::
                  (self#text_of_class_type_param_expr_list father l) @
                  [Code "] "]
                 )
          );
          self#latex_of_text fmt
            [Code (self#relative_idents father cta.cta_name)]

      | Class_signature (inh, eles) ->
          self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"];
          self#generate_inheritance_info fmt inh;
          List.iter (self#latex_of_class_element fmt father) eles;
          self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"]

    method latex_for_module_index fmt m =
      let s_name = Name.simple m.m_name in
      self#latex_of_text fmt
        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^
                (self#label ~no_:false s_name)^"`}\n"
               )
        ]

    method latex_for_module_type_index fmt mt =
      let s_name = Name.simple mt.mt_name in
      self#latex_of_text fmt
        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^
                (self#label ~no_:false (Name.simple s_name))^"`}\n"
               )
        ]

    method latex_for_module_label fmt m =
      ps fmt (self#make_label (self#module_label m.m_name))

    method latex_for_module_type_label fmt mt =
      ps fmt (self#make_label (self#module_type_label mt.mt_name))


    method latex_for_class_index fmt c =
      let s_name = Name.simple c.cl_name in
      self#latex_of_text fmt
        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^
                (self#label ~no_:false s_name)^"`}\n"
               )
        ]

    method latex_for_class_type_index fmt ct =
      let s_name = Name.simple ct.clt_name in
      self#latex_of_text fmt
        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^
                (self#label ~no_:false s_name)^"`}\n"
               )
        ]

    method latex_for_class_label fmt c =
      ps fmt (self#make_label (self#class_label c.cl_name))

    method latex_for_class_type_label fmt ct =
      ps fmt (self#make_label (self#class_type_label ct.clt_name))

    (** Print the LaTeX code for the given module. *)
    method latex_of_module fmt m =
      let father = Name.father m.m_name in
      let t =
        [
          Latex "\\begin{ocamldoccode}\n" ;
          Code "module ";
          Code (Name.simple m.m_name);
          Code " : ";
        ]
      in
      self#latex_of_text fmt t;
      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
      self#latex_for_module_label fmt m;
      self#latex_for_module_index fmt m;
      p fmt "@[<h 4>";
      self#latex_of_module_kind fmt father m.m_kind;
      (
       match Module.module_is_functor m with
         false -> ()
       | true ->
           self#latex_of_text fmt  [Newline];
           (
            match List.filter (fun (_,d) -> d <> None)
                (module_parameters ~trans: false m)
            with
              [] -> ()
            | l ->
                let t =
                  [ Bold [Raw "Parameters: "];
                    List
                      (List.map
                         (fun (p,text_opt) ->
                           let t = match text_opt with None -> [] | Some t -> t in
                           ( Raw p.mp_name :: Raw ": " :: t)
                         )
                         l
                      )
                  ]
           in
           self#latex_of_text fmt t
           );
      );
      self#latex_of_text fmt [Newline];
      self#latex_of_info fmt ~block: true m.m_info;
      p fmt "@]";


    (** Print the LaTeX code for the given module type. *)
    method latex_of_module_type fmt mt =
      let father = Name.father mt.mt_name in
      let t =
        [
          Latex "\\begin{ocamldoccode}\n" ;
          Code "module type " ;
          Code (Name.simple mt.mt_name);
        ]
      in
      self#latex_of_text fmt t;
      (
       match mt.mt_type, mt.mt_kind with
       | Some mtyp, Some kind ->
           self#latex_of_text fmt [ Code " = " ];
           self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
           self#latex_for_module_type_label fmt mt;
           self#latex_for_module_type_index fmt mt;
           p fmt "@[<h 4>";
           self#latex_of_module_type_kind fmt father kind
       | _ ->
           self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
           self#latex_for_module_type_index fmt mt;
           p fmt "@[<h 4>";
      );
      (
       match Module.module_type_is_functor mt with
         false -> ()
       | true ->
           self#latex_of_text fmt [Newline];
           (
            match List.filter (fun (_,d) -> d <> None)
                (module_type_parameters ~trans: false mt)
            with
              [] -> ()
            | l ->
                let t =
                  [ Bold [Raw "Parameters: "];
                    List
                      (List.map
                         (fun (p,text_opt) ->
                           let t = match text_opt with None -> [] | Some t -> t in
                           ( Raw p.mp_name :: Raw ": " :: t)
                         )
                         l
                      )
                  ]
                in
                self#latex_of_text fmt t
           );
      );
      self#latex_of_text fmt [Newline];
      self#latex_of_info fmt ~block: true mt.mt_info;
      p fmt "@]";

    (** Print the LaTeX code for the given included module. *)
    method latex_of_included_module fmt im =
      self#latex_of_text fmt
        ((Code "include ") ::
         (Code
            (match im.im_module with
              None -> im.im_name
            | Some (Mod m) -> m.m_name
            | Some (Modtype mt) -> mt.mt_name)
         ) ::
         (self#text_of_info im.im_info)
        )

    (** Print the LaTeX code for the given class. *)
    method latex_of_class fmt c =
      Odoc_info.reset_type_names () ;
      let father = Name.father c.cl_name in
      let type_params =
        match c.cl_type_parameters with
          [] -> ""
        | l -> (self#normal_class_type_param_list father l)^" "
      in
      let t =
        [
          Latex "\\begin{ocamldoccode}\n" ;
          Code (Printf.sprintf
                  "class %s%s%s : "
                  (if c.cl_virtual then "virtual " else "")
                  type_params
                  (Name.simple c.cl_name)
               )
        ]
      in
      self#latex_of_text fmt t;
      self#latex_of_class_parameter_list fmt father c;
      (* avoid a big gap if the kind is a consrt *)
      (
       match c.cl_kind with
         Class.Class_constr _ ->
           self#latex_of_class_kind fmt father c.cl_kind
       | _ ->
           ()
      );
      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
      self#latex_for_class_label fmt c;
      self#latex_for_class_index fmt c;
      p fmt "@[<h 4>";
      (match c.cl_kind with
        Class.Class_constr _ -> ()
      |        _ -> self#latex_of_class_kind fmt father c.cl_kind
      );
      self#latex_of_text fmt [Newline];
      self#latex_of_info fmt ~block: true c.cl_info;
      p fmt "@]"

    (** Print the LaTeX code for the given class type. *)
    method latex_of_class_type fmt ct =
      Odoc_info.reset_type_names () ;
      let father = Name.father ct.clt_name in
      let type_params =
        match ct.clt_type_parameters with
          [] -> ""
        | l -> (self#normal_class_type_param_list father l)^" "
      in
      let t =
        [
          Latex "\\begin{ocamldoccode}\n" ;
          Code (Printf.sprintf
                  "class type %s%s%s = "
                  (if ct.clt_virtual then "virtual " else "")
                  type_params
                  (Name.simple ct.clt_name)
               )
        ]
      in
      self#latex_of_text fmt t;

      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
      self#latex_for_class_type_label fmt ct;
      self#latex_for_class_type_index fmt ct;
      p fmt "@[<h 4>";
      self#latex_of_class_type_kind fmt father ct.clt_kind;
      self#latex_of_text fmt [Newline];
      self#latex_of_info fmt ~block: true ct.clt_info;
      p fmt "@]"

    (** Print the LaTeX code for the given class element. *)
    method latex_of_class_element fmt class_name class_ele =
      self#latex_of_text fmt [Newline];
      match class_ele with
        Class_attribute att -> self#latex_of_attribute fmt att
      | Class_method met -> self#latex_of_method fmt met
      | Class_comment t ->
          match t with
          | [] -> ()
          | (Title (_,_,_)) :: _ -> self#latex_of_text fmt t
          | _ -> self#latex_of_text fmt [ Title ((Name.depth class_name) + 2, None, t) ]

    (** Print the LaTeX code for the given module element. *)
    method latex_of_module_element fmt module_name module_ele =
      self#latex_of_text fmt [Newline];
      match module_ele with
        Element_module m -> self#latex_of_module fmt m
      | Element_module_type mt -> self#latex_of_module_type fmt mt
      | Element_included_module im -> self#latex_of_included_module fmt im
      | Element_class c -> self#latex_of_class fmt c
      | Element_class_type ct -> self#latex_of_class_type fmt ct
      | Element_value v -> self#latex_of_value fmt v
      | Element_exception e -> self#latex_of_exception fmt e
      | Element_type t -> self#latex_of_type fmt t
      | Element_module_comment t -> self#latex_of_text fmt t

    (** Generate the LaTeX code for the given list of inherited classes.*)
    method generate_inheritance_info fmt inher_l =
      let f inh =
        match inh.ic_class with
          None -> (* we can't make the reference *)
            Newline ::
            Code ("inherit "^inh.ic_name) ::
            (match inh.ic_text with
              None -> []
            | Some t -> Newline :: t
            )
        | Some cct ->
            let label =
              match cct with
                Cl _ -> self#class_label inh.ic_name
              | Cltype _ -> self#class_type_label inh.ic_name
            in
            (* we can create the reference *)
            Newline ::
            Odoc_info.Code ("inherit "^inh.ic_name) ::
            (Odoc_info.Latex (" ["^(self#make_ref label)^"]")) ::
            (match inh.ic_text with
              None -> []
            | Some t -> Newline :: t
            )
      in
      List.iter (self#latex_of_text fmt) (List.map f inher_l)

    (** Generate the LaTeX code for the inherited classes of the given class. *)
    method generate_class_inheritance_info fmt cl =
      let rec iter_kind k =
        match k with
          Class_structure ([], _) ->
            ()
        | Class_structure (l, _) ->
            self#generate_inheritance_info fmt l
        | Class_constraint (k, _) ->
            iter_kind k
        | Class_apply _
        | Class_constr _ ->
            ()
      in
      iter_kind cl.cl_kind

    (** Generate the LaTeX code for the inherited classes of the given class type. *)
    method generate_class_type_inheritance_info fmt clt =
      match clt.clt_kind with
        Class_signature ([], _) ->
          ()
      | Class_signature (l, _) ->
          self#generate_inheritance_info fmt l
      | Class_type _ ->
          ()

    (** 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
      let text =
        if m.m_text_only then
          [ Title (1, None, [Raw m.m_name]  @
                   (match first_t with
                     [] -> []
                   | t -> (Raw " : ") :: t)
                  ) ;
          ]
        else
          [ Title (1, None,
                   [ Raw (Odoc_messages.modul^" ") ; Code m.m_name ] @
                   (match first_t with
                     [] -> []
                   | t -> (Raw " : ") :: t)) ;
          ]
      in
      self#latex_of_text fmt text;
      self#latex_for_module_label fmt m;
      self#latex_for_module_index fmt m;
      self#latex_of_text fmt rest_t ;

      self#latex_of_text fmt [ Newline ] ;
      if not m.m_text_only then ps fmt "\\ocamldocvspace{0.5cm}\n\n";
      List.iter
        (fun ele ->
          self#latex_of_module_element fmt m.m_name ele;
          ps fmt "\n\n"
        )
        (Module.module_elements ~trans: false m)

    (** Print the header of the TeX document. *)
    method latex_header fmt module_list =
      ps fmt "\\documentclass[11pt]{article} \n";
      ps fmt "\\usepackage[latin1]{inputenc} \n";
      ps fmt "\\usepackage[T1]{fontenc} \n";
      ps fmt "\\usepackage{fullpage} \n";
      ps fmt "\\usepackage{url} \n";
      ps fmt "\\usepackage{ocamldoc}\n";
      (
       match !Args.title with
         None -> ()
       | Some s ->
           ps fmt "\\title{";
           ps fmt (self#escape s);
           ps fmt "}\n"
      );
      ps fmt "\\begin{document}\n";
      (match !Args.title with
        None -> () |
        Some _ -> ps fmt "\\maketitle\n"
      );
      if !Args.with_toc then ps fmt "\\tableofcontents\n";
      (
       let info = Odoc_info.apply_opt
           (Odoc_info.info_of_comment_file module_list)
           !Odoc_info.Args.intro_file
       in
       (match info with None -> () | Some _ -> ps fmt "\\vspace{0.2cm}");
       self#latex_of_info fmt info;
       (match info with None -> () | Some _ -> ps fmt "\n\n")
      )


    (** Generate the LaTeX style file, if it does not exists. *)
    method generate_style_file =
      try
        let dir = Filename.dirname !Args.out_file in
        let file = Filename.concat dir "ocamldoc.sty" in
        if Sys.file_exists file then
          Odoc_info.verbose (Odoc_messages.file_exists_dont_generate file)
        else
          (
           let chanout = open_out file in
           output_string chanout Odoc_latex_style.content ;
           flush chanout ;
           close_out chanout;
           Odoc_info.verbose (Odoc_messages.file_generated file)
          )
      with
        Sys_error s ->
          prerr_endline s ;
          incr Odoc_info.errors ;

    (** Generate the LaTeX file from a module list, in the {!Odoc_info.Args.out_file} file. *)
    method generate module_list =
      self#generate_style_file ;
      let main_file = !Args.out_file in
      let dir = Filename.dirname main_file in
      if !Args.separate_files then
        (
         let f m =
           try
             let chanout =
               open_out ((Filename.concat dir (Name.simple m.m_name))^".tex")
             in
             let fmt = Format.formatter_of_out_channel chanout in
             self#generate_for_top_module fmt m ;
             Format.pp_print_flush fmt ();
             close_out chanout
           with
             Failure s
           | Sys_error s ->
               prerr_endline s ;
               incr Odoc_info.errors
         in
         List.iter f module_list
        );

      try
        let chanout = open_out main_file in
        let fmt = Format.formatter_of_out_channel chanout in
        if !Args.with_header then self#latex_header fmt module_list;
        List.iter
          (fun m ->
            if !Args.separate_files then
              ps fmt ("\\input{"^((Name.simple m.m_name))^".tex}\n")
            else
              self#generate_for_top_module fmt m
          )
          module_list ;
        if !Args.with_trailer then ps fmt "\\end{document}";
        Format.pp_print_flush fmt ();
        close_out chanout
      with
        Failure s
      | Sys_error s ->
          prerr_endline s ;
          incr Odoc_info.errors
  end