1313 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
1414 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
1515 *)
16-
16+ module HLink = Link
1717open Odoc_document.Types
1818module Html = Tyxml. Html
1919module Doctree = Odoc_document. Doctree
2020module Url = Odoc_document. Url
21+ module Link = HLink
2122
2223type any = Html_types .flow5
2324
@@ -92,12 +93,12 @@ and styled style ~emph_level =
9293 | `Superscript -> (emph_level, Html. sup ~a: [] )
9394 | `Subscript -> (emph_level, Html. sub ~a: [] )
9495
95- let rec internallink ~config ~emph_level ~resolve ?(a = [] )
96- { InternalLink. target; content; tooltip } =
96+ let rec internallink ~config ~emph_level ~resolve ?(a = [] ) target content
97+ tooltip =
9798 let a = match tooltip with Some s -> Html. a_title s :: a | None -> a in
9899 let elt =
99100 match target with
100- | Resolved uri ->
101+ | Target. Resolved uri ->
101102 let href = Link. href ~config ~resolve uri in
102103 let a = (a :> Html_types.a_attrib Html.attrib list ) in
103104 Html. a ~a: (Html. a_href href :: a) (inline_nolink ~emph_level content)
@@ -125,11 +126,12 @@ and inline ~config ?(emph_level = 0) ~resolve (l : Inline.t) :
125126 | Styled (style , c ) ->
126127 let emph_level, app_style = styled style ~emph_level in
127128 [ app_style @@ inline ~config ~emph_level ~resolve c ]
128- | Link ( href , c ) ->
129+ | Link { target = External href ; content = c ; _ }
129130 let a = (a :> Html_types.a_attrib Html.attrib list ) in
130131 let content = inline_nolink ~emph_level c in
131132 [ Html. a ~a: (Html. a_href href :: a) content ]
132- | InternalLink c -> internallink ~config ~emph_level ~resolve ~a c
133+ | Link { target = Internal t ; content; tooltip } ->
134+ internallink ~config ~emph_level ~resolve ~a t content tooltip
133135 | Source c -> source (inline ~config ~emph_level ~resolve ) ~a c
134136 | Math s -> [ inline_math s ]
135137 | Raw_markup r -> raw_markup r
@@ -151,7 +153,6 @@ and inline_nolink ?(emph_level = 0) (l : Inline.t) :
151153 let emph_level, app_style = styled style ~emph_level in
152154 [ app_style @@ inline_nolink ~emph_level c ]
153155 | Link _ -> assert false
154- | InternalLink _ -> assert false
155156 | Source c -> source (inline_nolink ~emph_level ) ~a c
156157 | Math s -> [ inline_math s ]
157158 | Raw_markup r -> raw_markup r
@@ -185,6 +186,26 @@ let text_align = function
185186
186187let cell_kind = function `Header -> Html. th | `Data -> Html. td
187188
189+ (* Turns an inline into a string, for use as alternative text in
190+ images *)
191+ let rec alt_of_inline (i : Inline.t ) =
192+ let rec alt_of_source s =
193+ List. map
194+ (function
195+ | Source. Elt i -> alt_of_inline i | Tag (_ , t ) -> alt_of_source t)
196+ s
197+ |> String. concat " "
198+ in
199+ let alt_of_one (o : Inline.one ) =
200+ match o.desc with
201+ | Text t | Math t | Entity t -> t
202+ | Linebreak -> " \n "
203+ | Styled (_ , i ) | Link { content = i ; _ } -> alt_of_inline i
204+ | Source s -> alt_of_source s
205+ | Raw_markup _ -> " "
206+ in
207+ List. map alt_of_one i |> String. concat " "
208+
188209let rec block ~config ~resolve (l : Block.t ) : flow Html.elt list =
189210 let as_flow x = (x : phrasing Html.elt list :> flow Html.elt list ) in
190211 let one (t : Block.one ) =
@@ -222,6 +243,55 @@ let rec block ~config ~resolve (l : Block.t) : flow Html.elt list =
222243 let extra_class = [ " language-" ^ lang_tag ] in
223244 mk_block ~extra_class Html. pre (source (inline ~config ~resolve ) c)
224245 | Math s -> mk_block Html. div [ block_math s ]
246+ | Audio (target , content ) ->
247+ let content = inline ~config ~resolve content in
248+ let audio src = [ Html. audio ~src ~a: [ Html. a_controls () ] [] ] in
249+ let block =
250+ match target with
251+ | External url -> audio url
252+ | Internal (Resolved uri ) ->
253+ let url = Link. href ~config ~resolve uri in
254+ audio url
255+ | Internal Unresolved ->
256+ let a = Html. a_class [ " xref-unresolved" [] in
257+ [ Html. span ~a content ]
258+ in
259+ mk_block Html. div block
260+ | Video (target , content ) ->
261+ let content = inline ~config ~resolve content in
262+ let video src = [ Html. video ~src ~a: [ Html. a_controls () ] [] ] in
263+ let block =
264+ match target with
265+ | External url -> video url
266+ | Internal (Resolved uri ) ->
267+ let url = Link. href ~config ~resolve uri in
268+ video url
269+ | Internal Unresolved ->
270+ let a = [ Html. a_class [ " xref-unresolved" in
271+ [ Html. span ~a content ]
272+ in
273+ mk_block Html. div block
274+ | Image (target , alt ) ->
275+ let image src =
276+ let alt = alt_of_inline alt in
277+ let img =
278+ Html. a
279+ ~a: [ Html. a_href src; Html. a_class [ " img-link"
280+ [ Html. img ~src ~alt () ]
281+ in
282+ [ img ]
283+ in
284+ let block =
285+ match target with
286+ | External url -> image url
287+ | Internal (Resolved uri ) ->
288+ let url = Link. href ~config ~resolve uri in
289+ image url
290+ | Internal Unresolved ->
291+ let a = [ Html. a_class [ " xref-unresolved" in
292+ [ Html. span ~a (inline ~config ~resolve alt) ]
293+ in
294+ mk_block Html. div block
225295 in
226296 Utils. list_concat_map l ~f: one
227297
0 commit comments