Skip to content

Commit

Permalink
Merge pull request #10363 from Octachron/ocamldoc_entities
Browse files Browse the repository at this point in the history
ocamldoc: escape <, > and & in html backend
  • Loading branch information
gasche committed Apr 22, 2021
2 parents 2264171 + 6422902 commit b9acbd6
Show file tree
Hide file tree
Showing 6 changed files with 67 additions and 11 deletions.
3 changes: 3 additions & 0 deletions Changes
Expand Up @@ -172,6 +172,9 @@ Working version

### Tools:

- #8645, #10363: ocamldoc: escape `<`, `>`, and `&` in html backend.
(Florian Angeletti, report by Wim Lewis, review by Gabriel Scherer)

- #10139: Remove confusing navigation bar from stdlib documentation.
Adds a -nonavbar option to ocamldoc, and uses it to improve navigation within
the reference manual.
Expand Down
21 changes: 13 additions & 8 deletions ocamldoc/odoc_html.ml
Expand Up @@ -816,12 +816,17 @@ let print_concat b sep f =
in
iter

let newline_to_indented_br s =

(** Escape "\n", "<", ">", and "&" *)
let text_to_html s =
let len = String.length s in
let b = Buffer.create len in
for i = 0 to len - 1 do
match s.[i] with
'\n' -> Buffer.add_string b "<br> "
| '\n' -> Buffer.add_string b "<br> "
| '<' -> Buffer.add_string b "&lt;"
| '>' -> Buffer.add_string b "&gt;"
| '&' -> Buffer.add_string b "&amp;"
| c -> Buffer.add_char b c
done;
Buffer.contents b
Expand Down Expand Up @@ -1307,7 +1312,7 @@ class html =
(** Print html code to display a [Types.type_expr]. *)
method html_of_type_expr b m_name t =
let s = Odoc_info.remove_ending_newline (Odoc_info.string_of_type_expr t) in
let s2 = newline_to_indented_br s in
let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>"
Expand All @@ -1317,7 +1322,7 @@ class html =
match l with
| Cstr_tuple l ->
let s = Odoc_info.string_of_type_list ?par sep l in
let s2 = newline_to_indented_br s in
let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>"
Expand All @@ -1331,23 +1336,23 @@ class html =
of a class of class type. *)
method html_of_class_type_param_expr_list b m_name l =
let s = Odoc_info.string_of_class_type_param_list l in
let s2 = newline_to_indented_br s in
let s2 = text_to_html s in
bs b "<code class=\"type\">[";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "]</code>"

method html_of_class_parameter_list b father c =
let s = Odoc_info.string_of_class_params c in
let s = Odoc_info.remove_ending_newline s in
let s2 = newline_to_indented_br s in
let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links father s2);
bs b "</code>"

(** Print html code to display a list of type parameters for the given type.*)
method html_of_type_expr_param_list b m_name t =
let s = Odoc_info.string_of_type_param_list t in
let s2 = newline_to_indented_br s in
let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>"
Expand Down Expand Up @@ -1563,7 +1568,7 @@ class html =
bs b "<pre><code>";
bs b ((self#keyword "type")^" ");
let s = Odoc_info.string_of_type_extension_param_list te in
let s2 = newline_to_indented_br s in
let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>";
Expand Down
40 changes: 40 additions & 0 deletions testsuite/tests/tool-ocamldoc/Entities.html.reference
@@ -0,0 +1,40 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<link rel="stylesheet" href="style.css" type="text/css">
<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
<meta name="viewport" content="width=device-width, initial-scale=1">
<link rel="Start" href="index.html">
<link rel="Up" href="index.html">
<link title="Index of types" rel=Appendix href="index_types.html">
<link title="Index of modules" rel=Appendix href="index_modules.html">
<link title="Entities" rel="Chapter" href="Entities.html"><title>Entities</title>
</head>
<body>
<div class="navbar">&nbsp;<a class="up" href="index.html" title="Index">Up</a>
&nbsp;</div>
<h1>Module <a href="type_Entities.html">Entities</a></h1>

<pre><span id="MODULEEntities"><span class="keyword">module</span> Entities</span>: <code class="code"><span class="keyword">sig</span></code> <a href="Entities.html">..</a> <code class="code"><span class="keyword">end</span></code></pre><hr width="100%">

<pre><span id="TYPEul"><span class="keyword">type</span> <code class="type"></code>ul</span> </pre>


<pre><span id="TYPEli"><span class="keyword">type</span> <code class="type"></code>li</span> </pre>


<pre><span id="TYPEamp"><span class="keyword">type</span> <code class="type"></code>amp</span> </pre>


<pre><span id="TYPEt"><span class="keyword">type</span> <code class="type">[&lt; `A of &amp; <a href="Entities.html#TYPEamp">amp</a> ]</code> t</span> = &lt;</pre><table class="typetable">
<tr>
<td align="left" valign="top" >
<code>&nbsp;&nbsp;</code></td>
<td align="left" valign="top" >
<code><span id="TYPEELTt.ul">ul</span>&nbsp;: <code class="type">&lt; li : [&lt; `A of &amp; <a href="Entities.html#TYPEamp">amp</a> ] as 'a &gt;</code>;</code></td>

</tr></table>
>
</pre>

</body></html>
8 changes: 8 additions & 0 deletions testsuite/tests/tool-ocamldoc/Entities.ml
@@ -0,0 +1,8 @@
(* TEST
* ocamldoc with html
*)

type ul
type li
type amp
type 'a t = <ul: <li:[<`A of &amp] as 'a> >
4 changes: 2 additions & 2 deletions testsuite/tests/tool-ocamldoc/Inline_records.html.reference
Expand Up @@ -299,7 +299,7 @@
<td align="left" valign="top" >
<code>&nbsp;&nbsp;</code></td>
<td align="left" valign="top" >
<code><span id="TYPEELTInline_records.F.even_more">even_more</span>&nbsp;: <code class="type">int -> int</code>;</code></td>
<code><span id="TYPEELTInline_records.F.even_more">even_more</span>&nbsp;: <code class="type">int -&gt; int</code>;</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
<p>Some field documentations for <code class="code"><span class="constructor">F</span></code></p>
Expand All @@ -325,7 +325,7 @@
<td align="left" valign="top" >
<code>&nbsp;&nbsp;</code></td>
<td align="left" valign="top" >
<code><span id="TYPEELTInline_records.G.last">last</span>&nbsp;: <code class="type">int -> int</code>;</code></td>
<code><span id="TYPEELTInline_records.G.last">last</span>&nbsp;: <code class="type">int -&gt; int</code>;</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
<p>The last and least field documentation</p>
Expand Down
Expand Up @@ -20,5 +20,5 @@
<pre><span id="TYPEt"><span class="keyword">type</span> <code class="type"></code>t</span> = <code class="type">int</code> </pre>


<pre><span id="VALcompare"><span class="keyword">val</span> compare</span> : <code class="type">'a -> 'a -> int</code></pre></div>
<pre><span id="VALcompare"><span class="keyword">val</span> compare</span> : <code class="type">'a -&gt; 'a -&gt; int</code></pre></div>
<pre><code class="code"><span class="keyword">end</span></code><code class="code">)</code></pre></body></html>

0 comments on commit b9acbd6

Please sign in to comment.