(***********************************************************************)
(* 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 html 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
(** The functions used for naming files and html marks.*)
module Naming =
struct
(** The prefix for types marks. *)
let mark_type = "TYPE"
(** The prefix for functions marks. *)
let mark_function = "FUN"
(** The prefix for exceptions marks. *)
let mark_exception = "EXCEPTION"
(** The prefix for values marks. *)
let mark_value = "VAL"
(** The prefix for attributes marks. *)
let mark_attribute = "ATT"
(** The prefix for methods marks. *)
let mark_method = "METHOD"
(** The prefix for code files.. *)
let code_prefix = "code_"
(** The prefix for type files.. *)
let type_prefix = "type_"
(** Return the two html files names for the given module or class name.*)
let html_files name =
let html_file = name^".html" in
let html_frame_file = name^"-frame.html" in
(html_file, html_frame_file)
(** Return the target for the given prefix and simple name. *)
let target pref simple_name = pref^simple_name
(** Return the complete link target (file#target) for the given prefix string and complete name.*)
let complete_target pref complete_name =
let simple_name = Name.simple complete_name in
let module_name =
let s = Name.father complete_name in
if s = "" then simple_name else s
in
let (html_file, _) = html_files module_name in
html_file^"#"^(target pref simple_name)
(** Return the link target for the given type. *)
let type_target t = target mark_type (Name.simple t.ty_name)
(** Return the complete link target for the given type. *)
let complete_type_target t = complete_target mark_type t.ty_name
(** Return the link target for the given exception. *)
let exception_target e = target mark_exception (Name.simple e.ex_name)
(** Return the complete link target for the given exception. *)
let complete_exception_target e = complete_target mark_exception e.ex_name
(** Return the link target for the given value. *)
let value_target v = target mark_value (Name.simple v.val_name)
(** Return the given value name where symbols accepted in infix values
are replaced by strings, to avoid clashes with the filesystem.*)
let subst_infix_symbols name =
let len = String.length name in
let buf = Buffer.create len in
let ch c = Buffer.add_char buf c in
let st s = Buffer.add_string buf s in
for i = 0 to len - 1 do
match name.[i] with
| '|' -> st "_pipe_"
| '<' -> st "_lt_"
| '>' -> st "_gt_"
| '@' -> st "_at_"
| '^' -> st "_exp_"
| '&' -> st "_amp_"
| '+' -> st "_plus_"
| '-' -> st "_minus_"
| '*' -> st "_star_"
| '/' -> st "_slash_"
| '$' -> st "_dollar_"
| '%' -> st "_percent_"
| '=' -> st "_equal_"
| ':' -> st "_column_"
| '~' -> st "_tilde_"
| '!' -> st "_bang_"
| c -> ch c
done;
Buffer.contents buf
(** Return the complete link target for the given value. *)
let complete_value_target v = complete_target mark_value v.val_name
(** Return the complete filename for the code of the given value. *)
let file_code_value_complete_target v =
let f = code_prefix^mark_value^(subst_infix_symbols v.val_name)^".html" in
f
(** Return the link target for the given attribute. *)
let attribute_target a = target mark_attribute (Name.simple a.att_value.val_name)
(** Return the complete link target for the given attribute. *)
let complete_attribute_target a = complete_target mark_attribute a.att_value.val_name
(** Return the complete filename for the code of the given attribute. *)
let file_code_attribute_complete_target a =
let f = code_prefix^mark_attribute^a.att_value.val_name^".html" in
f
(** Return the link target for the given method. *)
let method_target m = target mark_method (Name.simple m.met_value.val_name)
(** Return the complete link target for the given method. *)
let complete_method_target m = complete_target mark_method m.met_value.val_name
(** Return the complete filename for the code of the given method. *)
let file_code_method_complete_target m =
let f = code_prefix^mark_method^m.met_value.val_name^".html" in
f
(** Return the link target for the given label section. *)
let label_target l = target "" l
(** Return the complete link target for the given section label. *)
let complete_label_target l = complete_target "" l
(** Return the complete filename for the code of the type of the
given module or module type name. *)
let file_type_module_complete_target name =
let f = type_prefix^name^".html" in
f
(** Return the complete filename for the code of the
given module name. *)
let file_code_module_complete_target name =
let f = code_prefix^name^".html" in
f
(** Return the complete filename for the code of the type of the
given class or class type name. *)
let file_type_class_complete_target name =
let f = type_prefix^name^".html" in
f
end
module StringSet = Set.Make (struct type t = string let compare = compare end)
(** A class with a method to colorize a string which represents OCaml code. *)
class ocaml_code =
object(self)
method html_of_code b ?(with_pre=true) code =
Odoc_ocamlhtml.html_of_code b ~with_pre: with_pre code
end
let new_buf () = Buffer.create 1024
let bp = Printf.bprintf
let bs = Buffer.add_string
(** Generation of html code from text structures. *)
class virtual text =
object (self)
(** We want to display colorized code. *)
inherit ocaml_code
(** Escape the strings which would clash with html syntax, and
make some replacements (double newlines replaced by
). *)
method escape s = Odoc_ocamlhtml.escape_base s
method keep_alpha_num s =
let len = String.length s in
let buf = Buffer.create len in
for i = 0 to len - 1 do
match s.[i] with
'a'..'z' | 'A'..'Z' | '0'..'9' -> Buffer.add_char buf s.[i]
| _ -> ()
done;
Buffer.contents buf
(** Return a label created from the first sentence of a text. *)
method label_of_text t=
let t2 = Odoc_info.first_sentence_of_text t in
let s = Odoc_info.string_of_text t2 in
let s2 = self#keep_alpha_num s in
s2
(** Create a label for the associated title.
Return the label specified by the user or a label created
from the title level and the first sentence of the title. *)
method create_title_label (n,label_opt,t) =
match label_opt with
Some s -> s
| None -> Printf.sprintf "%d_%s" n (self#label_of_text t)
(** Print the html code corresponding to the [text] parameter. *)
method html_of_text b t =
List.iter (self#html_of_text_element b) t
(** Print the html code for the [text_element] in parameter. *)
method html_of_text_element b te =
print_DEBUG "text::html_of_text_element";
match te with
| Odoc_info.Raw s -> self#html_of_Raw b s
| Odoc_info.Code s -> self#html_of_Code b s
| Odoc_info.CodePre s -> self#html_of_CodePre b s
| Odoc_info.Verbatim s -> self#html_of_Verbatim b s
| Odoc_info.Bold t -> self#html_of_Bold b t
| Odoc_info.Italic t -> self#html_of_Italic b t
| Odoc_info.Emphasize t -> self#html_of_Emphasize b t
| Odoc_info.Center t -> self#html_of_Center b t
| Odoc_info.Left t -> self#html_of_Left b t
| Odoc_info.Right t -> self#html_of_Right b t
| Odoc_info.List tl -> self#html_of_List b tl
| Odoc_info.Enum tl -> self#html_of_Enum b tl
| Odoc_info.Newline -> self#html_of_Newline b
| Odoc_info.Block t -> self#html_of_Block b t
| Odoc_info.Title (n, l_opt, t) -> self#html_of_Title b n l_opt t
| Odoc_info.Latex s -> self#html_of_Latex b s
| Odoc_info.Link (s, t) -> self#html_of_Link b s t
| Odoc_info.Ref (name, ref_opt) -> self#html_of_Ref b name ref_opt
| Odoc_info.Superscript t -> self#html_of_Superscript b t
| Odoc_info.Subscript t -> self#html_of_Subscript b t
| Odoc_info.Module_list l -> self#html_of_Module_list b l
| Odoc_info.Index_list -> self#html_of_Index_list b
method html_of_Raw b s = bs b (self#escape s)
method html_of_Code b s =
if !Args.colorize_code then
self#html_of_code b ~with_pre: false s
else
(
bs b "";
bs b (self#escape s);
bs b ""
)
method html_of_CodePre b s =
if !Args.colorize_code then
(
bs b "";
self#html_of_code b s;
bs b ""
)
else
(
bs b "" ;
bs b (self#escape s);
bs b "
"
)
method html_of_Verbatim b s =
bs b "";
bs b (self#escape s);
bs b ""
method html_of_Bold b t =
bs b "";
self#html_of_text b t;
bs b ""
method html_of_Italic b t =
bs b "" ;
self#html_of_text b t;
bs b ""
method html_of_Emphasize b t =
bs b "" ;
self#html_of_text b t ;
bs b ""
method html_of_Center b t =
bs b "";
self#html_of_text b t;
bs b ""
method html_of_Left b t =
bs b "";
self#html_of_text b t;
bs b "
"
method html_of_Right b t =
bs b "";
self#html_of_text b t;
bs b "
"
method html_of_List b tl =
bs b "\n";
List.iter
(fun t -> bs b "- "; self#html_of_text b t; bs b "
\n")
tl;
bs b "
\n"
method html_of_Enum b tl =
bs b "\n";
List.iter
(fun t -> bs b "- "; self#html_of_text b t; bs b"
\n")
tl;
bs b "
\n"
method html_of_Newline b = bs b "\n\n"
method html_of_Block b t =
bs b "
\n";
self#html_of_text b t;
bs b "
\n"
method html_of_Title b n label_opt t =
let label1 = self#create_title_label (n, label_opt, t) in
bs b "\n";
let (tag_o, tag_c) =
if n > 6 then
(Printf.sprintf "div class=\"h%d\"" n, "div")
else
let t = Printf.sprintf "h%d" n in (t, t)
in
bs b "<";
bs b tag_o;
bs b ">";
self#html_of_text b t;
bs b ""
method html_of_Latex b _ = ()
(* don't care about LaTeX stuff in HTML. *)
method html_of_Link b s t =
bs b "";
self#html_of_text b t;
bs b ""
method html_of_Ref b name ref_opt =
match ref_opt with
None ->
self#html_of_text_element b (Odoc_info.Code name)
| Some kind ->
let h name = Odoc_info.Code (Odoc_info.use_hidden_modules name) in
let (target, text) =
match kind with
Odoc_info.RK_module
| Odoc_info.RK_module_type
| Odoc_info.RK_class
| Odoc_info.RK_class_type ->
let (html_file, _) = Naming.html_files name in
(html_file, h name)
| Odoc_info.RK_value -> (Naming.complete_target Naming.mark_value name, h name)
| Odoc_info.RK_type -> (Naming.complete_target Naming.mark_type name, h name)
| Odoc_info.RK_exception -> (Naming.complete_target Naming.mark_exception name, h name)
| Odoc_info.RK_attribute -> (Naming.complete_target Naming.mark_attribute name, h name)
| Odoc_info.RK_method -> (Naming.complete_target Naming.mark_method name, h name)
| Odoc_info.RK_section t -> (Naming.complete_label_target name,
Odoc_info.Italic [Raw (Odoc_info.string_of_text t)])
in
bs b ("");
self#html_of_text_element b text;
bs b ""
method html_of_Superscript b t =
bs b "";
self#html_of_text b t;
bs b ""
method html_of_Subscript b t =
bs b "";
self#html_of_text b t;
bs b ""
method html_of_Module_list b l =
bs b "
\n\n";
List.iter
(fun name ->
bs b "| ";
(
try
let m =
List.find (fun m -> m.m_name = name) self#list_modules
in
let (html, _) = Naming.html_files m.m_name in
bp b "%s | " html m.m_name;
bs b "";
self#html_of_info_first_sentence b m.m_info;
with
Not_found ->
Odoc_messages.pwarning (Odoc_messages.cross_module_not_found name);
bp b "%s | " name
);
bs b " |
\n"
)
l;
bs b "
\n \n