Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

back to strings, not using format, and .type class added in generated style.css file 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4740 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Maxence Guesdon 2002-04-25 13:46:51 +00:00
parent c2df5a19ee
commit 56bfe8ac25
2 changed files with 796 additions and 848 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1556
ocamldoc/odoc_html.ml
View File

File diff suppressed because it is too large Load Diff

88
ocamldoc/odoc_ocamlhtml.mll
View File

@ -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 "@{<b>Odoc_ocamlhtml.html_of_comment not initialized@}")
(fun (s : string) -> "<b>Odoc_ocamlhtml.html_of_comment not initialized</b>")
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 "@{<span class=\"%s\">(*%s*)@}" comment_class (escape s)
else
match s.[0] with
'*' ->
(
try
Format.pp_print_string !fmt
("</code><table><tr><td>"^(make_margin ())^"</td><td>"^
"<span class=\""^comment_class^"\">"^
"(**");
!html_of_comment !fmt (String.sub s 1 (len-1));
Format.pp_print_string !fmt
("*)</span></td></tr></table><code class=\""^code_class^"\">")
with
e ->
prerr_endline (Printexc.to_string e);
Format.pp_print_string !fmt
("<span class=\""^comment_class^"\">(*"^(escape s)^"*)</span>")
)
| _ ->
Format.fprintf !fmt "@{<span class=\"%s\">(*%s*)@}" comment_class (escape s)
let code =
if len < 1 then
"<span class=\""^comment_class^"\">(*"^(escape s)^"*)</span>"
else
match s.[0] with
'*' ->
(
try
let html = !html_of_comment (String.sub s 1 (len-1)) in
"</code><table><tr><td>"^(make_margin ())^"</td><td>"^
"<span class=\""^comment_class^"\">"^
"(**"^html^"*)"^
"</span></td></tr></table><code class=\""^code_class^"\">"
with
e ->
prerr_endline (Printexc.to_string e);
"<span class=\""^comment_class^"\">(*"^(escape s)^"*)</span>"
)
| _ ->
"<span class=\""^comment_class^"\">(*"^(escape s)^"*)</span>"
in
print ~esc: false code
(** To buffer string literals *)
@ -495,36 +494,45 @@ and string = parse
string lexbuf }
{
let html_of_code formatter ?(with_pre=true) code =
let html_of_code ?(with_pre=true) code =
let old_pre = !pre in
let old_margin = !margin in
let old_comment_buffer = Buffer.contents comment_buffer in
let old_string_buffer = Buffer.contents string_buffer in
let old_fmt = !fmt in
let buf = Buffer.create 256 in
fmt := Format.formatter_of_buffer buf;
let old_fmt = !fmt in
fmt := Format.formatter_of_buffer buf ;
pre := with_pre;
margin := 0;
Format.fprintf formatter "@{<code class=\"%s\">" code_class ;
(
try
let lexbuf = Lexing.from_string code in
ignore (token lexbuf);
Format.pp_print_flush !fmt ();
Format.pp_print_string formatter (Buffer.contents buf)
with
_ ->
Format.pp_print_string formatter (escape code)
);
Format.fprintf formatter "@}";
let start = "<code class=\""^code_class^"\">" in
let ending = "</code>" in
let html =
(
try
print ~esc: false start ;
let lexbuf = Lexing.from_string code in
let _ = token lexbuf in
print ~esc: false ending ;
Format.pp_print_flush !fmt () ;
Buffer.contents buf
with
_ ->
(* flush str_formatter because we already output
something in it *)
Format.pp_print_flush !fmt () ;
start^code^ending
)
in
pre := old_pre;
fmt := old_fmt;
margin := old_margin ;
Buffer.reset comment_buffer;
Buffer.add_string comment_buffer old_comment_buffer ;
Buffer.reset string_buffer;
Buffer.add_string string_buffer old_string_buffer ;
fmt := old_fmt ;
html
}