diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index 8289eb178..00aa0c323 100644
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -120,8 +120,9 @@ module Naming =
(** A class with a method to colorize a string which represents OCaml code. *)
class ocaml_code =
object(self)
- method html_of_code fmt ?(with_pre=true) code =
- Odoc_ocamlhtml.html_of_code fmt ~with_pre: with_pre code
+ method html_of_code ?(with_pre=true) code =
+ let html_code = Odoc_ocamlhtml.html_of_code ~with_pre: with_pre code in
+ html_code
end
@@ -135,143 +136,98 @@ class text =
make some replacements (double newlines replaced by ). *)
method escape s = Odoc_ocamlhtml.escape_base s
- (** Print the html code corresponding to the [text] parameter. *)
- method html_of_text fmt t = List.iter (self#html_of_text_element fmt) t
+ (** Return the html code corresponding to the [text] parameter. *)
+ method html_of_text t = String.concat "" (List.map self#html_of_text_element t)
- (** Print the html code for the [text_element] in parameter. *)
- method html_of_text_element fmt te =
+ (** Return the html code for the [text_element] in parameter. *)
+ method html_of_text_element te =
print_DEBUG "text::html_of_text_element";
match te with
- | Odoc_info.Raw s -> self#html_of_Raw fmt s
- | Odoc_info.Code s -> self#html_of_Code fmt s
- | Odoc_info.CodePre s -> self#html_of_CodePre fmt s
- | Odoc_info.Verbatim s -> self#html_of_Verbatim fmt s
- | Odoc_info.Bold t -> self#html_of_Bold fmt t
- | Odoc_info.Italic t -> self#html_of_Italic fmt t
- | Odoc_info.Emphasize t -> self#html_of_Emphasize fmt t
- | Odoc_info.Center t -> self#html_of_Center fmt t
- | Odoc_info.Left t -> self#html_of_Left fmt t
- | Odoc_info.Right t -> self#html_of_Right fmt t
- | Odoc_info.List tl -> self#html_of_List fmt tl
- | Odoc_info.Enum tl -> self#html_of_Enum fmt tl
- | Odoc_info.Newline -> self#html_of_Newline fmt
- | Odoc_info.Block t -> self#html_of_Block fmt t
- | Odoc_info.Title (n, l_opt, t) -> self#html_of_Title fmt n l_opt t
- | Odoc_info.Latex s -> self#html_of_Latex fmt s
- | Odoc_info.Link (s, t) -> self#html_of_Link fmt s t
- | Odoc_info.Ref (name, ref_opt) -> self#html_of_Ref fmt name ref_opt
- | Odoc_info.Superscript t -> self#html_of_Superscript fmt t
- | Odoc_info.Subscript t -> self#html_of_Subscript fmt t
+ | Odoc_info.Raw s -> self#html_of_Raw s
+ | Odoc_info.Code s -> self#html_of_Code s
+ | Odoc_info.CodePre s -> self#html_of_CodePre s
+ | Odoc_info.Verbatim s -> self#html_of_Verbatim s
+ | Odoc_info.Bold t -> self#html_of_Bold t
+ | Odoc_info.Italic t -> self#html_of_Italic t
+ | Odoc_info.Emphasize t -> self#html_of_Emphasize t
+ | Odoc_info.Center t -> self#html_of_Center t
+ | Odoc_info.Left t -> self#html_of_Left t
+ | Odoc_info.Right t -> self#html_of_Right t
+ | Odoc_info.List tl -> self#html_of_List tl
+ | Odoc_info.Enum tl -> self#html_of_Enum tl
+ | Odoc_info.Newline -> self#html_of_Newline
+ | Odoc_info.Block t -> self#html_of_Block t
+ | Odoc_info.Title (n, l_opt, t) -> self#html_of_Title n l_opt t
+ | Odoc_info.Latex s -> self#html_of_Latex s
+ | Odoc_info.Link (s, t) -> self#html_of_Link s t
+ | Odoc_info.Ref (name, ref_opt) -> self#html_of_Ref name ref_opt
+ | Odoc_info.Superscript t -> self#html_of_Superscript t
+ | Odoc_info.Subscript t -> self#html_of_Subscript t
- method html_of_Raw fmt s =
- Format.pp_print_string fmt (self#escape s)
+ method html_of_Raw s = self#escape s
- method html_of_Code fmt s =
+ method html_of_Code s =
if !Odoc_args.colorize_code then
- self#html_of_code fmt ~with_pre: false s
+ self#html_of_code ~with_pre: false s
else
- Format.fprintf fmt "@{%s@}" Odoc_ocamlhtml.code_class (self#escape s)
+ ""^(self#escape s)^""
- method html_of_CodePre fmt s =
- Format.fprintf fmt "@{
";
+ method html_of_CodePre s =
if !Odoc_args.colorize_code then
- (
- Format.fprintf fmt "@}";
- self#html_of_code fmt s;
- Format.fprintf fmt "@{
\n"
- method html_of_Latex fmt _ = ()
+ method html_of_Latex _ = ""
(* don't care about LaTeX stuff in HTML. *)
- method html_of_Link fmt s t =
- Format.fprintf fmt "@{" s;
- self#html_of_text fmt t;
- Format.fprintf fmt "@}"
+ method html_of_Link s t =
+ ""^(self#html_of_text t)^""
- method html_of_Ref fmt name ref_opt =
+ method html_of_Ref name ref_opt =
match ref_opt with
None ->
- self#html_of_text_element fmt (Odoc_info.Code name)
+ self#html_of_text_element (Odoc_info.Code name)
| Some kind ->
let target =
match kind with
@@ -288,19 +244,15 @@ class text =
| Odoc_info.RK_method -> Naming.complete_target Naming.mark_method name
| Odoc_info.RK_section -> Naming.complete_label_target name
in
- Format.fprintf fmt "@{" target;
- self#html_of_text_element fmt (Odoc_info.Code (Odoc_info.use_hidden_modules name));
- Format.fprintf fmt "@}"
+ ""^
+ (self#html_of_text_element (Odoc_info.Code (Odoc_info.use_hidden_modules name)))^""
- method html_of_Superscript fmt t =
- Format.fprintf fmt "@{";
- self#html_of_text fmt t;
- Format.fprintf fmt "@}"
+ method html_of_Superscript t =
+ ""^(self#html_of_text t)^""
+
+ method html_of_Subscript t =
+ ""^(self#html_of_text t)^""
- method html_of_Subscript fmt t =
- Format.fprintf fmt "@{";
- self#html_of_text fmt t;
- Format.fprintf fmt "@}"
end
(** A class used to generate html code for info structures. *)
@@ -309,146 +261,138 @@ class virtual info =
(** The list of pairs [(tag, f)] where [f] is a function taking
the [text] associated to [tag] and returning html code.
Add a pair here to handle a tag.*)
- val mutable tag_functions = ([] : (string * (Format.formatter -> Odoc_info.text -> unit)) list)
+ val mutable tag_functions = ([] : (string * (Odoc_info.text -> string)) list)
(** The method used to get html code from a [text]. *)
- method virtual html_of_text : Format.formatter -> Odoc_info.text -> unit
+ method virtual html_of_text : Odoc_info.text -> string
- (** Print html for an author list. *)
- method html_of_author_list fmt l =
+ (** Return html for an author list. *)
+ method html_of_author_list l =
match l with
- [] -> ()
- | _ -> Format.fprintf fmt "@{%s: @}%s \n"
- Odoc_messages.authors (String.concat ", " l)
-
- (** Print html code for the given optional version information.*)
- method html_of_version_opt fmt v_opt =
- match v_opt with
- None -> ()
- | Some v -> Format.fprintf fmt "@{%s: @}%s \n" Odoc_messages.version v
-
- (** Print html code for the given optional since information.*)
- method html_of_since_opt fmt s_opt =
- match s_opt with
- None -> ()
- | Some s -> Format.fprintf fmt "@{%s :@}%s \n" Odoc_messages.since s
-
- (** Print html code for the given list of raised exceptions.*)
- method html_of_raised_exceptions fmt l =
- match l with
- [] -> ()
- | (s, t) :: [] ->
- Format.fprintf fmt "@{%s@} @{%s@} " Odoc_messages.raises s;
- self#html_of_text fmt t;
- Format.pp_print_string fmt " \n"
+ [] ->
+ ""
| _ ->
- Format.fprintf fmt "@{%s@}@{
@{%s@} " ex;
- self#html_of_text fmt desc;
- Format.fprintf fmt "@}"
- )
- l;
- Format.fprintf fmt "@}"
+ ""^Odoc_messages.authors^": "^
+ (String.concat ", " l)^
+ " \n"
- (** Print html code for the given "see also" reference. *)
- method html_of_see fmt (see_ref, t) =
+ (** Return html code for the given optional version information.*)
+ method html_of_version_opt v_opt =
+ match v_opt with
+ None -> ""
+ | Some v -> ""^Odoc_messages.version^": "^v^" \n"
+
+ (** Return html code for the given optional since information.*)
+ method html_of_since_opt s_opt =
+ match s_opt with
+ None -> ""
+ | Some s -> ""^Odoc_messages.since^" "^s^" \n"
+
+ (** Return html code for the given list of raised exceptions.*)
+ method html_of_raised_exceptions l =
+ match l with
+ [] -> ""
+ | (s, t) :: [] -> ""^Odoc_messages.raises^""^s^" "^(self#html_of_text t)^" \n"
+ | _ ->
+ ""^Odoc_messages.raises^"
\n"
+
+ (** Return html code for the given "see also" reference. *)
+ method html_of_see (see_ref, t) =
let t_ref =
match see_ref with
Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ]
| Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t
| Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t
in
- self#html_of_text fmt t_ref
+ self#html_of_text t_ref
- (** Print html code for the given list of "see also" references.*)
- method html_of_sees fmt l =
+ (** Return html code for the given list of "see also" references.*)
+ method html_of_sees l =
match l with
- [] -> ()
- | see :: [] ->
- Format.fprintf fmt "@{%s@} " Odoc_messages.see_also;
- self#html_of_see fmt see;
- Format.pp_print_string fmt " \n"
+ [] -> ""
+ | see :: [] -> ""^Odoc_messages.see_also^" "^(self#html_of_see see)^" \n"
| _ ->
- Format.fprintf fmt "@{%s@}@{
\n"
- (** Print html code for the given optional return information.*)
- method html_of_return_opt fmt return_opt =
+ (** Return html code for the given optional return information.*)
+ method html_of_return_opt return_opt =
match return_opt with
- None -> ()
- | Some s ->
- Format.fprintf fmt "@{%s@} " Odoc_messages.returns;
- self#html_of_text fmt s;
- Format.pp_print_string fmt " \n"
+ None -> ""
+ | Some s -> ""^Odoc_messages.returns^" "^(self#html_of_text s)^" \n"
- (** Print html code for the given list of custom tagged texts. *)
- method html_of_custom fmt l =
+ (** Return html code for the given list of custom tagged texts. *)
+ method html_of_custom l =
let buf = Buffer.create 50 in
List.iter
(fun (tag, text) ->
try
let f = List.assoc tag tag_functions in
- f fmt text
+ Buffer.add_string buf (f text)
with
Not_found ->
Odoc_info.warning (Odoc_messages.tag_not_handled tag)
)
- l
+ l;
+ Buffer.contents buf
- (** Print html code for a description, except for the [i_params] field. *)
- method html_of_info fmt info_opt =
+ (** Return html code for a description, except for the [i_params] field. *)
+ method html_of_info info_opt =
match info_opt with
- None -> ()
+ None ->
+ ""
| Some info ->
let module M = Odoc_info in
- Format.fprintf fmt "@{
\n";
+ "
\n"^
(match info.M.i_deprecated with
- None -> ()
+ None -> ""
| Some d ->
- Format.fprintf fmt "@{%s@} " Odoc_messages.deprecated;
- self#html_of_text fmt d;
- Format.pp_print_string fmt " \n"
- );
+ ""^Odoc_messages.deprecated^" "^
+ (self#html_of_text d)^
+ " \n"
+ )^
(match info.M.i_desc with
- None -> ()
- | Some d when d = [Odoc_info.Raw ""] -> ()
- | Some d -> self#html_of_text fmt d; Format.pp_print_string fmt " \n"
- );
- self#html_of_author_list fmt info.M.i_authors;
- self#html_of_version_opt fmt info.M.i_version;
- self#html_of_since_opt fmt info.M.i_since;
- self#html_of_raised_exceptions fmt info.M.i_raised_exceptions;
- self#html_of_return_opt fmt info.M.i_return_value;
- self#html_of_sees fmt info.M.i_sees;
- self#html_of_custom fmt info.M.i_custom;
- Format.fprintf fmt "@}\n"
+ None -> ""
+ | Some d when d = [Odoc_info.Raw ""] -> ""
+ | Some d -> (self#html_of_text d)^" \n"
+ )^
+ (self#html_of_author_list info.M.i_authors)^
+ (self#html_of_version_opt info.M.i_version)^
+ (self#html_of_since_opt info.M.i_since)^
+ (self#html_of_raised_exceptions info.M.i_raised_exceptions)^
+ (self#html_of_return_opt info.M.i_return_value)^
+ (self#html_of_sees info.M.i_sees)^
+ (self#html_of_custom info.M.i_custom)^
+ "
\n"
- (** Print html code for the first sentence of a description. *)
- method html_of_info_first_sentence fmt info_opt =
+ (** Return html code for the first sentence of a description. *)
+ method html_of_info_first_sentence info_opt =
match info_opt with
- None -> ()
+ None -> ""
| Some info ->
let module M = Odoc_info in
let dep = info.M.i_deprecated <> None in
- Format.fprintf fmt "@{
";
- if dep then Format.fprintf fmt "@{";
+ "
\n"^
+ (if dep then "" else "") ^
(match info.M.i_desc with
- None -> ()
- | Some d when d = [Odoc_info.Raw ""] -> ()
- | Some d ->
- self#html_of_text fmt (Odoc_info.first_sentence_of_text d)
- );
- if dep then Format.fprintf fmt "@}";
- Format.fprintf fmt "@}"
+ None -> ""
+ | Some d when d = [Odoc_info.Raw ""] -> ""
+ | Some d -> (self#html_of_text (Odoc_info.first_sentence_of_text d))^"\n"
+ )^
+ (if dep then "" else "") ^
+ "
\n"
+
end
@@ -473,7 +417,7 @@ class html =
".subscript { font-size : 4 }" ;
".comment { color : Green }" ;
".constructor { color : Blue }" ;
- ".type { color : DarkSlateBlue }" ;
+ ".type { color : #5C6585 }" ;
".string { color : Maroon }" ;
".warning { color : Red ; font-weight : bold }" ;
".info { margin-left : 3em; margin-right : 3em }" ;
@@ -551,7 +495,7 @@ class html =
val mutable list_class_types = []
(** The header of pages. Must be prepared by the [prepare_header] method.*)
- val mutable header = fun fmt -> fun ?(nav=None) -> fun _ -> ()
+ val mutable header = fun ?(nav=None) -> fun _ -> ""
(** Init the style. *)
method init_style =
@@ -572,7 +516,7 @@ class html =
| Some f ->
style_file <- f
);
- style <- ""
+ style <- "\n"
(** Get the title given by the user *)
method title = match !Odoc_args.title with None -> "" | Some t -> self#escape t
@@ -583,101 +527,103 @@ class html =
(self#escape s)
(** Get the page header. *)
- method header fmt ?nav title = header fmt ?nav title
+ method header ?nav title = header ?nav title
(** A function to build the header of pages. *)
method prepare_header module_list =
- let f fmt ?(nav=None) t =
+ let f ?(nav=None) t =
let link_if_not_empty l m url =
match l with
- [] -> ()
- | _ -> Format.fprintf fmt "\n" m url
+ [] -> ""
+ | _ -> "\n"
in
- Format.fprintf fmt "@{%s\n" style;
- Format.fprintf fmt "\n" index;
+ "\n"^
+ style^
+ "\n"^
(
match nav with
- None -> ()
+ None -> ""
| Some (pre_opt, post_opt, name) ->
(match pre_opt with
- None -> ()
+ None -> ""
| Some name ->
- Format.fprintf fmt "\n"
- (fst (Naming.html_files name))
- );
+ "\n"
+ )^
(match post_opt with
- None -> ()
+ None -> ""
| Some name ->
- Format.fprintf fmt "\n"
- (fst (Naming.html_files name))
- );
- let father = Name.father name in
- let href = if father = "" then index else fst (Naming.html_files father) in
- Format.fprintf fmt "\n" href
- );
- link_if_not_empty list_types Odoc_messages.index_of_types index_types;
- link_if_not_empty list_exceptions Odoc_messages.index_of_exceptions index_exceptions;
- link_if_not_empty list_values Odoc_messages.index_of_values index_values;
- link_if_not_empty list_attributes Odoc_messages.index_of_attributes index_attributes;
- link_if_not_empty list_methods Odoc_messages.index_of_methods index_methods;
- link_if_not_empty list_classes Odoc_messages.index_of_classes index_classes;
- link_if_not_empty list_class_types Odoc_messages.index_of_class_types index_class_types;
- link_if_not_empty list_modules Odoc_messages.index_of_modules index_modules;
- link_if_not_empty list_module_types Odoc_messages.index_of_module_types index_module_types;
- List.iter
- (fun m ->
- let html_file = fst (Naming.html_files m.m_name) in
- Format.fprintf fmt
- "\n"
- m.m_name html_file
- )
- module_list;
- Format.fprintf fmt "@{%s@}@}" t
+ "<link rel=\"next\" href=\""^(fst (Naming.html_files name))^"\">\n"
+ )^
+ (
+ let father = Name.father name in
+ let href = if father = "" then index else fst (Naming.html_files father) in
+ "<link rel=\"Up\" href=\""^href^"\">\n"
+ )
+ )^
+ (link_if_not_empty list_types Odoc_messages.index_of_types index_types)^
+ (link_if_not_empty list_exceptions Odoc_messages.index_of_exceptions index_exceptions)^
+ (link_if_not_empty list_values Odoc_messages.index_of_values index_values)^
+ (link_if_not_empty list_attributes Odoc_messages.index_of_attributes index_attributes)^
+ (link_if_not_empty list_methods Odoc_messages.index_of_methods index_methods)^
+ (link_if_not_empty list_classes Odoc_messages.index_of_classes index_classes)^
+ (link_if_not_empty list_class_types Odoc_messages.index_of_class_types index_class_types)^
+ (link_if_not_empty list_modules Odoc_messages.index_of_modules index_modules)^
+ (link_if_not_empty list_module_types Odoc_messages.index_of_module_types index_module_types)^
+ (String.concat "\n"
+ (List.map
+ (fun m ->
+ let html_file = fst (Naming.html_files m.m_name) in
+ "<link title=\""^m.m_name^"\" rel=\"Chapter\" href=\""^html_file^"\">"
+ )
+ module_list
+ )
+ )^
+ "<title>"^
+ t^
+ "\n\n"
in
header <- f
- (** Print HTML code for navigation bar.
+ (** Html code for navigation bar.
@param pre optional name for optional previous module/class
@param post optional name for optional next module/class
@param name name of current module/class *)
- method navbar fmt pre post name =
- Format.fprintf fmt "@{
";
+ method navbar pre post name =
+ "
"^
(match pre with
- None -> ()
+ None -> ""
| Some name ->
- Format.fprintf fmt "@{%s@}\n"
- (fst (Naming.html_files name))
- Odoc_messages.previous
- );
- let father = Name.father name in
- let href = if father = "" then index else fst (Naming.html_files father) in
- Format.fprintf fmt " @{%s@}\n " href Odoc_messages.up;
-
+ ""^Odoc_messages.previous^"\n"
+ )^
+ " "^
+ (
+ let father = Name.father name in
+ let href = if father = "" then index else fst (Naming.html_files father) in
+ ""^Odoc_messages.up^"\n"
+ )^
+ " "^
(match post with
- None -> ()
- | Some name -> Format.fprintf fmt "@{%s@}\n"
- (fst (Naming.html_files name)) Odoc_messages.next
- );
- Format.fprintf fmt "@}"
+ None -> ""
+ | Some name ->
+ ""^Odoc_messages.next^"\n"
+ )^
+ "
\n"
- (** Print html code with the given string in the keyword style.*)
- method keyword fmt s =
- Format.fprintf fmt "@{%s@}" s
+ (** Return html code with the given string in the keyword style.*)
+ method keyword s =
+ ""^s^""
- (** Print html code with the given string in the constructor style. *)
- method constructor fmt s =
- Format.fprintf fmt "@{%s@}" s
+ (** Return html code with the given string in the constructor style. *)
+ method constructor s = ""^s^""
(** Output the given ocaml code to the given file name. *)
method private output_code in_title file code =
try
- let (fmt, chanout) = self#formatter_of_file file in
- Format.fprintf fmt "@{";
- self#header fmt (self#inner_title in_title);
- Format.fprintf fmt "@{";
- self#html_of_code fmt code;
- Format.fprintf fmt "@}@}";
- Format.pp_print_flush fmt ();
+ let chanout = open_out file in
+ let html_code = self#html_of_code code in
+ output_string chanout (""^(self#header (self#inner_title in_title))^"\n");
+ output_string chanout html_code;
+ output_string chanout "";
close_out chanout
with
Sys_error s ->
@@ -732,43 +678,40 @@ class html =
in
s2
- (** Print html code to display a [Types.type_expr].*)
- method html_of_type_expr fmt m_name t =
+ (** Return html code to display a [Types.type_expr].*)
+ method html_of_type_expr m_name t =
let s = String.concat "\n"
(Str.split (Str.regexp "\n") (Odoc_info.string_of_type_expr t))
in
let s2 = Str.global_replace (Str.regexp "\n") " " s in
- Format.fprintf fmt "@{%s@}"
- (self#create_fully_qualified_idents_links m_name s2)
+ ""^(self#create_fully_qualified_idents_links m_name s2)^""
- (** Print html code to display a [Types.class_type].*)
- method html_of_class_type_expr fmt m_name t =
+
+ (** Return html code to display a [Types.class_type].*)
+ method html_of_class_type_expr m_name t =
let s = String.concat "\n"
(Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type t))
in
let s2 = Str.global_replace (Str.regexp "\n") " " s in
- Format.fprintf fmt "@{%s@}"
- (self#create_fully_qualified_idents_links m_name s2)
+ ""^(self#create_fully_qualified_idents_links m_name s2)^""
- (** Print html code to display a [Types.type_expr list].*)
- method html_of_type_expr_list fmt m_name sep l =
+ (** Return html code to display a [Types.type_expr list].*)
+ method html_of_type_expr_list m_name sep l =
print_DEBUG "html#html_of_type_expr_list";
let s = Odoc_info.string_of_type_list sep l in
print_DEBUG "html#html_of_type_expr_list: 1";
let s2 = Str.global_replace (Str.regexp "\n") " " s in
print_DEBUG "html#html_of_type_expr_list: 2";
- Format.fprintf fmt "@{%s@}"
- (self#create_fully_qualified_idents_links m_name s2)
+ ""^(self#create_fully_qualified_idents_links m_name s2)^""
- (** Print html code to display a [Types.module_type]. *)
- method html_of_module_type fmt m_name t =
+ (** Return html code to display a [Types.module_type]. *)
+ method html_of_module_type m_name t =
let s = String.concat "\n"
(Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type t))
in
let s2 = Str.global_replace (Str.regexp "\n") " " s in
- Format.fprintf fmt "@{%s@}"
- (self#create_fully_qualified_module_idents_links m_name s2)
-
+ ""^(self#create_fully_qualified_module_idents_links m_name s2)^""
+
(** Generate a file containing the module type in the given file name. *)
method output_module_type in_title file mtyp =
let s = String.concat "\n"
@@ -784,256 +727,253 @@ class html =
self#output_code in_title file s
- (** Print html code for a value. *)
- method html_of_value fmt v =
+ (** Return html code for a value. *)
+ method html_of_value v =
Odoc_info.reset_type_names ();
- Format.fprintf fmt "@{
";
- self#keyword fmt "val";
+ "
"^(self#keyword "val")^" "^
(* html mark *)
- Format.fprintf fmt " @{@}" (Naming.value_target v);
+ ""^
(match v.val_code with
- None -> Format.fprintf fmt "%s" (Name.simple v.val_name)
+ None -> Name.simple v.val_name
| Some c ->
let file = Naming.file_code_value_complete_target v in
self#output_code v.val_name (Filename.concat !Odoc_args.target_dir file) c;
- Format.fprintf fmt "@{%s@}" file (Name.simple v.val_name)
- );
- Format.pp_print_string fmt " : ";
- self#html_of_type_expr fmt (Name.father v.val_name) v.val_type;
- Format.fprintf fmt "@}";
- self#html_of_info fmt v.val_info;
-
- if !Odoc_args.with_parameter_list then
- self#html_of_parameter_list fmt (Name.father v.val_name) v.val_parameters
+ ""^(Name.simple v.val_name)^""
+ )^" : "^
+ (self#html_of_type_expr (Name.father v.val_name) v.val_type)^"
"^
+ (self#html_of_info v.val_info)^
+ (if !Odoc_args.with_parameter_list then
+ self#html_of_parameter_list (Name.father v.val_name) v.val_parameters
else
- self#html_of_described_parameter_list fmt (Name.father v.val_name) v.val_parameters
+ self#html_of_described_parameter_list (Name.father v.val_name) v.val_parameters
+ )
- (** Print html code for an exception. *)
- method html_of_exception fmt e =
+ (** Return html code for an exception. *)
+ method html_of_exception e =
Odoc_info.reset_type_names ();
- Format.fprintf fmt "@{
\n"^
+ ""^(if r.rf_mutable then self#keyword "mutable " else "")^
+ r.rf_name^" : "^(self#html_of_type_expr father r.rf_type)^";"^
+ "
\n"^
+ (match r.rf_text with
+ None -> ""
+ | Some t ->
+ "
"^
+ ""^
+ "(*"^
+ "
"^
+ "
"^
+ ""^
+ (self#html_of_text t)^
+ "
"^
+ "
"^
+ ""^
+ "*)"^
+ "
"
+ )^
+ "\n
"
+ )
+ l
+ )
+ )^
+ "
\n"^
+ "}\n"
+ )^"\n"^
+ (self#html_of_info t.ty_info)^
+ " \n"
- (** Print html code for a class attribute. *)
- method html_of_attribute fmt a =
+ (** Return html code for a class attribute. *)
+ method html_of_attribute a =
let module_name = Name.father (Name.father a.att_value.val_name) in
- Format.fprintf fmt "@{
"^
+ (self#html_of_info a.att_value.val_info)
- (** Print html code for a class method. *)
- method html_of_method fmt m =
+ (** Return html code for a class method. *)
+ method html_of_method m =
let module_name = Name.father (Name.father m.met_value.val_name) in
- Format.fprintf fmt "@{
";
- self#keyword fmt "method" ;
+ "
"^(self#keyword "method")^" "^
(* html mark *)
- Format.fprintf fmt " @{@}" (Naming.method_target m);
- if m.met_private then
- (
- self#keyword fmt "private";
- Format.pp_print_string fmt " ";
- );
- if m.met_virtual then
- (
- self#keyword fmt "virtual";
- Format.pp_print_string fmt " ";
- );
+ ""^
+ (if m.met_private then (self#keyword "private")^" " else "")^
+ (if m.met_virtual then (self#keyword "virtual")^" " else "")^
(match m.met_value.val_code with
- None -> Format.pp_print_string fmt (Name.simple m.met_value.val_name)
+ None -> Name.simple m.met_value.val_name
| Some c ->
let file = Naming.file_code_method_complete_target m in
self#output_code m.met_value.val_name (Filename.concat !Odoc_args.target_dir file) c;
- Format.fprintf fmt "@{%s@}" file (Name.simple m.met_value.val_name)
- );
- Format.pp_print_string fmt " : ";
- self#html_of_type_expr fmt module_name m.met_value.val_type;
- Format.fprintf fmt "@}";
- self#html_of_info fmt m.met_value.val_info;
+ ""^(Name.simple m.met_value.val_name)^""
+ )^" : "^
+ (self#html_of_type_expr module_name m.met_value.val_type)^"
"^
+ (self#html_of_info m.met_value.val_info)^
(if !Odoc_args.with_parameter_list then
- self#html_of_parameter_list fmt module_name m.met_value.val_parameters
+ self#html_of_parameter_list module_name m.met_value.val_parameters
else
- self#html_of_described_parameter_list fmt module_name m.met_value.val_parameters
+ self#html_of_described_parameter_list module_name m.met_value.val_parameters
)
- (** Print html code for the description of a function parameter. *)
- method html_of_parameter_description fmt p =
+ (** Return html code for the description of a function parameter. *)
+ method html_of_parameter_description p =
match Parameter.names p with
- [] -> ()
+ [] ->
+ ""
| name :: [] ->
(
(* Only one name, no need for label for the description. *)
match Parameter.desc_by_name p name with
- None -> ()
- | Some t -> self#html_of_text fmt t
+ None -> ""
+ | Some t -> self#html_of_text t
)
| l ->
(* A list of names, we display those with a description. *)
let l2 = List.filter (fun n -> (Parameter.desc_by_name p n) <> None) l in
- List.iter
- (fun n ->
- match Parameter.desc_by_name p n with
- None -> ()
- | Some t ->
- Format.fprintf fmt "@{%s@} : " n ;
- self#html_of_text fmt t;
- Format.pp_print_string fmt " \n"
+ String.concat " \n"
+ (List.map
+ (fun n ->
+ match Parameter.desc_by_name p n with
+ None -> ""
+ | Some t -> ""^n^" : "^(self#html_of_text t)
+ )
+ l2
)
- l2
- (** Print html code for a list of parameters. *)
- method html_of_parameter_list fmt m_name l =
+ (** Return html code for a list of parameters. *)
+ method html_of_parameter_list m_name l =
match l with
- [] -> ()
+ [] ->
+ ""
| _ ->
- Format.fprintf fmt "@{
\n"
- Format.fprintf fmt "@}@}@}@}@}"
-
- (** Print html code for the parameters which have a name and description. *)
- method html_of_described_parameter_list fmt m_name l =
+ (** Return html code for the parameters which have a name and description. *)
+ method html_of_described_parameter_list m_name l =
(* get the params which have a name, and at least one name described. *)
let l2 = List.filter
(fun p ->
@@ -1043,89 +983,96 @@ class html =
l
in
let f p =
- Format.fprintf fmt "@{
"^(self#html_of_module_type m_name p.mp_type)^"\n"^
+ (match desc_opt with
+ None -> ""
+ | Some t -> " "^(self#html_of_text t))^
+ "\n"^
+ "
\n"
+ )
+ l
+ )
+ )^"
\n"^
+ "
\n"^
+ "
\n"^
+ "
\n"
- Format.fprintf fmt "@}@}@}@}"
-
- (** Print html code for a module. *)
- method html_of_module fmt ?(info=true) ?(complete=true) ?(with_link=true) m =
+ (** Return html code for a module. *)
+ method html_of_module ?(info=true) ?(complete=true) ?(with_link=true) m =
let (html_file, _) = Naming.html_files m.m_name in
let father = Name.father m.m_name in
- Format.fprintf fmt "@{
";
- self#keyword fmt "module";
- Format.pp_print_string fmt " ";
-
- if with_link then
- Format.fprintf fmt "@{%s@}" html_file (Name.simple m.m_name)
- else
- Format.fprintf fmt "%s" (Name.simple m.m_name);
-
- Format.pp_print_string fmt ": ";
- self#html_of_module_type fmt father m.m_type;
- Format.fprintf fmt "@}";
+ let buf = Buffer.create 32 in
+ let p = Printf.bprintf in
+ p buf "
%s " (self#keyword "module");
+ (
+ if with_link then
+ p buf "%s" html_file (Name.simple m.m_name)
+ else
+ p buf "%s" (Name.simple m.m_name)
+ );
+ p buf ": %s
" (self#html_of_module_type father m.m_type);
if info then
- (if complete then self#html_of_info
- else self#html_of_info_first_sentence) fmt m.m_info
-
+ p buf "%s" ((if complete then self#html_of_info else self#html_of_info_first_sentence) m.m_info)
+ else
+ ();
+ Buffer.contents buf
- (** Print html code for a module type. *)
- method html_of_modtype fmt ?(info=true) ?(complete=true) ?(with_link=true) mt =
+ (** Return html code for a module type. *)
+ method html_of_modtype ?(info=true) ?(complete=true) ?(with_link=true) mt =
let (html_file, _) = Naming.html_files mt.mt_name in
let father = Name.father mt.mt_name in
- Format.fprintf fmt "@{
";
- self#keyword fmt "module type";
- Format.pp_print_string fmt " ";
-
- if with_link then
- Format.fprintf fmt "@{%s@}" html_file (Name.simple mt.mt_name)
- else
- Format.fprintf fmt "%s" (Name.simple mt.mt_name);
-
+ let buf = Buffer.create 32 in
+ let p = Printf.bprintf in
+ p buf "
%s " (self#keyword "module type");
+ (
+ if with_link then
+ p buf "%s" html_file (Name.simple mt.mt_name)
+ else
+ p buf "%s" (Name.simple mt.mt_name)
+ );
(match mt.mt_type with
None -> ()
- | Some mtyp ->
- Format.pp_print_string fmt " = ";
- self#html_of_module_type fmt father mtyp
+ | Some mtyp -> p buf " = %s" (self#html_of_module_type father mtyp)
);
- Format.fprintf fmt "@}";
+ Buffer.add_string buf "
";
if info then
- (if complete then self#html_of_info else self#html_of_info_first_sentence) fmt mt.mt_info
+ p buf "%s" ((if complete then self#html_of_info else self#html_of_info_first_sentence) mt.mt_info)
+ else
+ ();
+ Buffer.contents buf
- (** Print html code for an included module. *)
- method html_of_included_module fmt im =
- Format.fprintf fmt "@{
";
- self#keyword fmt "include";
- Format.pp_print_string fmt " ";
+ (** Return html code for an included module. *)
+ method html_of_included_module im =
+ "
"^(self#keyword "include")^" "^
(
match im.im_module with
- None -> Format.pp_print_string fmt im.im_name
+ None ->
+ im.im_name
| Some mmt ->
let (file, name) =
match mmt with
@@ -1136,95 +1083,87 @@ class html =
let (html_file, _) = Naming.html_files mt.mt_name in
(html_file, mt.mt_name)
in
- Format.fprintf fmt "@{%s@}" file (Name.simple name)
- );
- Format.fprintf fmt "@}"
+ ""^(Name.simple name)^""
+ )^
+ "
\n"
- (** Print html code for a class. *)
- method html_of_class fmt ?(complete=true) ?(with_link=true) c =
+ (** Return html code for a class. *)
+ method html_of_class ?(complete=true) ?(with_link=true) c =
let father = Name.father c.cl_name in
Odoc_info.reset_type_names ();
+ let buf = Buffer.create 32 in
let (html_file, _) = Naming.html_files c.cl_name in
- Format.fprintf fmt "@{
";
- self#keyword fmt "class";
- Format.pp_print_string fmt " ";
+ let p = Printf.bprintf in
+ p buf "
%s " (self#keyword "class");
(* we add a html tag, the same as for a type so we can
go directly here when the class name is used as a type name *)
- Format.fprintf fmt "@{@}"
+ p buf ""
(Naming.type_target
{ ty_name = c.cl_name ;
ty_info = None ; ty_parameters = [] ;
ty_kind = Type_abstract ; ty_manifest = None ;
ty_loc = Odoc_info.dummy_loc });
print_DEBUG "html#html_of_class : virtual or not" ;
- if c.cl_virtual then
- (
- self#keyword fmt "virtual";
- Format.pp_print_string fmt " "
- );
+ if c.cl_virtual then p buf "%s " (self#keyword "virtual") else ();
(
match c.cl_type_parameters with
[] -> ()
| l ->
- Format.pp_print_string fmt "[";
- self#html_of_type_expr_list fmt father ", " l;
- Format.pp_print_string fmt "]"
+ p buf "[%s] "
+ (self#html_of_type_expr_list father ", " l)
);
print_DEBUG "html#html_of_class : with link or not" ;
(
if with_link then
- Format.fprintf fmt "@{%s@}" html_file (Name.simple c.cl_name)
+ p buf "%s" html_file (Name.simple c.cl_name)
else
- Format.pp_print_string fmt (Name.simple c.cl_name)
+ p buf "%s" (Name.simple c.cl_name)
);
- Format.pp_print_string fmt " : " ;
- self#html_of_class_type_expr fmt father c.cl_type;
- Format.fprintf fmt "@}";
+ Buffer.add_string buf " : " ;
+ Buffer.add_string buf (self#html_of_class_type_expr father c.cl_type);
+ Buffer.add_string buf "
" ;
print_DEBUG "html#html_of_class : info" ;
- (if complete then self#html_of_info else self#html_of_info_first_sentence) fmt c.cl_info
+ Buffer.add_string buf
+ ((if complete then self#html_of_info else self#html_of_info_first_sentence) c.cl_info);
+ Buffer.contents buf
- (** Print html code for a class type. *)
- method html_of_class_type fmt ?(complete=true) ?(with_link=true) ct =
+ (** Return html code for a class type. *)
+ method html_of_class_type ?(complete=true) ?(with_link=true) ct =
Odoc_info.reset_type_names ();
let father = Name.father ct.clt_name in
+ let buf = Buffer.create 32 in
+ let p = Printf.bprintf in
let (html_file, _) = Naming.html_files ct.clt_name in
- Format.fprintf fmt "@{
%s " (self#keyword "class type");
(* we add a html tag, the same as for a type so we can
go directly here when the class type name is used as a type name *)
- Format.fprintf fmt "@{@}"
+ p buf ""
(Naming.type_target
{ ty_name = ct.clt_name ;
ty_info = None ; ty_parameters = [] ;
ty_kind = Type_abstract ; ty_manifest = None ;
ty_loc = Odoc_info.dummy_loc });
- if ct.clt_virtual then
- (
- self#keyword fmt "virtual";
- Format.pp_print_string fmt " "
- );
+ if ct.clt_virtual then p buf "%s "(self#keyword "virtual") else ();
(
match ct.clt_type_parameters with
[] -> ()
- | l ->
- Format.pp_print_string fmt "[";
- self#html_of_type_expr_list fmt father ", " l;
- Format.pp_print_string fmt "]"
+ | l -> p buf "[%s] " (self#html_of_type_expr_list father ", " l)
);
if with_link then
- Format.fprintf fmt "@{%s@}" html_file (Name.simple ct.clt_name)
+ p buf "%s" html_file (Name.simple ct.clt_name)
else
- Format.pp_print_string fmt (Name.simple ct.clt_name);
+ p buf "%s" (Name.simple ct.clt_name);
- Format.pp_print_string fmt " = ";
- self#html_of_class_type_expr fmt father ct.clt_type;
- Format.fprintf fmt "@}";
- (if complete then self#html_of_info else self#html_of_info_first_sentence) fmt ct.clt_info
+ Buffer.add_string buf " = ";
+ Buffer.add_string buf (self#html_of_class_type_expr father ct.clt_type);
+ Buffer.add_string buf "
";
+ Buffer.add_string buf ((if complete then self#html_of_info else self#html_of_info_first_sentence) ct.clt_info);
- (** Get html code to represent a dag, represented as in Odoc_dag2html. *)
+ Buffer.contents buf
+
+ (** Return html code to represent a dag, represented as in Odoc_dag2html. *)
method html_of_dag dag =
let f n =
let (name, cct_opt) = n.Odoc_dag2html.valu in
@@ -1246,14 +1185,12 @@ class html =
let a = Array.map f dag.Odoc_dag2html.dag in
Odoc_dag2html.html_of_dag { Odoc_dag2html.dag = a }
- (** Print html code for a module comment.*)
- method html_of_module_comment fmt text =
- Format.pp_print_string fmt " \n";
- self#html_of_text fmt text;
- Format.pp_print_string fmt "
\n"
+ (** Return html code for a module comment.*)
+ method html_of_module_comment text =
+ " \n"^(self#html_of_text text)^"
\n"
- (** Print html code for a class comment.*)
- method html_of_class_comment fmt text =
+ (** Return html code for a class comment.*)
+ method html_of_class_comment text =
(* Add some style if there is no style for the first part of the text. *)
let text2 =
match text with
@@ -1261,10 +1198,10 @@ class html =
(Odoc_info.Title (2, None, [Odoc_info.Raw s])) :: q
| _ -> text
in
- self#html_of_text fmt text2
+ self#html_of_text text2
- (** Print html code for the given list of inherited classes.*)
- method generate_inheritance_info fmt inher_l =
+ (** Generate html 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 link. *)
@@ -1290,7 +1227,8 @@ class html =
Odoc_info.List (List.map f inher_l)
]
in
- self#html_of_text fmt text
+ let html = self#html_of_text text in
+ output_string chanout html
(** Generate html code for the inherited classes of the given class. *)
method generate_class_inheritance_info chanout cl =
@@ -1309,12 +1247,12 @@ class html =
iter_kind cl.cl_kind
(** Generate html code for the inherited classes of the given class type. *)
- method generate_class_type_inheritance_info fmt clt =
+ method generate_class_type_inheritance_info chanout clt =
match clt.clt_kind with
Class_signature ([], _) ->
()
| Class_signature (l, _) ->
- self#generate_inheritance_info fmt l
+ self#generate_inheritance_info chanout l
| Class_type _ ->
()
@@ -1327,10 +1265,13 @@ class html =
('a -> string) -> string -> string -> unit =
fun elements name info target title simple_file ->
try
- let (fmt,chanout) = self#formatter_of_file (Filename.concat !Odoc_args.target_dir simple_file) in
- Format.fprintf fmt "@{";
- self#header fmt (self#inner_title title);
- Format.fprintf fmt "@{@{
\n");
let sorted_elements = List.sort
(fun e1 -> fun e2 -> compare (Name.simple (name e1)) (Name.simple (name e2)))
@@ -1340,12 +1281,16 @@ class html =
let f_ele e =
let simple_name = Name.simple (name e) in
let father_name = Name.father (name e) in
- Format.fprintf fmt "@{
\n"^
+ "\n"^
+ ""
+ );
close_out chanout
with
Sys_error s ->
@@ -1802,48 +1781,9 @@ class html =
prerr_endline s ;
incr Odoc_info.errors
- method init_formatter fmt =
- let htag s =
- try
- let i = String.index s ' ' in
- String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1)
- with Not_found -> s, ""
- in
-
- let mark_open_tag s =
- let tag, vals = htag s in
- match tag with
- | "href" -> ""
- | "mark" -> ""
- | "ul" | "li" | "ol" | "html" | "body"
- | "table" | "tr" | "td" | "head" ->
- "<" ^ tag ^(if vals = "" then "" else " "^vals)^ ">\n"
- | t -> "<" ^ t ^ " " ^ vals ^ ">"
- in
- let mark_close_tag s =
- let tag, vals = htag s in
- match tag with
- | "href" -> ""
- | "mark" -> ""
- | "ul" | "li" | "ol" | "html" | "body" | "pre"
- | "table" | "tr" | "td" | "head" -> "\n"
- | t -> ""
- in
- Format.pp_set_formatter_tag_functions fmt
- {(Format.pp_get_formatter_tag_functions fmt ()) with
- Format.mark_close_tag = mark_close_tag;
- Format.mark_open_tag = mark_open_tag}
-
- method formatter_of_file file =
- let chanout = open_out file in
- let fmt = Format.formatter_of_out_channel chanout in
- self#init_formatter fmt;
- (fmt, chanout)
-
initializer
Odoc_ocamlhtml.html_of_comment :=
- (fun fmt -> fun s -> self#html_of_text fmt (Odoc_text.Texter.text_of_string s));
-
+ (fun s -> self#html_of_text (Odoc_text.Texter.text_of_string s))
end
diff --git a/ocamldoc/odoc_ocamlhtml.mll b/ocamldoc/odoc_ocamlhtml.mll
index 5e847a112..5881f4a59 100644
--- a/ocamldoc/odoc_ocamlhtml.mll
+++ b/ocamldoc/odoc_ocamlhtml.mll
@@ -80,8 +80,7 @@ let create_hashtable size init =
(** The function used to return html code for the given comment body. *)
let html_of_comment = ref
- (fun (fmt: Format.formatter) (s : string) ->
- Format.fprintf fmt "@{Odoc_ocamlhtml.html_of_comment not initialized@}")
+ (fun (s : string) -> "Odoc_ocamlhtml.html_of_comment not initialized")
let keyword_table =
create_hashtable 149 [
@@ -170,28 +169,28 @@ let make_margin () =
let print_comment () =
let s = Buffer.contents comment_buffer in
let len = String.length s in
- if len < 1 then
- Format.fprintf !fmt "@{(*%s*)@}" comment_class (escape s)
- else
- match s.[0] with
- '*' ->
- (
- try
- Format.pp_print_string !fmt
- ("