(***********************************************************************)
(*                             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) -> self#latex_of_Ref fmt name ref_opt
      | Odoc_info.Superscript t -> self#latex_of_Superscript fmt t
      | Odoc_info.Subscript t -> self#latex_of_Subscript fmt t

    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 =
      match ref_opt with
        None -> 
          self#latex_of_text_element fmt
            (Odoc_info.Code (Odoc_info.use_hidden_modules name))
      | 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
          self#latex_of_text fmt
            [
              Odoc_info.Code (Odoc_info.use_hidden_modules name) ;
              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 info_opt = 
      self#latex_of_text fmt 
        (self#text_of_info ~block: false 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 ")"

    (** 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;
	(
         match t.ty_manifest with
           None -> ()
         | Some typ -> 
             p fmt2 " = %s" (self#normal_type mod_name typ)
	);
        let s_type3 = 
          p fmt2
            " %s"
            (
	     match t.ty_kind with
               Type_abstract -> ""
             | Type_variant (_, priv) -> "="^(if priv then " private" else "")
             | Type_record (_, priv) -> "= "^(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#type_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 [Code "sig\n"];
	  List.iter (self#latex_of_module_element fmt father) eles;
	  self#latex_of_text fmt [Code "end"]
      | 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);
	    ]
	    
    method latex_of_module_kind fmt father kind =
      match kind with
	Module_struct eles ->
	  self#latex_of_text fmt [Code "sig\n"];
	  List.iter (self#latex_of_module_element fmt father) eles;
	  self#latex_of_text fmt [Code "end"]
      | 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


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

      | Class_apply capp ->
	  (* TODO: afficher le type final à partirdu 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 [Code "object\n"];
	  self#generate_inheritance_info fmt inh;
	  List.iter (self#latex_of_class_element fmt father) eles;
	  self#latex_of_text fmt [Code "end"]

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

    method latex_for_module_type_index fmt mt =
      self#latex_of_text fmt 
	[Latex ("\\index{"^(self#module_type_label mt.mt_name)^"@\\verb`"^
		(self#label ~no_:false mt.mt_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 =
      self#latex_of_text fmt 
	[Latex ("\\index{"^(self#class_label c.cl_name)^"@\\verb`"^
		(self#label ~no_:false c.cl_name)^"`}\n"
	       )
	]

    method latex_for_class_type_index fmt ct =
      self#latex_of_text fmt 
	[Latex ("\\index{"^(self#class_type_label ct.clt_name)^"@\\verb`"^
		(self#label ~no_:false ct.clt_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 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 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_text fmt [ Latex "\\end{ocamldoccode}\n" ];
      self#latex_for_class_label fmt c;
      self#latex_for_class_index fmt c;
      p fmt "@[<h 4>";
      self#latex_of_class_kind fmt father c.cl_kind;
      self#latex_of_text fmt [Newline];
      self#latex_of_info fmt 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 %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 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 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
      let text = [ 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 ] ;
      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 =
      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 !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 ;
      if !Args.separate_files then
        (
         let f m =
           try
             let chanout = 
               open_out ((Filename.concat !Args.target_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 !Args.out_file in
	let fmt = Format.formatter_of_out_channel chanout in
        if !Args.with_header then self#latex_header fmt;
        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

(* eof $Id$ *)