(**************************************************************************) (* *) (* OCaml *) (* *) (* 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 GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Generation of LaTeX documentation. *) open Odoc_info open Value open Type open Extension open Exception open Class open Module let separate_files = ref false let latex_titles = ref [ 0, "section" ; 1, "section" ; 2, "subsection" ; 3, "subsubsection" ; 4, "paragraph" ; 5, "subparagraph" ; ] let latex_value_prefix = ref Odoc_messages.default_latex_value_prefix let latex_type_prefix = ref Odoc_messages.default_latex_type_prefix let latex_type_elt_prefix = ref Odoc_messages.default_latex_type_elt_prefix let latex_extension_prefix = ref Odoc_messages.default_latex_extension_prefix let latex_exception_prefix = ref Odoc_messages.default_latex_exception_prefix let latex_module_prefix = ref Odoc_messages.default_latex_module_prefix let latex_module_type_prefix = ref Odoc_messages.default_latex_module_type_prefix let latex_class_prefix = ref Odoc_messages.default_latex_class_prefix let latex_class_type_prefix = ref Odoc_messages.default_latex_class_type_prefix let latex_attribute_prefix = ref Odoc_messages.default_latex_attribute_prefix let latex_method_prefix = ref Odoc_messages.default_latex_method_prefix 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 rec merge_codepre = function [] -> [] | [e] -> [e] | (CodePre s1) :: (CodePre s2) :: q -> merge_codepre ((CodePre (s1^"\n"^s2)) :: q) | e :: q -> e :: (merge_codepre q) 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 section according to the given level, and with the given latex code. *) method section_style level s = try let sec = List.assoc level !latex_titles in "\\"^sec^"{"^s^"}\n" with Not_found -> s (** Associations of strings to substitute in latex code. *) val subst_strings = List.map (fun (x, y) -> (Str.regexp x, y)) [ "\001", "\001\002"; "\\\\", "\001b"; "{", "\\\\{"; "}", "\\\\}"; "\\$", "\\\\$"; "\\^", "{\\\\textasciicircum}"; "%", "\\\\%"; "_", "\\\\_"; "~", "\\\\~{}"; "#", "{\\char35}"; "->", "$\\\\rightarrow$"; "<-", "$\\\\leftarrow$"; ">=", "$\\\\geq$"; "<=", "$\\\\leq$"; ">", "$>$"; "<", "$<$"; "=", "$=$"; "|", "{\\\\textbar}"; "\\.\\.\\.", "$\\\\ldots$"; "&", "\\\\&"; "\001b", "{\\\\char92}"; "\001\002", "\001"; ] val subst_strings_simple = List.map (fun (x, y) -> (Str.regexp x, y)) [ "\001", "\001\002"; "\\\\", "\001b"; "{", "\001l"; "}", "{\\\\char125}"; "'", "{\\\\textquotesingle}"; "`", "{\\\\textasciigrave}"; "\001b", "{\\\\char92}"; "\001l", "{\\\\char123}"; "\001\002", "\001"; ] val subst_strings_code = List.map (fun (x, y) -> (Str.regexp x, y)) [ "\001", "\001\002"; "\\\\", "\001b"; "{", "\001l"; "}", "{\\\\char125}"; "'", "{\\\\textquotesingle}"; "`", "{\\\\textasciigrave}"; "%", "\\\\%"; "_", "\\\\_"; "~", "{\\\\char126}"; "#", "{\\\\char35}"; "&", "\\\\&"; "\\$", "\\\\$"; "\\^", "{\\\\char94}"; "\001b", "{\\\\char92}"; "\001l", "{\\\\char123}"; "\001\002", "\001"; ] method subst l s = List.fold_left (fun acc (re, st) -> Str.global_replace re st acc) s l (** 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 = !latex_value_prefix^(self#label ?no_ name) (** Make a correct label from an attribute name. *) method attribute_label ?no_ name = !latex_attribute_prefix^(self#label ?no_ name) (** Make a correct label from a method name. *) method method_label ?no_ name = !latex_method_prefix^(self#label ?no_ name) (** Make a correct label from a class name. *) method class_label ?no_ name = !latex_class_prefix^(self#label ?no_ name) (** Make a correct label from a class type name. *) method class_type_label ?no_ name = !latex_class_type_prefix^(self#label ?no_ name) (** Make a correct label from a module name. *) method module_label ?no_ name = !latex_module_prefix^(self#label ?no_ name) (** Make a correct label from a module type name. *) method module_type_label ?no_ name = !latex_module_type_prefix^(self#label ?no_ name) (** Make a correct label from an extension name. *) method extension_label ?no_ name = !latex_extension_prefix^(self#label ?no_ name) (** Make a correct label from an exception name. *) method exception_label ?no_ name = !latex_exception_prefix^(self#label ?no_ name) (** Make a correct label from a type name. *) method type_label ?no_ name = !latex_type_prefix^(self#label ?no_ name) (** Make a correct label from a record field. *) method recfield_label ?no_ name = !latex_type_elt_prefix^(self#label ?no_ name) (** Make a correct label from a variant constructor. *) method const_label ?no_ name = !latex_type_elt_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 txt = match txt 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 _ _ _ = () method latex_of_Target fmt ~target ~code = if String.lowercase_ascii 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 "\n\\begin{verbatim}\n"; ps fmt s; ps fmt "\n\\end{verbatim}\n" 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 _) -> let text = match text_opt with | None -> [] | Some x -> x in let label= self#make_ref (self#label ~no_:false (Name.simple name)) in self#latex_of_text fmt (text @ [Latex ("["^label^"]")] ) | 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_extension -> self#extension_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 | Odoc_info.RK_recfield -> self#recfield_label | Odoc_info.RK_const -> self#const_label 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 optional 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 module Generator = struct (** 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, v) = ps fmt (Odoc_info.string_of_variance t v); ps fmt (self#normal_type m_name p) in match t.ty_parameters with [] -> () | [t] -> print_one t | _ -> 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) method entry_comment (fmt,flush) = function | None -> [] | Some t -> let s = ps fmt "\\begin{ocamldoccomment}\n"; self#latex_of_info fmt (Some t); ps fmt "\n\\end{ocamldoccomment}\n"; flush () in [ Latex s] (** record printing method *) method latex_of_record ( (fmt,flush) as f) mod_name l = p fmt "{"; let fields = List.map (fun r -> let s_field = p fmt "@[ %s%s :@ %s ;" (if r.rf_mutable then "mutable " else "") r.rf_name (self#normal_type mod_name r.rf_type); flush () in [ CodePre s_field ] @ (self#entry_comment f r.rf_text) ) l in List.flatten fields @ [ CodePre "}" ] method latex_of_cstr_args ( (fmt,flush) as f) mod_name (args, ret) = match args, ret with | Cstr_tuple [], None -> [CodePre(flush())] | Cstr_tuple _ as l, None -> p fmt " of@ %s" (self#normal_cstr_args ~par:false mod_name l); [CodePre (flush())] | Cstr_tuple t as l, Some r -> let res = self#normal_type mod_name r in if t = [] then p fmt " :@ %s" res else p fmt " :@ %s -> %s" (self#normal_cstr_args ~par:false mod_name l) res ; [CodePre (flush())] | Cstr_record l, None -> p fmt " of@ "; self#latex_of_record f mod_name l | Cstr_record r, Some res -> let l = p fmt " :@ "; self#latex_of_record f mod_name r in let l2 = p fmt "@ %s@ %s" "->" (self#normal_type mod_name res); [CodePre (flush())] in l @ l2 (** 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) as f) = new_fmt () in Odoc_info.reset_type_names () ; let mod_name = Name.father t.ty_name in Format.fprintf fmt2 "@[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 | Some (Other 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 -> begin match t.ty_manifest with | Some (Object_type _) -> "= " ^ (if priv then "private" else "") ^ " <" | _ -> "" end | Type_variant _ -> "="^(if priv then " private" else "") | Type_record _ -> "= "^(if priv then "private " else "") | Type_open -> "= .." ) ; flush2 () in let defs = match t.ty_kind with | Type_abstract -> begin match t.ty_manifest with | Some (Object_type l) -> let fields = List.map (fun r -> let s_field = p fmt2 "@[ %s :@ %s ;" r.of_name (self#normal_type mod_name r.of_type); flush2 () in [ CodePre s_field ] @ (self#entry_comment f r.of_text) ) l in List.flatten fields @ [ CodePre ">" ] | None | Some (Other _) -> [] end | Type_variant l -> if l = [] then (p fmt2 "@[ |"; [CodePre (flush2())]) else ( let constructors = List.map (fun {vc_name; vc_args; vc_ret; vc_text} -> p fmt2 "@[ | %s" vc_name ; let l = self#latex_of_cstr_args f mod_name (vc_args,vc_ret) in l @ (self#entry_comment f vc_text) ) l in List.flatten constructors) | Type_record l -> self#latex_of_record f mod_name l | Type_open -> (* FIXME ? *) [] in let defs2 = (CodePre s_type3) :: defs in (merge_codepre 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 a type extension. *) method latex_of_type_extension mod_name fmt te = let text = let (fmt2, flush2) as f = new_fmt () in Odoc_info.reset_type_names () ; Format.fprintf fmt2 "@[type "; ( match te.te_type_parameters with [] -> () | [p] -> ps fmt2 (self#normal_type mod_name p); ps fmt2 " " | l -> ps fmt2 "("; print_concat fmt2 ", " (fun p -> ps fmt2 (self#normal_type mod_name p)) l; ps fmt2 ") " ); ps fmt2 (self#relative_idents mod_name te.te_type_name); p fmt2 " +=%s" (if te.te_private = Asttypes.Private then " private" else "") ; let s_type3 = flush2 () in let defs = (List.flatten (List.map (fun x -> let father = Name.father x.xt_name in p fmt2 "@[ | %s" (Name.simple x.xt_name); let l = self#latex_of_cstr_args f father (x.xt_args, x.xt_ret) in let c = match x.xt_alias with | None -> [] | Some xa -> p fmt2 " = %s" ( match xa.xa_xt with | None -> xa.xa_name | Some x -> x.xt_name ); [CodePre (flush2 ())] in Latex (self#make_label (self#extension_label x.xt_name)) :: l @ c @ (match x.xt_text with None -> [] | Some t -> let s = ps fmt2 "\\begin{ocamldoccomment}\n"; self#latex_of_info fmt2 (Some t); ps fmt2 "\n\\end{ocamldoccomment}\n"; flush2 () in [ Latex s] ) ) te.te_constructors ) ) in let defs2 = (CodePre s_type3) :: defs in (merge_codepre defs2) @ (self#text_of_info te.te_info) in self#latex_of_text fmt text (** Print LaTeX code for an exception. *) method latex_of_exception fmt e = let text = let (fmt2, flush2) as f = new_fmt() in Odoc_info.reset_type_names () ; let s_name = Name.simple e.ex_name in let father = Name.father e.ex_name in p fmt2 "@[exception %s" s_name; let l = self#latex_of_cstr_args f father (e.ex_args, e.ex_ret) in let s = match e.ex_alias with None -> [] | Some ea -> Format.fprintf fmt " = %s" ( match ea.ea_ex with None -> ea.ea_name | Some e -> e.ex_name ); [CodePre (flush2 ())] in Latex ( self#make_label (self#exception_label e.ex_name) ) :: merge_codepre (l @ s ) @ [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @ (self#text_of_info e.ex_info) in self#latex_of_text fmt text 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: application is not correct in a .mli. Fix? -> print the typedtree module_type *) 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_apply_unit k1 -> self#latex_of_module_kind fmt father k1; self#latex_of_text fmt [Code "()"] | Module_with (k, s) -> (* TODO: modify when Module_with will be more detailed *) 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: what should we print? *) 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 _ -> (* TODO: print final type from 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 "@["; 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 _, 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 "@["; 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 "@["; ); ( 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 constr *) ( 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 "@["; (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 "@["; 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_type_extension te -> self#latex_of_type_extension module_name fmt te | 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 = let title = if m.m_text_only then [Raw m.m_name] else [ Raw (Odoc_messages.modul^" ") ; Code m.m_name ] in let subtitle = match first_t with | [] -> [] | t -> (Raw " : ") :: t in [ Title (0, None, title @ subtitle ) ] 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{textcomp}\n"; ps fmt "\\usepackage{fullpage} \n"; ps fmt "\\usepackage{url} \n"; ps fmt "\\usepackage{ocamldoc}\n"; ( match !Global.title with None -> () | Some s -> ps fmt "\\title{"; ps fmt (self#escape s); ps fmt "}\n" ); ps fmt "\\begin{document}\n"; (match !Global.title with None -> () | Some _ -> ps fmt "\\maketitle\n" ); if !Global.with_toc then ps fmt "\\tableofcontents\n"; ( let info = Odoc_info.apply_opt (Odoc_info.info_of_comment_file module_list) !Odoc_info.Global.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 exist. *) method generate_style_file = try let dir = Filename.dirname !Global.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.Global.out_file} file. *) method generate module_list = self#generate_style_file ; let main_file = !Global.out_file in let dir = Filename.dirname main_file in if !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 !Global.with_header then self#latex_header fmt module_list; List.iter (fun m -> if !separate_files then ps fmt ("\\input{"^((Name.simple m.m_name))^".tex}\n") else self#generate_for_top_module fmt m ) module_list ; if !Global.with_trailer then ps fmt "\\end{document}\n"; Format.pp_print_flush fmt (); close_out chanout with Failure s | Sys_error s -> prerr_endline s ; incr Odoc_info.errors end end module type Latex_generator = module type of Generator