Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Annotate code that is following or followed by other code #863

Closed
wants to merge 2 commits into from
Closed

Annotate code that is following or followed by other code #863

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
da74727
Augment Inline.t with the information about being preformatted
favonia Jun 8, 2022
56fdef1
Update the HTML generator
favonia Jun 8, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 35 additions & 2 deletions src/document/types.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,9 +35,11 @@ and Inline : sig

type href = string

type preformatted = { begin_ : bool; end_ : bool }

type t = one list

and one = { attr : Class.t; desc : desc }
and one = { attr : Class.t; preformatted : preformatted; desc : desc }

and desc =
| Text of string
Expand Down Expand Up @@ -159,6 +161,37 @@ and Page : sig
end =
Page

let inline ?(attr = []) desc = Inline.{ attr; desc }
let rec last = function
| [] -> invalid_arg "last"
| [ x ] -> x
| _ :: xs -> last xs

(* Checking whether an Inline.desc starts with or ends with preformatted text.
This is only an approximation as we did not check whether the text is empty
[Text ""] or the styled inline is empty [Style (_, [])]. *)
let rec is_inline_preformatted =
let open Inline in
function
| Text _ | Linebreak -> { begin_ = false; end_ = false }
| Entity _ | Source _ -> { begin_ = true; end_ = true }
| Styled (_, is) | Link (_, is) -> is_inline_list_preformatted is
| InternalLink il -> is_internallink_preformatted il
(* Ideally, the markup should be parsed *)
| Raw_markup _ -> { begin_ = false; end_ = false }

and is_inline_list_preformatted = function
| [] -> { begin_ = false; end_ = false }
| l ->
{
begin_ = (List.hd l).preformatted.begin_;
end_ = (last l).preformatted.end_;
}

and is_internallink_preformatted = function
| Resolved (_, is) | Unresolved is -> is_inline_list_preformatted is

let inline ?(attr = []) desc =
let preformatted = is_inline_preformatted desc in
Inline.{ attr; preformatted; desc }

let block ?(attr = []) desc = Block.{ attr; desc }
103 changes: 74 additions & 29 deletions src/html/generator.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,28 @@ type phrasing = Html_types.phrasing

type non_link_phrasing = Html_types.phrasing_without_interactive

type context = { following_code : bool; followed_by_code : bool }

let default_context = { following_code = false; followed_by_code = false }

let rec inline_list_concat_map ~context ~f = function
| [] -> []
| [ x ] -> f ~context x
| x1 :: (x2 :: _ as xs) ->
let hd =
let context =
{ context with followed_by_code = x2.Inline.preformatted.begin_ }
in
f ~context x1
in
let tl =
let context =
{ context with following_code = x1.Inline.preformatted.end_ }
in
inline_list_concat_map ~context ~f xs
in
hd @ tl

let mk_anchor_link id =
[ Html.a ~a:[ Html.a_href ("#" ^ id); Html.a_class [ "anchor" ] ] [] ]

Expand All @@ -42,6 +64,14 @@ let mk_anchor anchor =

let class_ (l : Class.t) = if l = [] then [] else [ Html.a_class l ]

let class_with_context ~context (l : Class.t) =
class_ @@ l
@ List.concat
[
(if context.following_code then [ "following-code" ] else []);
(if context.followed_by_code then [ "followed-by-code" ] else []);
]

and raw_markup (t : Raw_markup.t) =
let target, content = t in
match Astring.String.Ascii.lowercase target with
Expand Down Expand Up @@ -74,13 +104,15 @@ and styled style ~emph_level =
| `Superscript -> (emph_level, Html.sup ~a:[])
| `Subscript -> (emph_level, Html.sub ~a:[])

let rec internallink ~emph_level ~resolve ?(a = []) (t : InternalLink.t) =
let rec internallink ~context ~emph_level ~resolve ?(a = [])
(t : InternalLink.t) =
match t with
| Resolved (uri, content) ->
let href = Link.href ~resolve uri in
let a = (a :> Html_types.a_attrib Html.attrib list) in
let elt =
Html.a ~a:(Html.a_href href :: a) (inline_nolink ~emph_level content)
Html.a ~a:(Html.a_href href :: a)
(inline_nolink ~context ~emph_level content)
in
let elt = (elt :> phrasing Html.elt) in
[ elt ]
Expand All @@ -90,67 +122,74 @@ let rec internallink ~emph_level ~resolve ?(a = []) (t : InternalLink.t) =
* (ref_to_string ref)
* in *)
let a = Html.a_class [ "xref-unresolved" ] :: a in
let elt = Html.span ~a (inline ~emph_level ~resolve content) in
let elt = Html.span ~a (inline ~context ~emph_level ~resolve content) in
let elt = (elt :> phrasing Html.elt) in
[ elt ]

and internallink_nolink ~emph_level
and internallink_nolink ~context ~emph_level
~(a : Html_types.span_attrib Html.attrib list) (t : InternalLink.t) =
match t with
| Resolved (_, content) | Unresolved content ->
[ Html.span ~a (inline_nolink ~emph_level content) ]
[ Html.span ~a (inline_nolink ~context ~emph_level content) ]

and inline ?(emph_level = 0) ~resolve (l : Inline.t) : phrasing Html.elt list =
let one (t : Inline.one) =
and inline ~context ?(emph_level = 0) ~resolve (l : Inline.t) :
phrasing Html.elt list =
let one ~context (t : Inline.one) =
let a = class_ t.attr in
match t.desc with
| Text "" -> []
| Text s ->
if a = [] then [ Html.txt s ] else [ Html.span ~a [ Html.txt s ] ]
| Entity s ->
let a = class_with_context ~context t.attr in
if a = [] then [ Html.entity s ] else [ Html.span ~a [ Html.entity s ] ]
| Linebreak -> [ Html.br ~a () ]
| Styled (style, c) ->
let emph_level, app_style = styled style ~emph_level in
[ app_style @@ inline ~emph_level ~resolve c ]
[ app_style @@ inline ~context ~emph_level ~resolve c ]
| Link (href, c) ->
let a = (a :> Html_types.a_attrib Html.attrib list) in
let content = inline_nolink ~emph_level c in
let content = inline_nolink ~context ~emph_level c in
[ Html.a ~a:(Html.a_href href :: a) content ]
| InternalLink c -> internallink ~emph_level ~resolve ~a c
| Source c -> source (inline ~emph_level ~resolve) ~a c
| InternalLink c -> internallink ~context ~emph_level ~resolve ~a c
| Source c ->
let a = class_with_context ~context t.attr in
source (inline ~context:default_context ~emph_level ~resolve) ~a c
| Raw_markup r -> raw_markup r
in
Utils.list_concat_map ~f:one l
inline_list_concat_map ~context ~f:one l

and inline_nolink ?(emph_level = 0) (l : Inline.t) :
and inline_nolink ~context ?(emph_level = 0) (l : Inline.t) :
non_link_phrasing Html.elt list =
let one (t : Inline.one) =
let one ~context (t : Inline.one) =
let a = class_ t.attr in
match t.desc with
| Text "" -> []
| Text s ->
if a = [] then [ Html.txt s ] else [ Html.span ~a [ Html.txt s ] ]
| Entity s ->
let a = class_with_context ~context t.attr in
if a = [] then [ Html.entity s ] else [ Html.span ~a [ Html.entity s ] ]
| Linebreak -> [ Html.br ~a () ]
| Styled (style, c) ->
let emph_level, app_style = styled style ~emph_level in
[ app_style @@ inline_nolink ~emph_level c ]
| Link (_, c) -> inline_nolink ~emph_level c
| InternalLink c -> internallink_nolink ~emph_level ~a c
| Source c -> source (inline_nolink ~emph_level) ~a c
[ app_style @@ inline_nolink ~context ~emph_level c ]
| Link (_, c) -> inline_nolink ~context ~emph_level c
| InternalLink c -> internallink_nolink ~context ~emph_level ~a c
| Source c ->
let a = class_with_context ~context t.attr in
source (inline_nolink ~context:default_context ~emph_level) ~a c
| Raw_markup r -> raw_markup r
in
Utils.list_concat_map ~f:one l
inline_list_concat_map ~context ~f:one l

let heading ~resolve (h : Heading.t) =
let a, anchor =
match h.label with
| Some id -> ([ Html.a_id id ], mk_anchor_link id)
| None -> ([], [])
in
let content = inline ~resolve h.title in
let content = inline ~context:default_context ~resolve h.title in
let mk =
match h.level with
| 0 -> Html.h1
Expand All @@ -171,17 +210,19 @@ let rec block ~resolve (l : Block.t) : flow Html.elt list =
in
match t.desc with
| Inline i ->
if t.attr = [] then as_flow @@ inline ~resolve i
else mk_block Html.span (inline ~resolve i)
| Paragraph i -> mk_block Html.p (inline ~resolve i)
if t.attr = [] then
as_flow @@ inline ~context:default_context ~resolve i
else mk_block Html.span (inline ~context:default_context ~resolve i)
| Paragraph i ->
mk_block Html.p (inline ~context:default_context ~resolve i)
| List (typ, l) ->
let mk = match typ with Ordered -> Html.ol | Unordered -> Html.ul in
mk_block mk (List.map (fun x -> Html.li (block ~resolve x)) l)
| Description l ->
let item i =
let a = class_ i.Description.attr in
let term =
(inline ~resolve i.Description.key
(inline ~resolve ~context:default_context i.Description.key
: phrasing Html.elt list
:> flow Html.elt list)
in
Expand All @@ -195,7 +236,8 @@ let rec block ~resolve (l : Block.t) : flow Html.elt list =
let extra_class =
match lang_tag with None -> [] | Some lang -> [ "language-" ^ lang ]
in
mk_block ~extra_class Html.pre (source (inline ~resolve) c)
mk_block ~extra_class Html.pre
(source (inline ~context:default_context ~resolve) c)
in
Utils.list_concat_map l ~f:one

Expand Down Expand Up @@ -241,14 +283,16 @@ let rec documentedSrc ~resolve (t : DocumentedSrc.t) : item Html.elt list =
| [] -> []
| (Code _ | Alternative _) :: _ ->
let code, _, rest = take_code t in
source (inline ~resolve) code @ to_html rest
source (inline ~context:default_context ~resolve) code @ to_html rest
| Subpage subp :: _ -> subpage ~resolve subp
| (Documented _ | Nested _) :: _ ->
let l, _, rest = take_descr t in
let one { DocumentedSrc.attrs; anchor; code; doc; markers } =
let content =
match code with
| `D code -> (inline ~resolve code :> item Html.elt list)
| `D code ->
(inline ~context:default_context ~resolve code
:> item Html.elt list)
| `N n -> to_html n
in
let doc =
Expand Down Expand Up @@ -308,7 +352,8 @@ and items ~resolve l : item Html.elt list =
let summary =
let extra_attr, extra_class, anchor_link = mk_anchor anchor in
let a = spec_class (attr @ extra_class) @ extra_attr in
Html.summary ~a @@ anchor_link @ source (inline ~resolve) summary
Html.summary ~a @@ anchor_link
@ source (inline ~context:default_context ~resolve) summary
in
[ Html.details ~a:open' summary included_html ]
in
Expand Down Expand Up @@ -337,7 +382,7 @@ module Toc = struct

let render_toc ~resolve (toc : Toc.t) =
let rec section { Toc.url; text; children } =
let text = inline_nolink text in
let text = inline_nolink ~context:default_context text in
let text =
(text
: non_link_phrasing Html.elt list
Expand Down
14 changes: 14 additions & 0 deletions src/odoc/etc/odoc.css
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -387,6 +387,20 @@ li code {
padding: 0 0.3ex;
}

p code.followed-by-code,
li code.followed-by-code {
border-top-right-radius: 0px;
border-bottom-right-radius: 0px;
padding-right: 0px;
}

p code.following-code,
li code.following-code {
border-top-left-radius: 0px;
border-bottom-left-radius: 0px;
padding-left: 0px;
}

p a > code {
color: var(--link-color);
}
Expand Down
5 changes: 3 additions & 2 deletions test/generators/cases/markup.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,8 +47,9 @@
[code] is a different kind of markup that doesn't allow nested markup.

It's possible for two markup elements to appear {b next} {i to} each other
and have a space, and appear {b next}{i to} each other with no space. It
doesn't matter {b how} {i much} space it was in the source: in this
and have a space, and appear {b next}{i to} each other with no space.
This also applies to consecutive code phrases [f][ ][x].
It doesn't matter {b how} {i much} space it was in the source: in this
sentence, it was two space characters. And in this one, there is {b a}
{i newline}.

Expand Down
10 changes: 7 additions & 3 deletions test/generators/html/Markup.html
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -88,9 +88,13 @@ <h6 id="subparagraph"><a href="#subparagraph" class="anchor"></a>
</p>
<p>It's possible for two markup elements to appear <b>next</b> <i>to</i>
each other and have a space, and appear <b>next</b><i>to</i> each
other with no space. It doesn't matter <b>how</b> <i>much</i> space
it was in the source: in this sentence, it was two space characters.
And in this one, there is <b>a</b> <i>newline</i>.
other with no space. This also applies to consecutive code phrases
<code class="followed-by-code">f</code>
<code class="following-code followed-by-code"> </code>
<code class="following-code">x</code>. It doesn't matter <b>how</b>
<i>much</i> space it was in the source: in this sentence, it was
two space characters. And in this one, there is <b>a</b> <i>newline</i>
.
</p>
<p>This is also true between <em>non-</em><code>code</code> markup
<em>and</em> <code>code</code>.
Expand Down
Loading