diff --git a/odoc.opam b/odoc.opam index a262f4182a..c8a14ec6c3 100644 --- a/odoc.opam +++ b/odoc.opam @@ -25,7 +25,7 @@ delimited with `(** ... *)`, and outputs HTML. """ depends: [ - "odoc-parser" {>= "0.9.0"} + "odoc-parser" {>= "1.0.0"} "astring" "cmdliner" {>= "1.0.0"} "cppo" {build & >= "1.1.0"} diff --git a/src/document/codefmt.ml b/src/document/codefmt.ml index a66f3496d7..a0064188f5 100644 --- a/src/document/codefmt.ml +++ b/src/document/codefmt.ml @@ -222,7 +222,7 @@ let code ?attr f = [ inline ?attr @@ Inline.Source (render f) ] let documentedSrc f = [ DocumentedSrc.Code (render f) ] -let codeblock ?attr f = [ block ?attr @@ Block.Source (render f) ] +let codeblock ?attr f = [ block ?attr @@ Block.Source (None, render f) ] let keyword keyword ppf = pf ppf "@{%s@}" keyword diff --git a/src/document/comment.ml b/src/document/comment.ml index ff7862094f..4f5a82217f 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -196,8 +196,9 @@ let rec nestable_block_element : Comment.nestable_block_element -> Block.one = fun content -> match content with | `Paragraph p -> paragraph p - | `Code_block code -> - block @@ Source (source_of_code (Odoc_model.Location_.value code)) + | `Code_block (lang_tag, code) -> + block + @@ Source (lang_tag, source_of_code (Odoc_model.Location_.value code)) | `Verbatim s -> block @@ Verbatim s | `Modules ms -> module_references ms | `List (kind, items) -> diff --git a/src/document/types.ml b/src/document/types.ml index 228c1c3173..154a81062a 100644 --- a/src/document/types.ml +++ b/src/document/types.ml @@ -64,6 +64,8 @@ end = Heading and Block : sig + type lang_tag = string option + type t = one list and one = { attr : Class.t; desc : desc } @@ -73,7 +75,7 @@ and Block : sig | Paragraph of Inline.t | List of list_type * t list | Description of Description.t - | Source of Source.t + | Source of lang_tag * Source.t | Verbatim of string | Raw_markup of Raw_markup.t diff --git a/src/html/generator.ml b/src/html/generator.ml index d5d9a78b82..73c1cda5e5 100644 --- a/src/html/generator.ml +++ b/src/html/generator.ml @@ -165,32 +165,37 @@ let heading ~resolve (h : Heading.t) = let rec block ~resolve (l : Block.t) : flow Html.elt list = let as_flow x = (x : phrasing Html.elt list :> flow Html.elt list) in let one (t : Block.one) = - let a = class_ t.attr in + let mk_block ?(extra_class = []) mk content = + let a = Some (class_ (extra_class @ t.attr)) in + [ mk ?a content ] + in match t.desc with | Inline i -> - if a = [] then as_flow @@ inline ~resolve i - else [ Html.span ~a (inline ~resolve i) ] - | Paragraph i -> [ Html.p ~a (inline ~resolve 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) | List (typ, l) -> let mk = match typ with Ordered -> Html.ol | Unordered -> Html.ul in - [ mk ~a (List.map (fun x -> Html.li (block ~resolve x)) l) ] + 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 - : phrasing Html.elt list - :> flow Html.elt list) - in - let def = block ~resolve i.Description.definition in - Html.li ~a (term @ (Html.txt " " :: def)) - in - Html.ul ~a (List.map item l)); - ] + let item i = + let a = class_ i.Description.attr in + let term = + (inline ~resolve i.Description.key + : phrasing Html.elt list + :> flow Html.elt list) + in + let def = block ~resolve i.Description.definition in + Html.li ~a (term @ (Html.txt " " :: def)) + in + mk_block Html.ul (List.map item l) | Raw_markup r -> raw_markup r - | Verbatim s -> [ Html.pre ~a [ Html.txt s ] ] - | Source c -> [ Html.pre ~a (source (inline ~resolve) c) ] + | Verbatim s -> mk_block Html.pre [ Html.txt s ] + | Source (lang_tag, c) -> + let extra_class = + match lang_tag with None -> [] | Some lang -> [ "language-" ^ lang ] + in + mk_block ~extra_class Html.pre (source (inline ~resolve) c) in Utils.list_concat_map l ~f:one diff --git a/src/latex/generator.ml b/src/latex/generator.ml index d3c32ec643..3f620253eb 100644 --- a/src/latex/generator.ml +++ b/src/latex/generator.ml @@ -308,7 +308,7 @@ let rec block ~in_source (l : Block.t) = ] | Raw_markup r -> raw_markup r | Verbatim s -> [ Verbatim s ] - | Source c -> non_empty_block_code c + | Source (_, c) -> non_empty_block_code c in list_concat_map l ~f:one diff --git a/src/manpage/generator.ml b/src/manpage/generator.ml index 3342ff183c..a3c63ffc38 100644 --- a/src/manpage/generator.ml +++ b/src/manpage/generator.ml @@ -331,7 +331,7 @@ let rec block (l : Block.t) = indent 2 (str "@" ++ key ++ str ":" ++ sp ++ def) in list ~sep:break (List.map f descrs) ++ continue rest - | Source content -> + | Source (_, content) -> env "EX" "EE" "" (source_code content) ++ continue rest | Verbatim content -> env "EX" "EE" "" (str "%s" content) ++ continue rest | Raw_markup t -> raw_markup t ++ continue rest) diff --git a/src/model/comment.ml b/src/model/comment.ml index a7a1146467..bc6444ac39 100644 --- a/src/model/comment.ml +++ b/src/model/comment.ml @@ -40,7 +40,7 @@ type module_reference = { type nestable_block_element = [ `Paragraph of paragraph - | `Code_block of string with_location + | `Code_block of string option * string with_location | `Verbatim of string | `Modules of module_reference list | `List of diff --git a/src/model/semantics.ml b/src/model/semantics.ml index cd6d5d6b56..1f0a06ebbf 100644 --- a/src/model/semantics.ml +++ b/src/model/semantics.ml @@ -227,8 +227,13 @@ let rec nestable_block_element : match element with | { value = `Paragraph content; location } -> Location.at location (`Paragraph (inline_elements status content)) - | { value = `Code_block (_, code); _ } -> - Location.same element (`Code_block code) + | { value = `Code_block (metadata, code); location } -> + let lang_tag = + match metadata with + | Some ({ Location.value; _ }, _) -> Some value + | None -> None + in + Location.at location (`Code_block (lang_tag, code)) | { value = `Verbatim _; _ } as element -> element | { value = `Modules modules; location } -> let modules = diff --git a/src/model_desc/comment_desc.ml b/src/model_desc/comment_desc.ml index 42bdc4122c..b656a793d8 100644 --- a/src/model_desc/comment_desc.ml +++ b/src/model_desc/comment_desc.ml @@ -18,7 +18,7 @@ and general_link_content = general_inline_element with_location list type general_block_element = [ `Paragraph of general_link_content - | `Code_block of string with_location + | `Code_block of string option * string with_location | `Verbatim of string | `Modules of Comment.module_reference list | `List of @@ -100,7 +100,8 @@ let rec block_element : general_block_element t = Variant (function | `Paragraph x -> C ("`Paragraph", x, link_content) - | `Code_block x -> C ("`Code_block", ignore_loc x, string) + | `Code_block (x1, x2) -> + C ("`Code_block", (x1, ignore_loc x2), Pair (Option string, string)) | `Verbatim x -> C ("`Verbatim", x, string) | `Modules x -> C ("`Modules", x, List module_reference) | `List (x1, x2) -> diff --git a/test/model/semantics/test.ml b/test/model/semantics/test.ml index f3ffd66697..8abe7027fb 100644 --- a/test/model/semantics/test.ml +++ b/test/model/semantics/test.ml @@ -1989,7 +1989,10 @@ let%expect_test _ = [%expect {| { - "value": [ { "`Tag": { "`Author": "Foo" } }, { "`Code_block": "bar" } ], + "value": [ + { "`Tag": { "`Author": "Foo" } }, + { "`Code_block": [ "None", "bar" ] } + ], "warnings": [ "File \"f.ml\", line 2, characters 0-7:\n'{[...]}' (code block) is not allowed in the tags section.\nSuggestion: move '{[...]}' (code block) before any tags." ] @@ -2376,7 +2379,7 @@ let%expect_test _ = test "{[@author Foo]}"; [%expect {| - { "value": [ { "`Code_block": "@author Foo" } ], "warnings": [] } |}] + { "value": [ { "`Code_block": [ "None", "@author Foo" ] } ], "warnings": [] } |}] let in_verbatim = test "{v @author Foo v}"; @@ -2389,7 +2392,10 @@ let%expect_test _ = [%expect {| { - "value": [ { "`Code_block": "foo" }, { "`Tag": { "`Author": "Bar" } } ], + "value": [ + { "`Code_block": [ "None", "foo" ] }, + { "`Tag": { "`Author": "Bar" } } + ], "warnings": [ "File \"f.ml\", line 1, characters 8-19:\n'@author' should begin on its own line." ]