1313 lines
45 KiB
OCaml
1313 lines
45 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* OCaml *)
|
|
(* *)
|
|
(* Olivier Andrieu, base sur du code de Maxence Guesdon *)
|
|
(* *)
|
|
(* 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 Texinfo documentation. *)
|
|
|
|
open Odoc_info
|
|
open Value
|
|
open Type
|
|
open Extension
|
|
open Exception
|
|
open Class
|
|
open Module
|
|
|
|
let esc_8bits = ref false
|
|
|
|
let info_section = ref "OCaml"
|
|
|
|
let info_entry = ref []
|
|
|
|
(** {1 Some small helper functions} *)
|
|
|
|
let puts_nl chan s =
|
|
output_string chan s ;
|
|
output_char chan '\n'
|
|
let puts chan s =
|
|
output_string chan s
|
|
let nl chan =
|
|
output_char chan '\n'
|
|
|
|
let is = function
|
|
| None -> false
|
|
| Some _ -> true
|
|
|
|
let pad_to n s =
|
|
let len = String.length s in
|
|
if len < n then s ^ String.make (n - len) ' ' else s
|
|
|
|
let indent nb_sp s =
|
|
let c = ref 0 in
|
|
let len = pred (String.length s) in
|
|
for i = 0 to len do if s.[i] = '\n' then incr c done ;
|
|
let s' = Bytes.make (succ len + (succ !c) * nb_sp ) ' ' in
|
|
c := nb_sp ;
|
|
for i = 0 to len do
|
|
Bytes.set s' !c s.[i] ;
|
|
if s.[i] = '\n' then c := !c + nb_sp ;
|
|
incr c
|
|
done ;
|
|
Bytes.to_string s'
|
|
|
|
type subparts = [
|
|
| `Module of Odoc_info.Module.t_module
|
|
| `Module_type of Odoc_info.Module.t_module_type
|
|
| `Class of Odoc_info.Class.t_class
|
|
| `Class_type of Odoc_info.Class.t_class_type
|
|
]
|
|
|
|
type menu_data = [
|
|
| subparts
|
|
| `Blank
|
|
| `Comment of string
|
|
| `Texi of string
|
|
| `Index of string
|
|
] list
|
|
|
|
let nothing = Verbatim ""
|
|
|
|
let module_subparts =
|
|
let rec iter acc = function
|
|
| [] -> List.rev acc
|
|
(* skip aliases *)
|
|
| Element_module { m_kind = Module_alias _ } :: n ->
|
|
iter acc n
|
|
| Element_module_type { mt_kind = Some (Module_type_alias _) } :: n ->
|
|
iter acc n
|
|
(* keep modules, module types, classes and class types *)
|
|
| Element_module m :: n ->
|
|
iter (`Module m :: acc) n
|
|
| Element_module_type mt :: n ->
|
|
iter (`Module_type mt :: acc) n
|
|
| Element_class c :: n ->
|
|
iter (`Class c :: acc) n
|
|
| Element_class_type ct :: n ->
|
|
iter (`Class_type ct :: acc) n
|
|
(* forget the rest *)
|
|
| _ :: n -> iter acc n
|
|
in
|
|
iter []
|
|
|
|
type indices = [
|
|
| `Type
|
|
| `Extension
|
|
| `Exception
|
|
| `Value
|
|
| `Class_att
|
|
| `Method
|
|
| `Class
|
|
| `Class_type
|
|
| `Module
|
|
| `Module_type
|
|
]
|
|
|
|
let indices = function
|
|
| `Type -> "ty"
|
|
| `Extension -> "xt"
|
|
| `Exception -> "ex"
|
|
| `Value -> "va"
|
|
| `Class_att -> "ca"
|
|
| `Method -> "me"
|
|
| `Class -> "cl"
|
|
| `Class_type -> "ct"
|
|
| `Module -> "mo"
|
|
| `Module_type -> "mt"
|
|
|
|
let indices_names = [
|
|
"Types" , "ty" ;
|
|
"Extensions" , "xt" ;
|
|
"Exceptions" , "ex" ;
|
|
"Values" , "va" ;
|
|
"Class attributes", "ca" ;
|
|
"Methods" , "me" ;
|
|
"Classes" , "cl" ;
|
|
"Class types" , "ct" ;
|
|
"Modules" , "mo" ;
|
|
"Module types" , "mt" ; ]
|
|
|
|
|
|
|
|
(** Module for generating various Texinfo things (menus, xrefs, ...) *)
|
|
module Texi =
|
|
struct
|
|
(** Associations of strings to substitute in Texinfo code. *)
|
|
let subst_strings = [
|
|
(Str.regexp "@", "@@") ;
|
|
(Str.regexp "{", "@{") ;
|
|
(Str.regexp "}", "@}") ;
|
|
(Str.regexp "\\.\\.\\.", "@dots{}") ;
|
|
] @
|
|
(if !esc_8bits
|
|
then [
|
|
(Str.regexp "\xE0", "@`a") ;
|
|
(Str.regexp "\xE2", "@^a") ;
|
|
(Str.regexp "\xE9", "@'e") ;
|
|
(Str.regexp "\xE8", "@`e") ;
|
|
(Str.regexp "\xEA", "@^e") ;
|
|
(Str.regexp "\xEB", "@\"e") ;
|
|
(Str.regexp "\xF7", "@,{c}") ;
|
|
(Str.regexp "\xF4", "@^o") ;
|
|
(Str.regexp "\xF6", "@\"o") ;
|
|
(Str.regexp "\xEE", "@^i") ;
|
|
(Str.regexp "\xEF", "@\"i") ;
|
|
(Str.regexp "\xF9", "@`u") ;
|
|
(Str.regexp "\xFB", "@^u") ;
|
|
(Str.regexp "\xE6", "@ae{}" ) ;
|
|
(Str.regexp "\xC6", "@AE{}" ) ;
|
|
(Str.regexp "\xDF", "@ss{}" ) ;
|
|
(Str.regexp "\xA9", "@copyright{}" ) ;
|
|
]
|
|
else [])
|
|
|
|
(** Escape the strings which would clash with Texinfo syntax. *)
|
|
let escape s =
|
|
List.fold_left
|
|
(fun acc (p, r) -> Str.global_replace p r acc)
|
|
s subst_strings
|
|
|
|
(** Removes dots (no good for a node name). *)
|
|
let fix_nodename s =
|
|
Str.global_replace (Str.regexp "\\.") "/" (escape s)
|
|
|
|
(** Generates a Texinfo menu. *)
|
|
let generate_menu chan subpart_list =
|
|
if subpart_list <> []
|
|
then begin
|
|
let menu_line part_qual name =
|
|
let sname = Name.simple name in
|
|
if sname = name
|
|
then (
|
|
puts chan (pad_to 35
|
|
("* " ^ sname ^ ":: ")) ;
|
|
puts_nl chan part_qual )
|
|
else (
|
|
puts chan (pad_to 35
|
|
("* " ^ sname ^ ": " ^ (fix_nodename name) ^ ". " )) ;
|
|
puts_nl chan part_qual )
|
|
in
|
|
puts_nl chan "@menu" ;
|
|
List.iter
|
|
(function
|
|
| `Module { m_name = name } ->
|
|
menu_line Odoc_messages.modul name
|
|
| `Module_type { mt_name = name } ->
|
|
menu_line Odoc_messages.module_type name
|
|
| `Class { cl_name = name } ->
|
|
menu_line Odoc_messages.clas name
|
|
| `Class_type { clt_name = name } ->
|
|
menu_line Odoc_messages.class_type name
|
|
| `Blank -> nl chan
|
|
| `Comment c -> puts_nl chan (escape c)
|
|
| `Texi t -> puts_nl chan t
|
|
| `Index ind -> Printf.fprintf chan "* %s::\n" ind)
|
|
subpart_list ;
|
|
puts_nl chan "@end menu"
|
|
end
|
|
|
|
(** cross reference to node [name] *)
|
|
let xref ?xname name =
|
|
"@xref{" ^ (fix_nodename name) ^
|
|
(match xname with | None -> "" | Some s -> "," ^ s) ^
|
|
"}."
|
|
|
|
(** enclose the string between [\@ifinfo] tags *)
|
|
let ifinfo s =
|
|
String.concat "\n"
|
|
[ "@ifinfo" ; s ; "@end ifinfo" ; "" ]
|
|
|
|
(** [install-info] information *)
|
|
let dirsection sec =
|
|
"@dircategory " ^ (escape sec)
|
|
|
|
let direntry ent =
|
|
[ "@direntry" ] @
|
|
(List.map escape ent) @
|
|
[ "@end direntry" ]
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
(** {1 Generation of Texinfo code} *)
|
|
|
|
(** {2 Associations between a title number and texinfo code.} *)
|
|
let titles_and_headings = ref [
|
|
0, ("@chapter ", "@majorheading ") ;
|
|
1, ("@chapter ", "@majorheading ") ;
|
|
2, ("@section ", "@heading ") ;
|
|
3, ("@subsection ", "@subheading ") ;
|
|
4, ("@subsubsection ", "@subsubheading ") ;
|
|
]
|
|
|
|
let title = fst
|
|
let heading = snd
|
|
|
|
let fallback_title =
|
|
"@unnumberedsubsubsec "
|
|
|
|
let fallback_heading =
|
|
"@subsubheading "
|
|
|
|
(** This class generates Texinfo code from text structures *)
|
|
class text =
|
|
object(self)
|
|
|
|
method escape =
|
|
Texi.escape
|
|
|
|
(** this method is not used here but is virtual
|
|
in a class we will inherit later *)
|
|
method label ?no_:(_ : bool option) (_ : string) : string =
|
|
failwith "gni"
|
|
|
|
(** Return the Texinfo code corresponding to the [text] parameter.*)
|
|
method texi_of_text t =
|
|
String.concat ""
|
|
(List.map self#texi_of_text_element t)
|
|
|
|
|
|
(** {2 Conversion methods}
|
|
[texi_of_????] converts a [text_element] to a Texinfo string. *)
|
|
|
|
(** Return the Texinfo code for the [text_element] in parameter. *)
|
|
method texi_of_text_element = function
|
|
| Verbatim s | Latex s -> self#texi_of_Verbatim s
|
|
| Raw s -> self#texi_of_Raw s
|
|
| Code s -> self#texi_of_Code s
|
|
| CodePre s -> self#texi_of_CodePre s
|
|
| Bold t -> self#texi_of_Bold t
|
|
| Italic t -> self#texi_of_Italic t
|
|
| Emphasize t -> self#texi_of_Emphasize t
|
|
| Center t -> self#texi_of_Center t
|
|
| Left t -> self#texi_of_Left t
|
|
| Right t -> self#texi_of_Right t
|
|
| List tl -> self#texi_of_List tl
|
|
| Enum tl -> self#texi_of_Enum tl
|
|
| Newline -> self#texi_of_Newline
|
|
| Block t -> self#texi_of_Block t
|
|
| Title (n, _, t) -> self#texi_of_Title n t
|
|
| Link (s, t) -> self#texi_of_Link s t
|
|
| Ref (name, kind, _) ->self#texi_of_Ref name kind
|
|
| Superscript t -> self#texi_of_Superscript t
|
|
| Subscript t -> self#texi_of_Subscript t
|
|
| Odoc_info.Module_list _ -> ""
|
|
| Odoc_info.Index_list -> ""
|
|
| Odoc_info.Custom (s,t) -> self#texi_of_custom_text s t
|
|
| Odoc_info.Target (target, code) -> self#texi_of_Target ~target ~code
|
|
|
|
method texi_of_custom_text _ _ = ""
|
|
|
|
method texi_of_Target ~target ~code =
|
|
if String.lowercase_ascii target = "texi" then code else ""
|
|
|
|
method texi_of_Verbatim s = s
|
|
method texi_of_Raw s = self#escape s
|
|
method texi_of_Code s = "@code{" ^ (self#escape s) ^ "}"
|
|
method texi_of_CodePre s =
|
|
String.concat "\n"
|
|
[ "" ; "@example" ; self#escape s ; "@end example" ; "" ]
|
|
method texi_of_Bold t = "@strong{" ^ (self#texi_of_text t) ^ "}"
|
|
method texi_of_Italic t = "@i{" ^ (self#texi_of_text t) ^ "}"
|
|
method texi_of_Emphasize t = "@emph{" ^ (self#texi_of_text t) ^ "}"
|
|
method texi_of_Center t =
|
|
let sl = Str.split (Str.regexp "\n") (self#texi_of_text t) in
|
|
String.concat ""
|
|
((List.map (fun s -> "\n@center "^s) sl) @ [ "\n" ])
|
|
method texi_of_Left t =
|
|
String.concat "\n"
|
|
[ "" ; "@flushleft" ; self#texi_of_text t ; "@end flushleft" ; "" ]
|
|
method texi_of_Right t =
|
|
String.concat "\n"
|
|
[ "" ; "@flushright" ; self#texi_of_text t ; "@end flushright"; "" ]
|
|
method texi_of_List tl =
|
|
String.concat "\n"
|
|
( [ "" ; "@itemize" ] @
|
|
(List.map (fun t -> "@item\n" ^ (self#texi_of_text t)) tl) @
|
|
[ "@end itemize"; "" ] )
|
|
method texi_of_Enum tl =
|
|
String.concat "\n"
|
|
( [ "" ; "@enumerate" ] @
|
|
(List.map (fun t -> "@item\n" ^ (self#texi_of_text t)) tl) @
|
|
[ "@end enumerate"; "" ] )
|
|
method texi_of_Newline = "\n"
|
|
method texi_of_Block t =
|
|
String.concat "\n"
|
|
[ "@format" ; self#texi_of_text t ; "@end format" ; "" ]
|
|
method texi_of_Title n t =
|
|
let t_begin =
|
|
try title @@ List.assoc n !titles_and_headings
|
|
with Not_found -> fallback_title in
|
|
t_begin ^ (self#texi_of_text t) ^ "\n"
|
|
method texi_of_Link s t =
|
|
String.concat ""
|
|
[ "@uref{" ; s ; "," ; self#texi_of_text t ; "}" ]
|
|
method texi_of_Ref name kind =
|
|
let xname =
|
|
match kind with
|
|
| Some RK_module ->
|
|
Odoc_messages.modul ^ " " ^ (Name.simple name)
|
|
| Some RK_module_type ->
|
|
Odoc_messages.module_type ^ " " ^ (Name.simple name)
|
|
| Some RK_class ->
|
|
Odoc_messages.clas ^ " " ^ (Name.simple name)
|
|
| Some RK_class_type ->
|
|
Odoc_messages.class_type ^ " " ^ (Name.simple name)
|
|
| _ -> ""
|
|
in
|
|
if xname = "" then self#escape name else Texi.xref ~xname name
|
|
method texi_of_Superscript t =
|
|
"^@{" ^ (self#texi_of_text t) ^ "@}"
|
|
method texi_of_Subscript t =
|
|
"_@{" ^ (self#texi_of_text t) ^ "@}"
|
|
|
|
method heading n t =
|
|
let f =
|
|
try heading @@ List.assoc n !titles_and_headings
|
|
with Not_found -> fallback_heading
|
|
in
|
|
f ^ (self#texi_of_text t) ^ "\n"
|
|
|
|
method fixedblock t =
|
|
Block ( ( Verbatim "@t{" :: t ) @ [ Verbatim "}" ] )
|
|
|
|
end
|
|
|
|
exception Aliased_node
|
|
|
|
module Generator =
|
|
struct
|
|
|
|
(** This class is used to create objects which can generate a simple
|
|
Texinfo documentation. *)
|
|
class texi =
|
|
object (self)
|
|
inherit text
|
|
inherit Odoc_to_text.to_text as to_text
|
|
|
|
(** {2 Small helper stuff.} *)
|
|
|
|
val maxdepth = 4
|
|
|
|
val bullet = Verbatim " @bullet{} "
|
|
val minus = Verbatim " @minus{} "
|
|
val linebreak = Verbatim "@*\n"
|
|
|
|
val mutable indices_to_build = [ `Module ]
|
|
|
|
(** Keep a set of nodes we create. If we try to create one
|
|
a second time, that means it is some kind of alias, so
|
|
don't do it, just link to the previous one *)
|
|
val node_tbl = Hashtbl.create 37
|
|
|
|
method node depth name =
|
|
if Hashtbl.mem node_tbl name
|
|
then raise Aliased_node ;
|
|
Hashtbl.add node_tbl name () ;
|
|
if depth <= maxdepth
|
|
then Verbatim ("@node " ^ (Texi.fix_nodename name) ^ ",\n")
|
|
else nothing
|
|
|
|
method index (ind : indices) ent =
|
|
Verbatim
|
|
(if !Global.with_index
|
|
then (assert(List.mem ind indices_to_build) ;
|
|
String.concat ""
|
|
[ "@" ; indices ind ; "index " ;
|
|
Texi.escape (Name.simple ent) ; "\n" ])
|
|
else "")
|
|
|
|
|
|
(** Two hacks to fix linebreaks in the descriptions.*)
|
|
method private fix_linebreaks =
|
|
let re = Str.regexp "\n[ \t]*" in
|
|
fun t ->
|
|
List.map
|
|
(function
|
|
| Newline -> Raw "\n"
|
|
| Raw s -> Raw (Str.global_replace re "\n" s)
|
|
| List tel -> List (List.map self#fix_linebreaks tel)
|
|
| Enum tel -> Enum (List.map self#fix_linebreaks tel)
|
|
| txt -> txt) t
|
|
|
|
method private soft_fix_linebreaks =
|
|
let re = Str.regexp "\n[ \t]*" in
|
|
fun ind t ->
|
|
let rep = "\n" ^ String.make ind ' ' in
|
|
List.map
|
|
(function
|
|
| Raw s -> Raw (Str.global_replace re rep s)
|
|
| txt -> txt) t
|
|
|
|
(** {2 [text] values generation}
|
|
Generates [text] values out of description parts.
|
|
Redefines some of methods of {! Odoc_to_text.to_text}. *)
|
|
|
|
method text_of_desc = function
|
|
| None -> []
|
|
| Some [ Raw "" ] -> []
|
|
| Some t -> (self#fix_linebreaks t) @ [ Newline ]
|
|
|
|
method text_of_sees_opt see_l =
|
|
List.concat
|
|
(List.map
|
|
(function
|
|
| (See_url s, t) ->
|
|
[ linebreak ; Bold [ Raw Odoc_messages.see_also ] ;
|
|
Raw " " ; Link (s, t) ; Newline ]
|
|
| (See_file s, t)
|
|
| (See_doc s, t) ->
|
|
[ linebreak ; Bold [ Raw Odoc_messages.see_also ] ;
|
|
Raw " " ; Raw s ] @ t @ [ Newline ])
|
|
see_l)
|
|
|
|
method! text_of_before l =
|
|
List.flatten
|
|
(List.map
|
|
(fun x -> linebreak :: (to_text#text_of_before [x])) l)
|
|
|
|
method text_of_params params_list =
|
|
List.concat
|
|
(List.map
|
|
(fun (s, t) ->
|
|
[ linebreak ;
|
|
Bold [ Raw Odoc_messages.parameters ] ;
|
|
Raw " " ; Raw s ; Raw ": " ] @ t @ [ Newline ] )
|
|
params_list)
|
|
|
|
method! text_of_raised_exceptions = function
|
|
| [] -> []
|
|
| (s, t) :: [] ->
|
|
[ linebreak ;
|
|
Bold [ Raw Odoc_messages.raises ] ;
|
|
Raw " " ; Code s ; Raw " " ]
|
|
@ t @ [ Newline ]
|
|
| l ->
|
|
[ linebreak ;
|
|
Bold [ Raw Odoc_messages.raises ] ;
|
|
Raw " :" ;
|
|
List
|
|
(List.map
|
|
(fun (ex, desc) ->(Code ex) :: (Raw " ") :: desc ) l ) ;
|
|
Newline ]
|
|
|
|
method! text_of_return_opt = function
|
|
| None -> []
|
|
| Some t ->
|
|
(Bold [Raw Odoc_messages.returns ]) :: Raw " " :: t @ [ Newline ]
|
|
|
|
method! text_of_custom c_l =
|
|
List.flatten
|
|
(List.rev
|
|
(List.fold_left
|
|
(fun acc -> fun (tag, text) ->
|
|
try
|
|
let f = List.assoc tag tag_functions in
|
|
( linebreak :: (f text) @ [ Newline ] ) :: acc
|
|
with
|
|
Not_found ->
|
|
Odoc_info.warning (Odoc_messages.tag_not_handled tag) ;
|
|
acc
|
|
) [] c_l))
|
|
|
|
method! text_of_info ?(block=false) = function
|
|
| None -> []
|
|
| Some info ->
|
|
let t =
|
|
List.concat
|
|
[ ( match info.i_deprecated with
|
|
| None -> []
|
|
| Some t ->
|
|
(Raw (Odoc_messages.deprecated ^ " ")) ::
|
|
(self#fix_linebreaks t)
|
|
@ [ Newline ; Newline ] ) ;
|
|
self#text_of_desc info.i_desc ;
|
|
if info.i_authors <> []
|
|
then ( linebreak ::
|
|
self#text_of_author_list info.i_authors )
|
|
else [] ;
|
|
if is info.i_version
|
|
then ( linebreak ::
|
|
self#text_of_version_opt info.i_version )
|
|
else [] ;
|
|
self#text_of_sees_opt info.i_sees ;
|
|
self#text_of_before info.i_before ;
|
|
if is info.i_since
|
|
then ( linebreak ::
|
|
self#text_of_since_opt info.i_since )
|
|
else [] ;
|
|
self#text_of_params info.i_params ;
|
|
self#text_of_raised_exceptions info.i_raised_exceptions ;
|
|
if is info.i_return_value
|
|
then ( linebreak ::
|
|
self#text_of_return_opt info.i_return_value )
|
|
else [] ;
|
|
self#text_of_custom info.i_custom ;
|
|
] in
|
|
if block
|
|
then [ Block t ]
|
|
else (t @ [ Newline ] )
|
|
|
|
method texi_of_info i =
|
|
self#texi_of_text (self#text_of_info i)
|
|
|
|
(** {2 Conversion of [module_elements] into Texinfo strings}
|
|
The following functions convert [module_elements] and their
|
|
description to [text] values then to Texinfo strings using the
|
|
functions above. *)
|
|
|
|
method text_el_of_type_expr m_name typ =
|
|
Raw (indent 5
|
|
(self#relative_idents m_name
|
|
(Odoc_info.string_of_type_expr typ)))
|
|
|
|
method! text_of_short_type_expr m_name typ =
|
|
[ Raw (self#normal_type m_name typ) ]
|
|
|
|
(** Return Texinfo code for a value. *)
|
|
method texi_of_value v =
|
|
Odoc_info.reset_type_names () ;
|
|
let t = [ self#fixedblock
|
|
[ Newline ; minus ;
|
|
Raw ("val " ^ (Name.simple v.val_name) ^ " :\n") ;
|
|
self#text_el_of_type_expr
|
|
(Name.father v.val_name) v.val_type ] ;
|
|
self#index `Value v.val_name ; Newline ] @
|
|
(self#text_of_info v.val_info) in
|
|
self#texi_of_text t
|
|
|
|
|
|
(** Return Texinfo code for a class attribute. *)
|
|
method texi_of_attribute a =
|
|
Odoc_info.reset_type_names () ;
|
|
let t = [ self#fixedblock
|
|
[ Newline ; minus ;
|
|
Raw "val " ;
|
|
Raw (if a.att_virtual then "virtual " else "") ;
|
|
Raw (if a.att_mutable then "mutable " else "") ;
|
|
Raw (Name.simple a.att_value.val_name) ;
|
|
Raw " :\n" ;
|
|
self#text_el_of_type_expr
|
|
(Name.father a.att_value.val_name)
|
|
a.att_value.val_type ] ;
|
|
self#index `Class_att a.att_value.val_name ; Newline ] @
|
|
(self#text_of_info a.att_value.val_info) in
|
|
self#texi_of_text t
|
|
|
|
|
|
(** Return Texinfo code for a class method. *)
|
|
method texi_of_method m =
|
|
Odoc_info.reset_type_names () ;
|
|
let t = [ self#fixedblock
|
|
[ Newline ; minus ; Raw "method " ;
|
|
Raw (if m.met_private then "private " else "") ;
|
|
Raw (if m.met_virtual then "virtual " else "") ;
|
|
Raw (Name.simple m.met_value.val_name) ;
|
|
Raw " :\n" ;
|
|
self#text_el_of_type_expr
|
|
(Name.father m.met_value.val_name)
|
|
m.met_value.val_type ] ;
|
|
self#index `Method m.met_value.val_name ; Newline ] @
|
|
(self#text_of_info m.met_value.val_info) in
|
|
self#texi_of_text t
|
|
|
|
|
|
method string_of_type_parameters t =
|
|
let f (tp, co, cn) =
|
|
Printf.sprintf "%s%s"
|
|
(Odoc_info.string_of_variance t (co, cn))
|
|
(Odoc_info.string_of_type_expr tp)
|
|
in
|
|
match t.ty_parameters with
|
|
| [] -> ""
|
|
| [ (tp, co, cn) ] ->
|
|
(f (tp, co, cn))^" "
|
|
| l ->
|
|
Printf.sprintf "(%s) "
|
|
(String.concat ", " (List.map f l))
|
|
|
|
method string_of_type_args (args:constructor_args) (ret:Types.type_expr option) =
|
|
let f = function
|
|
| Cstr_tuple l -> Odoc_info.string_of_type_list " * " l
|
|
| Cstr_record l -> Odoc_info.string_of_record l
|
|
in
|
|
match args, ret with
|
|
| Cstr_tuple [], None -> ""
|
|
| args, None -> " of " ^ (f args)
|
|
| Cstr_tuple [], Some r -> " : " ^ (Odoc_info.string_of_type_expr r)
|
|
| args, Some r -> " : " ^ (f args) ^
|
|
" -> " ^ (Odoc_info.string_of_type_expr r)
|
|
|
|
(** Return Texinfo code for a type. *)
|
|
method texi_of_type ty =
|
|
Odoc_info.reset_type_names () ;
|
|
let entry_doc = function
|
|
| None -> [ Newline ]
|
|
| Some t ->
|
|
(Raw (indent 5 "\n(*\n") :: (self#soft_fix_linebreaks 8 (self#text_of_info (Some t))))
|
|
@ [ Raw " *)" ; Newline ]
|
|
in
|
|
let t =
|
|
[ self#fixedblock (
|
|
[ Newline ; minus ; Raw "type " ;
|
|
Raw (self#string_of_type_parameters ty) ;
|
|
Raw (Name.simple ty.ty_name) ] @
|
|
let priv = ty.ty_private = Asttypes.Private in
|
|
( match ty.ty_manifest with
|
|
| None -> []
|
|
| Some (Other typ) ->
|
|
(Raw " = ") ::
|
|
(Raw (if priv then "private " else "")) ::
|
|
(self#text_of_short_type_expr (Name.father ty.ty_name) typ)
|
|
| Some (Object_type l) ->
|
|
(Raw (" = "^(if priv then "private " else "")^"{\n")) ::
|
|
(List.flatten
|
|
(List.map
|
|
(fun r ->
|
|
[ Raw (" " ^ r.of_name ^ " : ") ] @
|
|
(self#text_of_short_type_expr
|
|
(Name.father r.of_name)
|
|
r.of_type) @
|
|
[ Raw " ;" ] @
|
|
(entry_doc r.of_text))
|
|
l ) )
|
|
@ [ Raw " }" ]
|
|
) @
|
|
(
|
|
match ty.ty_kind with
|
|
| Type_abstract -> [ Newline ]
|
|
| Type_variant l ->
|
|
(Raw (" ="^(if priv then " private" else "")^"\n")) ::
|
|
(List.flatten
|
|
(List.map
|
|
(fun constr ->
|
|
(Raw (" | " ^ constr.vc_name)) ::
|
|
(Raw (self#string_of_type_args
|
|
constr.vc_args constr.vc_ret)) ::
|
|
(entry_doc constr.vc_text)
|
|
) l ) )
|
|
| Type_record l ->
|
|
(Raw (" = "^(if priv then "private " else "")^"{\n")) ::
|
|
(List.flatten
|
|
(List.map
|
|
(fun r ->
|
|
[ Raw (" " ^ r.rf_name ^ " : ") ] @
|
|
(self#text_of_short_type_expr
|
|
(Name.father r.rf_name)
|
|
r.rf_type) @
|
|
[ Raw " ;" ] @
|
|
(entry_doc r.rf_text)
|
|
)
|
|
l ) )
|
|
@ [ Raw " }" ]
|
|
| Type_open -> [ Raw " = .." ; Newline ]
|
|
) ) ;
|
|
self#index `Type ty.ty_name ; Newline ] @
|
|
(self#text_of_info ty.ty_info) in
|
|
self#texi_of_text t
|
|
|
|
(** Return Texinfo code for a type extension. *)
|
|
method texi_of_type_extension m_name te =
|
|
Odoc_info.reset_type_names () ;
|
|
let t =
|
|
( self#fixedblock (
|
|
[ Newline ; minus ;
|
|
Raw "type " ;
|
|
Raw (match te.te_type_parameters with
|
|
| [] -> ""
|
|
| [ tp ] ->
|
|
Printf.sprintf "%s "
|
|
(Odoc_info.string_of_type_expr tp)
|
|
| l ->
|
|
Printf.sprintf "(%s) "
|
|
(String.concat ", "
|
|
(List.map Odoc_info.string_of_type_expr l))) ;
|
|
Raw (self#relative_idents m_name te.te_type_name) ;
|
|
Raw (" +=" ^
|
|
(if te.te_private = Asttypes.Private
|
|
then " private" else "")^"\n") ] @
|
|
(List.flatten
|
|
(List.map
|
|
(fun x ->
|
|
(Raw (" | " ^ (Name.simple x.xt_name))) ::
|
|
(Raw (self#string_of_type_args
|
|
x.xt_args x.xt_ret)) ::
|
|
(match x.xt_alias with
|
|
| None -> []
|
|
| Some xa ->
|
|
[ Raw " = " ;
|
|
Raw ( match xa.xa_xt with
|
|
| None -> xa.xa_name
|
|
| Some x -> x.xt_name ) ]) @
|
|
(match x.xt_text with
|
|
| None -> [ Newline ]
|
|
| Some t ->
|
|
(Raw (indent 5 "\n(* ") ::
|
|
self#soft_fix_linebreaks 8
|
|
(self#text_of_info (Some t))) @
|
|
[ Raw " *)" ; Newline ] ) @
|
|
[self#index `Extension x.xt_name ] )
|
|
te.te_constructors ) ) ) ) ::
|
|
(self#text_of_info te.te_info) in
|
|
self#texi_of_text t
|
|
|
|
(** Return Texinfo code for an exception. *)
|
|
method texi_of_exception e =
|
|
Odoc_info.reset_type_names () ;
|
|
let t =
|
|
[ self#fixedblock
|
|
( [ Newline ; minus ; Raw "exception " ;
|
|
Raw (Name.simple e.ex_name) ;
|
|
Raw (self#string_of_type_args e.ex_args e.ex_ret) ] @
|
|
(match e.ex_alias with
|
|
| None -> []
|
|
| Some ea -> [ Raw " = " ; Raw
|
|
( match ea.ea_ex with
|
|
| None -> ea.ea_name
|
|
| Some e -> e.ex_name ) ; ]
|
|
) ) ;
|
|
self#index `Exception e.ex_name ; Newline ] @
|
|
(self#text_of_info e.ex_info) in
|
|
self#texi_of_text t
|
|
|
|
|
|
(** Return the Texinfo code for the given module. *)
|
|
method texi_of_module m =
|
|
let is_alias = function
|
|
| { m_kind = Module_alias _ } -> true
|
|
| _ -> false in
|
|
let is_alias_there = function
|
|
| { m_kind = Module_alias { ma_module = None } } -> false
|
|
| _ -> true in
|
|
let resolve_alias_name = function
|
|
| { m_kind = Module_alias { ma_name = name } } -> name
|
|
| { m_name = name } -> name in
|
|
let t =
|
|
[ [ self#fixedblock
|
|
[ Newline ; minus ; Raw "module " ;
|
|
Raw (Name.simple m.m_name) ;
|
|
Raw (if is_alias m
|
|
then " = " ^ (resolve_alias_name m)
|
|
else "" ) ] ] ;
|
|
( if is_alias_there m
|
|
then [ Ref (resolve_alias_name m, Some RK_module, None) ;
|
|
Newline ; ]
|
|
else [] ) ;
|
|
( if is_alias m
|
|
then [ self#index `Module m.m_name ; Newline ]
|
|
else [ Newline ] ) ;
|
|
self#text_of_info m.m_info ]
|
|
in
|
|
self#texi_of_text (List.flatten t)
|
|
|
|
(** Return the Texinfo code for the given module type. *)
|
|
method texi_of_module_type mt =
|
|
let is_alias = function
|
|
| { mt_kind = Some (Module_type_alias _) } -> true
|
|
| _ -> false in
|
|
let is_alias_there = function
|
|
| { mt_kind = Some (Module_type_alias { mta_module = None }) } -> false
|
|
| _ -> true in
|
|
let resolve_alias_name = function
|
|
| { mt_kind = Some (Module_type_alias { mta_name = name }) } -> name
|
|
| { mt_name = name } -> name in
|
|
let t =
|
|
[ [ self#fixedblock
|
|
[ Newline ; minus ; Raw "module type " ;
|
|
Raw (Name.simple mt.mt_name) ;
|
|
Raw (if is_alias mt
|
|
then " = " ^ (resolve_alias_name mt)
|
|
else "" ) ] ] ;
|
|
( if is_alias_there mt
|
|
then [ Ref (resolve_alias_name mt, Some RK_module_type, None) ;
|
|
Newline ; ]
|
|
else [] ) ;
|
|
( if is_alias mt
|
|
then [ self#index `Module_type mt.mt_name ; Newline ]
|
|
else [ Newline ] ) ;
|
|
self#text_of_info mt.mt_info ]
|
|
in
|
|
self#texi_of_text (List.flatten t)
|
|
|
|
(** Return the Texinfo code for the given included module. *)
|
|
method texi_of_included_module im =
|
|
let t = [ self#fixedblock
|
|
( Newline :: minus :: (Raw "include ") ::
|
|
( match im.im_module with
|
|
| None ->
|
|
[ Raw im.im_name ]
|
|
| Some (Mod { m_name = name }) ->
|
|
[ Raw name ; Raw "\n " ;
|
|
Ref (name, Some RK_module, None) ]
|
|
| Some (Modtype { mt_name = name }) ->
|
|
[ Raw name ; Raw "\n " ;
|
|
Ref (name, Some RK_module_type, None) ]
|
|
) @
|
|
[ Newline ] @
|
|
(self#text_of_info im.im_info)
|
|
)
|
|
]
|
|
in
|
|
self#texi_of_text t
|
|
|
|
(** Return the Texinfo code for the given class. *)
|
|
method texi_of_class c =
|
|
Odoc_info.reset_type_names () ;
|
|
let t = [ self#fixedblock
|
|
[ Newline ; minus ; Raw "class " ;
|
|
Raw (Name.simple c.cl_name) ] ;
|
|
Ref (c.cl_name, Some RK_class, None) ; Newline ;
|
|
Newline ] @ (self#text_of_info c.cl_info) in
|
|
self#texi_of_text t
|
|
|
|
(** Return the Texinfo code for the given class type. *)
|
|
method texi_of_class_type ct =
|
|
Odoc_info.reset_type_names () ;
|
|
let t = [ self#fixedblock
|
|
[ Newline ; minus ; Raw "class type " ;
|
|
Raw (Name.simple ct.clt_name) ] ;
|
|
Ref (ct.clt_name, Some RK_class_type, None) ; Newline ;
|
|
Newline ] @ (self#text_of_info ct.clt_info) in
|
|
self#texi_of_text t
|
|
|
|
(** Return the Texinfo code for the given class element. *)
|
|
method texi_of_class_element _class_name class_ele =
|
|
match class_ele with
|
|
| Class_attribute att -> self#texi_of_attribute att
|
|
| Class_method met -> self#texi_of_method met
|
|
| Class_comment t -> self#texi_of_text t
|
|
|
|
(** Return the Texinfo code for the given module element. *)
|
|
method texi_of_module_element module_name module_ele =
|
|
(match module_ele with
|
|
| Element_module m -> self#texi_of_module m
|
|
| Element_module_type mt -> self#texi_of_module_type mt
|
|
| Element_included_module im -> self#texi_of_included_module im
|
|
| Element_class c -> self#texi_of_class c
|
|
| Element_class_type ct -> self#texi_of_class_type ct
|
|
| Element_value v -> self#texi_of_value v
|
|
| Element_type_extension te -> self#texi_of_type_extension module_name te
|
|
| Element_exception e -> self#texi_of_exception e
|
|
| Element_type t -> self#texi_of_type t
|
|
| Element_module_comment t ->
|
|
self#texi_of_text (Newline :: t @ [Newline])
|
|
)
|
|
|
|
(** {2 Generating methods }
|
|
These methods write Texinfo code to an [out_channel] *)
|
|
|
|
(** Generate the Texinfo code for the given list of inherited classes.*)
|
|
method generate_inheritance_info chanout inher_l =
|
|
let f inh =
|
|
match inh.ic_class with
|
|
| None -> (* we can't make the reference *)
|
|
(Code inh.ic_name) ::
|
|
(match inh.ic_text with
|
|
| None -> []
|
|
| Some t -> Newline :: t)
|
|
| Some cct -> (* we can create the reference *)
|
|
let kind =
|
|
match cct with
|
|
| Cl _ -> Some RK_class
|
|
| Cltype _ -> Some RK_class_type in
|
|
(Code inh.ic_name) ::
|
|
(Ref (inh.ic_name, kind, None)) ::
|
|
( match inh.ic_text with
|
|
| None -> []
|
|
| Some t -> Newline :: t)
|
|
in
|
|
let text = [
|
|
Bold [ Raw Odoc_messages.inherits ] ;
|
|
List (List.map f inher_l) ; Newline ]
|
|
in
|
|
puts chanout (self#texi_of_text text)
|
|
|
|
|
|
|
|
(** Generate the Texinfo code for the inherited classes
|
|
of the given class. *)
|
|
method generate_class_inheritance_info chanout cl =
|
|
let rec iter_kind = function
|
|
| Class_structure ([], _) -> ()
|
|
| Class_structure (l, _) ->
|
|
self#generate_inheritance_info chanout l
|
|
| Class_constraint (k, _) -> iter_kind k
|
|
| Class_apply _
|
|
| Class_constr _ -> ()
|
|
in
|
|
iter_kind cl.cl_kind
|
|
|
|
|
|
|
|
(** Generate the Texinfo code for the inherited classes
|
|
of the given class type. *)
|
|
method generate_class_type_inheritance_info chanout clt =
|
|
match clt.clt_kind with
|
|
| Class_signature ([], _) ->
|
|
()
|
|
| Class_signature (l, _) ->
|
|
self#generate_inheritance_info chanout l
|
|
| Class_type _ ->
|
|
()
|
|
|
|
(** Generate the Texinfo code for the given class,
|
|
in the given out channel. *)
|
|
method generate_for_class chanout c =
|
|
try
|
|
Odoc_info.reset_type_names () ;
|
|
let depth = Name.depth c.cl_name in
|
|
let title = [
|
|
self#node depth c.cl_name ;
|
|
Title (depth, None, [ Raw (Odoc_messages.clas ^ " ") ;
|
|
Code c.cl_name ]) ;
|
|
self#index `Class c.cl_name ] in
|
|
puts chanout (self#texi_of_text title) ;
|
|
|
|
if is c.cl_info
|
|
then begin
|
|
let descr = [ Title (succ depth, None,
|
|
[ Raw Odoc_messages.description ]) ] in
|
|
puts chanout (self#texi_of_text descr) ;
|
|
puts chanout (self#texi_of_info c.cl_info)
|
|
end ;
|
|
|
|
let intf = [ Title (succ depth, None,
|
|
[ Raw Odoc_messages.interface]) ] in
|
|
puts chanout (self#texi_of_text intf);
|
|
self#generate_class_inheritance_info chanout c ;
|
|
List.iter
|
|
(fun ele -> puts chanout
|
|
(self#texi_of_class_element c.cl_name ele))
|
|
(Class.class_elements ~trans:false c)
|
|
with Aliased_node -> ()
|
|
|
|
|
|
(** Generate the Texinfo code for the given class type,
|
|
in the given out channel. *)
|
|
method generate_for_class_type chanout ct =
|
|
try
|
|
Odoc_info.reset_type_names () ;
|
|
let depth = Name.depth ct.clt_name in
|
|
let title = [
|
|
self#node depth ct.clt_name ;
|
|
Title (depth, None, [ Raw (Odoc_messages.class_type ^ " ") ;
|
|
Code ct.clt_name ]) ;
|
|
self#index `Class_type ct.clt_name ] in
|
|
puts chanout (self#texi_of_text title) ;
|
|
|
|
if is ct.clt_info
|
|
then begin
|
|
let descr = [ Title (succ depth, None,
|
|
[ Raw Odoc_messages.description ]) ] in
|
|
puts chanout (self#texi_of_text descr) ;
|
|
puts chanout (self#texi_of_info ct.clt_info)
|
|
end ;
|
|
|
|
let intf = [ Title (succ depth, None,
|
|
[ Raw Odoc_messages.interface ]) ] in
|
|
puts chanout (self#texi_of_text intf) ;
|
|
self#generate_class_type_inheritance_info chanout ct;
|
|
List.iter
|
|
(fun ele -> puts chanout
|
|
(self#texi_of_class_element ct.clt_name ele))
|
|
(Class.class_type_elements ~trans:false ct)
|
|
with Aliased_node -> ()
|
|
|
|
|
|
(** Generate the Texinfo code for the given module type,
|
|
in the given out channel. *)
|
|
method generate_for_module_type chanout mt =
|
|
try
|
|
let depth = Name.depth mt.mt_name in
|
|
let title = [
|
|
self#node depth mt.mt_name ;
|
|
Title (depth, None, [ Raw (Odoc_messages.module_type ^ " ") ;
|
|
Code mt.mt_name ]) ;
|
|
self#index `Module_type mt.mt_name ; Newline ] in
|
|
puts chanout (self#texi_of_text title) ;
|
|
|
|
if is mt.mt_info
|
|
then begin
|
|
let descr = [ Title (succ depth, None,
|
|
[ Raw Odoc_messages.description ]) ] in
|
|
puts chanout (self#texi_of_text descr) ;
|
|
puts chanout (self#texi_of_info mt.mt_info)
|
|
end ;
|
|
|
|
let mt_ele = Module.module_type_elements ~trans:true mt in
|
|
let subparts = module_subparts mt_ele in
|
|
if depth < maxdepth && subparts <> []
|
|
then begin
|
|
let menu = Texi.ifinfo
|
|
( self#heading (succ depth) [ Raw "Subparts" ]) in
|
|
puts chanout menu ;
|
|
Texi.generate_menu chanout (subparts :> menu_data)
|
|
end ;
|
|
|
|
let intf = [ Title (succ depth, None,
|
|
[ Raw Odoc_messages.interface ]) ] in
|
|
puts chanout (self#texi_of_text intf) ;
|
|
List.iter
|
|
(fun ele -> puts chanout
|
|
(self#texi_of_module_element mt.mt_name ele))
|
|
mt_ele ;
|
|
|
|
(* create sub parts for modules, module types, classes and class types *)
|
|
List.iter
|
|
(function
|
|
| `Module m -> self#generate_for_module chanout m
|
|
| `Module_type mt -> self#generate_for_module_type chanout mt
|
|
| `Class c -> self#generate_for_class chanout c
|
|
| `Class_type ct -> self#generate_for_class_type chanout ct)
|
|
subparts
|
|
with Aliased_node -> ()
|
|
|
|
(** Generate the Texinfo code for the given module,
|
|
in the given out channel. *)
|
|
method generate_for_module chanout m =
|
|
try
|
|
Odoc_info.verbose ("Generate for module " ^ m.m_name) ;
|
|
let depth = Name.depth m.m_name in
|
|
let title = [
|
|
self#node depth m.m_name ;
|
|
Title (depth, None,
|
|
if m.m_text_only then
|
|
[ Raw m.m_name ]
|
|
else
|
|
[ Raw (Odoc_messages.modul ^ " ") ;
|
|
Code m.m_name ]
|
|
) ;
|
|
self#index `Module m.m_name ; Newline ] in
|
|
puts chanout (self#texi_of_text title) ;
|
|
|
|
if is m.m_info
|
|
then begin
|
|
let descr = [ Title (succ depth, None,
|
|
[ Raw Odoc_messages.description ]) ] in
|
|
puts chanout (self#texi_of_text descr) ;
|
|
puts chanout (self#texi_of_info m.m_info)
|
|
end ;
|
|
|
|
let m_ele = Module.module_elements ~trans:true m in
|
|
let subparts = module_subparts m_ele in
|
|
if depth < maxdepth && subparts <> []
|
|
then begin
|
|
let menu = Texi.ifinfo
|
|
( self#heading (succ depth) [ Raw "Subparts" ]) in
|
|
puts chanout menu ;
|
|
Texi.generate_menu chanout (subparts :> menu_data)
|
|
end ;
|
|
|
|
let intf = [ Title (succ depth, None,
|
|
[ Raw Odoc_messages.interface]) ] in
|
|
puts chanout (self#texi_of_text intf) ;
|
|
|
|
List.iter
|
|
(fun ele -> puts chanout
|
|
(self#texi_of_module_element m.m_name ele))
|
|
m_ele ;
|
|
|
|
(* create sub nodes for modules, module types, classes and class types *)
|
|
List.iter
|
|
(function
|
|
| `Module m -> self#generate_for_module chanout m
|
|
| `Module_type mt -> self#generate_for_module_type chanout mt
|
|
| `Class c -> self#generate_for_class chanout c
|
|
| `Class_type ct -> self#generate_for_class_type chanout ct )
|
|
subparts
|
|
with Aliased_node -> ()
|
|
|
|
|
|
(** Writes the header of the TeXinfo document. *)
|
|
method generate_texi_header chan texi_filename m_list =
|
|
let title = match !Global.title with
|
|
| None -> ""
|
|
| Some s -> self#escape s in
|
|
let filename =
|
|
if texi_filename <> "ocamldoc.texi"
|
|
then
|
|
let fn = Filename.basename texi_filename in
|
|
(if Filename.check_suffix fn ".texi"
|
|
then Filename.chop_suffix fn ".texi"
|
|
else fn) ^ ".info"
|
|
else
|
|
if title <> ""
|
|
then title ^ ".info"
|
|
else "doc.info"
|
|
in
|
|
(* write a standard Texinfo header *)
|
|
List.iter
|
|
(puts_nl chan)
|
|
(List.flatten
|
|
[ [ "\\input texinfo @c -*-texinfo-*-" ;
|
|
"@c %**start of header" ;
|
|
"@setfilename " ^ filename ;
|
|
"@settitle " ^ title ;
|
|
"@c %**end of header" ; ] ;
|
|
|
|
(if !Global.with_index then
|
|
List.map
|
|
(fun ind ->
|
|
"@defcodeindex " ^ (indices ind))
|
|
indices_to_build
|
|
else []) ;
|
|
|
|
[ Texi.dirsection !info_section ] ;
|
|
|
|
Texi.direntry
|
|
(if !info_entry <> []
|
|
then !info_entry
|
|
else [ Printf.sprintf "* %s: (%s)."
|
|
title
|
|
(Filename.chop_suffix filename ".info") ]) ;
|
|
|
|
[ "@ifinfo" ;
|
|
"This file was generated by Ocamldoc using the Texinfo generator." ;
|
|
"@end ifinfo" ;
|
|
|
|
"@c no titlepage." ;
|
|
|
|
"@node Top, , , (dir)" ;
|
|
"@top "^ title ; ]
|
|
] ) ;
|
|
|
|
(* insert the intro file *)
|
|
begin
|
|
match !Odoc_info.Global.intro_file with
|
|
| None when title <> "" ->
|
|
puts_nl chan "@ifinfo" ;
|
|
puts_nl chan ("Documentation for " ^ title) ;
|
|
puts_nl chan "@end ifinfo"
|
|
| None ->
|
|
puts_nl chan "@c no title given"
|
|
| Some f ->
|
|
nl chan ;
|
|
puts_nl chan
|
|
(self#texi_of_info
|
|
(Some (Odoc_info.info_of_comment_file m_list f)))
|
|
end ;
|
|
|
|
(* write a top menu *)
|
|
Texi.generate_menu chan
|
|
((List.map (fun m -> `Module m) m_list) @
|
|
(if !Global.with_index then
|
|
let indices_names_to_build = List.map indices indices_to_build in
|
|
List.rev
|
|
(List.fold_left
|
|
(fun acc ->
|
|
function (longname, shortname)
|
|
when List.mem shortname indices_names_to_build ->
|
|
(`Index (longname ^ " index")) :: acc
|
|
| _ -> acc)
|
|
[ `Comment "Indices :" ; `Blank ]
|
|
indices_names )
|
|
else [] ))
|
|
|
|
|
|
(** Writes the trailer of the TeXinfo document. *)
|
|
method generate_texi_trailer chan =
|
|
nl chan ;
|
|
if !Global.with_index
|
|
then
|
|
let indices_names_to_build = List.map indices indices_to_build in
|
|
List.iter (puts_nl chan)
|
|
(List.flatten
|
|
(List.map
|
|
(fun (longname, shortname) ->
|
|
if List.mem shortname indices_names_to_build
|
|
then [ "@node " ^ longname ^ " index," ;
|
|
"@unnumbered " ^ longname ^ " index" ;
|
|
"@printindex " ^ shortname ; ]
|
|
else [])
|
|
indices_names )) ;
|
|
if !Global.with_toc
|
|
then puts_nl chan "@contents" ;
|
|
puts_nl chan "@bye"
|
|
|
|
|
|
method do_index it =
|
|
if not (List.mem it indices_to_build)
|
|
then indices_to_build <- it :: indices_to_build
|
|
|
|
(** Scan the whole module information to know which indices need to be build *)
|
|
method scan_for_index : subparts -> unit = function
|
|
| `Module m ->
|
|
let m_ele = Module.module_elements ~trans:true m in
|
|
List.iter self#scan_for_index_in_mod m_ele
|
|
| `Module_type mt ->
|
|
let m_ele = Module.module_type_elements ~trans:true mt in
|
|
List.iter self#scan_for_index_in_mod m_ele
|
|
| `Class c ->
|
|
let c_ele = Class.class_elements ~trans:true c in
|
|
List.iter self#scan_for_index_in_class c_ele
|
|
| `Class_type ct ->
|
|
let c_ele = Class.class_type_elements ~trans:true ct in
|
|
List.iter self#scan_for_index_in_class c_ele
|
|
|
|
method scan_for_index_in_mod = function
|
|
(* no recursion *)
|
|
| Element_value _ -> self#do_index `Value
|
|
| Element_type_extension _ -> self#do_index `Extension
|
|
| Element_exception _ -> self#do_index `Exception
|
|
| Element_type _ -> self#do_index `Type
|
|
| Element_included_module _
|
|
| Element_module_comment _ -> ()
|
|
(* recursion *)
|
|
| Element_module m -> self#do_index `Module ;
|
|
self#scan_for_index (`Module m)
|
|
| Element_module_type mt -> self#do_index `Module_type ;
|
|
self#scan_for_index (`Module_type mt)
|
|
| Element_class c -> self#do_index `Class ;
|
|
self#scan_for_index (`Class c)
|
|
| Element_class_type ct -> self#do_index `Class_type ;
|
|
self#scan_for_index (`Class_type ct)
|
|
|
|
method scan_for_index_in_class = function
|
|
| Class_attribute _ -> self#do_index `Class_att
|
|
| Class_method _ -> self#do_index `Method
|
|
| Class_comment _ -> ()
|
|
|
|
|
|
(** Generate the Texinfo file from a module list,
|
|
in the {!Odoc_info.Global.out_file} file. *)
|
|
method generate module_list =
|
|
Hashtbl.clear node_tbl ;
|
|
let filename =
|
|
if !Global.out_file = Odoc_messages.default_out_file
|
|
then "ocamldoc.texi"
|
|
else !Global.out_file in
|
|
if !Global.with_index
|
|
then List.iter self#scan_for_index
|
|
(List.map (fun m -> `Module m) module_list) ;
|
|
try
|
|
let chanout = open_out
|
|
(Filename.concat !Global.target_dir filename) in
|
|
if !Global.with_header
|
|
then self#generate_texi_header chanout filename module_list ;
|
|
List.iter
|
|
(self#generate_for_module chanout)
|
|
module_list ;
|
|
if !Global.with_trailer
|
|
then self#generate_texi_trailer chanout ;
|
|
close_out chanout
|
|
with
|
|
| Failure s
|
|
| Sys_error s ->
|
|
prerr_endline s ;
|
|
incr Odoc_info.errors
|
|
end
|
|
end
|
|
|
|
module type Texi_generator = module type of Generator
|