From 40716d5fef3919e7ef582a55c5e27009231e2aec Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 12:11:46 +0200 Subject: [PATCH 01/24] Fix unused functor parameter warnings (warning 67) Recent compilers in the dune development profile treat warning 67 (unused functor parameter) as an error, which breaks make build and the CI on every platform. The parameters are only used for their side effects on behavior, not in the result signatures, so they can be anonymous. --- CHANGES.md | 3 +++ lib/html_f.mli | 2 +- lib/svg_f.mli | 2 +- lib/xml_print.mli | 6 +++--- 4 files changed, 8 insertions(+), 5 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 9f625a7ad..5c1dfba19 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,8 @@ # NEXT +* Fix the development-profile build with recent compilers: anonymize + unused functor parameters in printer and functor signatures + (warning 67) * Fix typo `whitout` in type definition (#324 by Martin @MBodin Bodin) * Add support for the clip-path presentation attribute diff --git a/lib/html_f.mli b/lib/html_f.mli index 647c57c49..4c3ae76eb 100644 --- a/lib/html_f.mli +++ b/lib/html_f.mli @@ -46,7 +46,7 @@ module Wrapped_functions (** Similar to {!Make} but with a custom set of wrapped functions. *) module Make_with_wrapped_functions (Xml : Xml_sigs.T) - (C : Html_sigs.Wrapped_functions with module Xml = Xml) + (_ : Html_sigs.Wrapped_functions with module Xml = Xml) (Svg : Svg_sigs.T with module Xml := Xml) : Html_sigs.Make(Xml)(Svg).T with type +'a elt = Xml.elt diff --git a/lib/svg_f.mli b/lib/svg_f.mli index 476c15fbe..0375f48e6 100644 --- a/lib/svg_f.mli +++ b/lib/svg_f.mli @@ -99,7 +99,7 @@ module Wrapped_functions (** Similar to {!Make} but with a custom set of wrapped functions. *) module Make_with_wrapped_functions (Xml : Xml_sigs.T) - (C : Svg_sigs.Wrapped_functions with module Xml = Xml) + (_ : Svg_sigs.Wrapped_functions with module Xml = Xml) : Svg_sigs.Make(Xml).T with type +'a elt = Xml.elt and type +'a attrib = Xml.attrib diff --git a/lib/xml_print.mli b/lib/xml_print.mli index 782fa56a7..54a5fc927 100644 --- a/lib/xml_print.mli +++ b/lib/xml_print.mli @@ -103,7 +103,7 @@ module type TagList = sig val emptytags : string list end (** Printers for raw XML modules. *) module Make_fmt (Xml : Xml_sigs.Iterable) - (I : TagList) + (_ : TagList) : Xml_sigs.Pp with type elt := Xml.elt (** {2 Deprecated functors} @@ -113,7 +113,7 @@ module Make_fmt module Make (Xml : Xml_sigs.Iterable) - (I : TagList) + (_ : TagList) (O : Xml_sigs.Output) : Xml_sigs.Printer with type out := O.out and type xml_elt := Xml.elt [@@ocaml.deprecated "Use Xml_print.Make_fmt instead."] @@ -129,7 +129,7 @@ module Make_typed module Make_simple (Xml : Xml_sigs.Iterable) - (I : TagList) + (_ : TagList) : Xml_sigs.Simple_printer with type xml_elt := Xml.elt [@@ocaml.deprecated "Use Xml_print.Make_fmt instead."] From a2e01efd36910cf77798afb8ee2ec9d8f17811a4 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:20:23 +0200 Subject: [PATCH 02/24] Add support for the s element The s element represents contents that are no longer accurate or relevant. It is flow and phrasing content, with phrasing content and common attributes. Spec: https://html.spec.whatwg.org/multipage/text-level-semantics.html#the-s-element --- CHANGES.md | 1 + lib/html_f.ml | 2 ++ lib/html_sigs.mli | 4 ++++ lib/html_types.mli | 24 +++++++++++++++++++++--- test/test_html.ml | 4 ++++ test/test_ppx.ml | 4 ++++ 6 files changed, 36 insertions(+), 3 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5c1dfba19..edddd5e12 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -3,6 +3,7 @@ * Fix the development-profile build with recent compilers: anonymize unused functor parameters in printer and functor signatures (warning 67) +* Add support for the `s` element * Fix typo `whitout` in type definition (#324 by Martin @MBodin Bodin) * Add support for the clip-path presentation attribute diff --git a/lib/html_f.ml b/lib/html_f.ml index d163a82e4..b5ae2bb03 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -629,6 +629,8 @@ struct let u = star "u" + let s = star "s" + let small = star "small" let sub = star "sub" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 60750f6c7..e610db3f5 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -807,6 +807,10 @@ module type T = sig val u : ([< | u_attrib], [< | u_content_fun], [> | u]) star + val s : ([< | s_attrib], [< | s_content_fun], [> | s]) star + (** @see + s element documentation on MDN *) + val small : ([< | small_attrib], [< | small_content_fun], [> | small]) star diff --git a/lib/html_types.mli b/lib/html_types.mli index 6318f0962..f4158f11c 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -550,6 +550,7 @@ type core_phrasing = | `Small | `Script | `Samp + | `S | `Ruby | `Q | `Mark @@ -590,6 +591,7 @@ type core_phrasing_without_noscript = | `Small | `Script | `Samp + | `S | `Ruby | `Q | `Mark @@ -628,6 +630,7 @@ type core_phrasing_without_interactive = | `Script | `Svg | `Samp + | `S | `Ruby | `Q | `Mark @@ -665,6 +668,7 @@ type core_phrasing_without_media = | `Small | `Script | `Samp + | `S | `Ruby | `Q | `Mark @@ -723,7 +727,7 @@ type (+'a, +'b) between_phrasing_and_phrasing_without_interactive = phrasing_without_media) transparent > `Abbr `B `Bdo `Br `Canvas `Cite `Code `Command `Datalist `Del `Dfn `Em `I `Img `Picture `Ins `Kbd `Map `Mark `Meter - `Noscript `Object `PCDATA `Progress `Q `Ruby `Samp `Script + `Noscript `Object `PCDATA `Progress `Q `Ruby `S `Samp `Script `Small `Span `Strong `Sub `Sup `Svg `Template `Time `U `Var `Wbr ] as 'a) (** Phrasing without the interactive markups *) @@ -743,6 +747,7 @@ type phrasing_without_dfn = | `Small | `Script | `Samp + | `S | `Ruby | `Q | `Mark @@ -783,6 +788,7 @@ type phrasing_without_label = | `Small | `Script | `Samp + | `S | `Ruby | `Q | `Mark @@ -819,6 +825,7 @@ type phrasing_without_progress = | `Small | `Script | `Samp + | `S | `Img | `Img_interactive | `Picture | `Ruby @@ -861,6 +868,7 @@ type phrasing_without_time = | `Small | `Script | `Samp + | `S | `Ruby | `Q | `Mark @@ -902,6 +910,7 @@ type phrasing_without_meter = | `Small | `Script | `Samp + | `S | `Ruby | `Q | `Mark @@ -1102,7 +1111,7 @@ type +'a between_flow5_and_flow5_without_interactive_header_footer = `Button `Canvas `Cite `Code `Command `Datalist `Del `Dfn `Dialog `Div `Dl `Em `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Img `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript - `Object `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `Samp `Script + `Object `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `S `Samp `Script `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table `Template `Textarea `Time `U `Ul `Var `Video `Wbr] as 'a @@ -1118,7 +1127,7 @@ type (+'a, +'b) between_flow5_and_flow5_without_header_footer = `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Iframe `Img `Img_interactive `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript `Object `Object_interactive - `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `Samp `Script + `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `S `Samp `Script `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table `Template `Textarea `Time `U `Ul `Var `Video `Video_interactive `Wbr ] as 'a @@ -1559,6 +1568,15 @@ type u_content_fun = [ | phrasing ] type u_attrib = [ | common ] +(* NAME: s, KIND: star, TYPE: [= common ], [= phrasing ], [=`S], ARG: [= phrasing ], ATTRIB: OUT: [=`S] *) +type s = [ | `S ] + +type s_content = [ | phrasing ] + +type s_content_fun = [ | phrasing ] + +type s_attrib = [ | common ] + (* NAME: small, KIND: star, TYPE: [= common ], [= phrasing ], [=`Small], ARG: [= phrasing ], ATTRIB: OUT: [=`Small] *) type small = [ | `Small ] diff --git a/test/test_html.ml b/test/test_html.ml index c64d4f1c5..edde5baa1 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -6,6 +6,10 @@ let html_elements = "html elements", tyxml_tests Html.[ dialog ~a:[a_open ()] [div []], "
" ; + "s", + p [s [txt "old price"]], + "

old price

" ; + "div", div [a []], "
" ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index b521aada4..50986aa58 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -189,6 +189,10 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|foo|}]], [dialog ~a:[a_open ()] [txt "foo"] ]; + "s", + [[%html {|foo|}]], + [s [txt "foo"] ]; + "picture", [[%html {|
test picture/img.png From 3b06685e1162c632265ead07c0d8959bf62b825d Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:22:57 +0200 Subject: [PATCH 03/24] Add support for the bdi element The bdi element represents a span of text isolated from its surroundings for the purposes of bidirectional text formatting. It is flow and phrasing content, with phrasing content and common attributes (the dir attribute is already available globally). Spec: https://html.spec.whatwg.org/multipage/text-level-semantics.html#the-bdi-element --- CHANGES.md | 1 + lib/html_f.ml | 2 ++ lib/html_sigs.mli | 4 ++++ lib/html_types.mli | 24 +++++++++++++++++++++--- test/test_html.ml | 4 ++++ test/test_ppx.ml | 4 ++++ 6 files changed, 36 insertions(+), 3 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index edddd5e12..a3d4bcdda 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,7 @@ unused functor parameters in printer and functor signatures (warning 67) * Add support for the `s` element +* Add support for the `bdi` element * Fix typo `whitout` in type definition (#324 by Martin @MBodin Bodin) * Add support for the clip-path presentation attribute diff --git a/lib/html_f.ml b/lib/html_f.ml index b5ae2bb03..4bf6f1925 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -652,6 +652,8 @@ struct let bdo ~dir ?(a = []) elts = Xml.node ~a: ((a_dir dir) :: a) "bdo" elts + let bdi = star "bdi" + let a_datetime = string_attrib "datetime" let a_shape x = diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index e610db3f5..ab001308b 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -826,6 +826,10 @@ module type T = sig dir: [< | `Ltr | `Rtl] wrap -> ([< | bdo_attrib], [< | bdo_content_fun], [> | bdo]) star + val bdi : ([< | bdi_attrib], [< | bdi_content_fun], [> | bdi]) star + (** @see + bdi element documentation on MDN *) + val abbr : ([< | abbr_attrib], [< | abbr_content_fun], [> | abbr]) star val br : ([< | br_attrib], [> | br]) nullary diff --git a/lib/html_types.mli b/lib/html_types.mli index f4158f11c..9f276335b 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -567,6 +567,7 @@ type core_phrasing = | `Cite | `Br | `Bdo + | `Bdi | `B | `Abbr | `Img | `Img_interactive @@ -608,6 +609,7 @@ type core_phrasing_without_noscript = | `Cite | `Br | `Bdo + | `Bdi | `Img | `Img_interactive | `Picture | `B @@ -646,6 +648,7 @@ type core_phrasing_without_interactive = | `Cite | `Br | `Bdo + | `Bdi | `B | `Abbr | `PCDATA @@ -687,6 +690,7 @@ type core_phrasing_without_media = | `Cite | `Br | `Bdo + | `Bdi | `B | `Abbr | `PCDATA @@ -725,7 +729,7 @@ type (+'a, +'b) between_phrasing_and_phrasing_without_interactive = phrasing_without_noscript, phrasing, phrasing_without_media) transparent - > `Abbr `B `Bdo `Br `Canvas `Cite `Code `Command + > `Abbr `B `Bdi `Bdo `Br `Canvas `Cite `Code `Command `Datalist `Del `Dfn `Em `I `Img `Picture `Ins `Kbd `Map `Mark `Meter `Noscript `Object `PCDATA `Progress `Q `Ruby `S `Samp `Script `Small `Span `Strong `Sub `Sup `Svg `Template `Time `U `Var `Wbr ] as 'a) @@ -763,6 +767,7 @@ type phrasing_without_dfn = | `Cite | `Br | `Bdo + | `Bdi | `B | `Abbr | `PCDATA @@ -802,6 +807,7 @@ type phrasing_without_label = | `Cite | `Br | `Bdo + | `Bdi | `B | `Abbr | `PCDATA @@ -844,6 +850,7 @@ type phrasing_without_progress = | `Button | `Br | `Bdo + | `Bdi | `B | `Abbr | `PCDATA @@ -883,6 +890,7 @@ type phrasing_without_time = | `Cite | `Br | `Bdo + | `Bdi | `B | `Abbr | `PCDATA @@ -925,6 +933,7 @@ type phrasing_without_meter = | `Cite | `Br | `Bdo + | `Bdi | `B | `Abbr | `PCDATA @@ -1107,7 +1116,7 @@ type flow5_without_header_footer = ] type +'a between_flow5_and_flow5_without_interactive_header_footer = - [< flow5 > `Abbr `Address `Article `Aside `Audio `B `Bdo `Blockquote `Br + [< flow5 > `Abbr `Address `Article `Aside `Audio `B `Bdi `Bdo `Blockquote `Br `Button `Canvas `Cite `Code `Command `Datalist `Del `Dfn `Dialog `Div `Dl `Em `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Img `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript @@ -1122,7 +1131,7 @@ type (+'a, +'b) between_flow5_and_flow5_without_header_footer = flow5_without_media) transparent > `A `Abbr `Address `Article `Aside `Audio `Audio_interactive `B - `Bdo `Blockquote `Br `Button `Canvas `Cite `Code `Command + `Bdi `Bdo `Blockquote `Br `Button `Canvas `Cite `Code `Command `Datalist `Del `Details `Dfn `Dialog `Div `Dl `Em `Embed `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Iframe `Img `Img_interactive `Picture `Input `Ins `Kbd `Keygen `Label `Map @@ -1631,6 +1640,15 @@ type bdo_content_fun = [ | phrasing ] type bdo_attrib = [ | common ] +(* NAME: bdi, KIND: star, TYPE: [= common ],[= phrasing ],[= `Bdi ], ARG: [= phrasing ], ATTRIB: OUT: [= `Bdi ] *) +type bdi = [ | `Bdi ] + +type bdi_content = [ | phrasing ] + +type bdi_content_fun = [ | phrasing ] + +type bdi_attrib = [ | common ] + (* NAME: abbr, KIND: star, TYPE: [= common ], [=phrasing ], [=`Abbr], ARG: [=phrasing ], ATTRIB: OUT: [=`Abbr] *) type abbr = [ | `Abbr ] diff --git a/test/test_html.ml b/test/test_html.ml index edde5baa1..dc778cd06 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -10,6 +10,10 @@ let html_elements = "html elements", tyxml_tests Html.[ p [s [txt "old price"]], "

old price

" ; + "bdi", + p [bdi [txt "user123"]], + "

user123

" ; + "div", div [a []], "
" ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 50986aa58..9bbaf2af4 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -193,6 +193,10 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|foo|}]], [s [txt "foo"] ]; + "bdi", + [[%html {|foo|}]], + [bdi [txt "foo"] ]; + "picture", [[%html {|
test picture/img.png From fce5425bddc325fdfb460bdebe001f45396ff4a0 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:24:46 +0200 Subject: [PATCH 04/24] Add support for the search element The search element represents a part of a document whose contents relate to performing a search or filtering operation. It is flow content containing flow content, with common attributes. It is grouping content, not a sectioning element. Spec: https://html.spec.whatwg.org/multipage/grouping-content.html#the-search-element --- CHANGES.md | 1 + lib/html_f.ml | 2 ++ lib/html_sigs.mli | 5 +++++ lib/html_types.mli | 22 ++++++++++++++++++++-- test/test_html.ml | 4 ++++ test/test_ppx.ml | 4 ++++ 6 files changed, 36 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index a3d4bcdda..1f5efdbc3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,7 @@ (warning 67) * Add support for the `s` element * Add support for the `bdi` element +* Add support for the `search` element * Fix typo `whitout` in type definition (#324 by Martin @MBodin Bodin) * Add support for the clip-path presentation attribute diff --git a/lib/html_f.ml b/lib/html_f.ml index 4bf6f1925..68fa1b7ef 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -689,6 +689,8 @@ struct let main = star "main" + let search = star "search" + let video_audio name ?src ?srcs ?(a = []) elts = let a = match src with diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index ab001308b..84b612e2d 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -759,6 +759,11 @@ module type T = sig val main : ([< | main_attrib], [< | main_content_fun], [> | main]) star + val search : + ([< | search_attrib], [< | search_content_fun], [> | search]) star + (** @see + search element documentation on MDN *) + (** {3 Grouping content} *) val p : ([< | p_attrib], [< | p_content_fun], [> | p]) star diff --git a/lib/html_types.mli b/lib/html_types.mli index 9f276335b..a3342511c 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -958,6 +958,7 @@ type core_flow5 = | `Details | `Main | `Dialog + | `Search ] type core_flow5_without_interactive = @@ -976,6 +977,7 @@ type core_flow5_without_interactive = | `Dl | `Main | `Dialog + | `Search ] type core_flow5_without_noscript = @@ -995,6 +997,7 @@ type core_flow5_without_noscript = | `Details | `Main | `Dialog + | `Search ] type core_flow5_without_media = [ @@ -1013,6 +1016,7 @@ type core_flow5_without_media = | `Details | `Main | `Dialog + | `Search ] type flow5_without_interactive = @@ -1057,6 +1061,7 @@ type flow5_without_table = | `Details | `Main | `Dialog + | `Search | (flow5_without_interactive, flow5_without_noscript, flow5, flow5_without_media) transparent ] @@ -1083,6 +1088,7 @@ type flow5_without_interactive_header_footer = | `Dl | `Main | `Dialog + | `Search | (flow5_without_noscript, flow5, flow5_without_media) transparent_without_interactive ] @@ -1110,6 +1116,7 @@ type flow5_without_header_footer = | `Details | `Main | `Dialog + | `Search | (flow5_without_interactive_header_footer, flow5_without_noscript, flow5, flow5_without_media) transparent @@ -1121,7 +1128,7 @@ type +'a between_flow5_and_flow5_without_interactive_header_footer = `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Img `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript `Object `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `S `Samp `Script - `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table + `Search `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table `Template `Textarea `Time `U `Ul `Var `Video `Wbr] as 'a type (+'a, +'b) between_flow5_and_flow5_without_header_footer = @@ -1137,7 +1144,7 @@ type (+'a, +'b) between_flow5_and_flow5_without_header_footer = `Img `Img_interactive `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript `Object `Object_interactive `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `S `Samp `Script - `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg + `Search `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table `Template `Textarea `Time `U `Ul `Var `Video `Video_interactive `Wbr ] as 'a @@ -1157,6 +1164,7 @@ type flow5_without_form = | `Details | `Main | `Dialog + | `Search | (flow5_without_interactive, flow5_without_noscript, flow5, flow5_without_media) transparent ] @@ -1181,6 +1189,7 @@ type flow5_without_sectioning_heading_header_footer_address = | `Details | `Main | `Dialog + | `Search | (flow5_without_interactive, flow5_without_noscript, flow5, flow5_without_media) transparent ] @@ -1405,6 +1414,15 @@ type main_content_fun = [ | flow5 ] type main_attrib = [ | common ] +(* NAME: search, KIND: star, TYPE: [= common ], [= flow5 ], [=`Search], ARG: [= flow5 ], ATTRIB: OUT: [=`Search] *) +type search = [ | `Search ] + +type search_content = [ | flow5 ] + +type search_content_fun = [ | flow5 ] + +type search_attrib = [ | common ] + (* NAME: p, KIND: star, TYPE: [= common ], [=phrasing ], [=`P], ARG: [=phrasing ], ATTRIB: OUT: [=`P] *) type p = [ | `P ] diff --git a/test/test_html.ml b/test/test_html.ml index dc778cd06..43d0c02b9 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -14,6 +14,10 @@ let html_elements = "html elements", tyxml_tests Html.[ p [bdi [txt "user123"]], "

user123

" ; + "search", + search [p [txt "results"]], + "

results

" ; + "div", div [a []], "
" ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 9bbaf2af4..b6f1f2dfe 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -197,6 +197,10 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|foo|}]], [bdi [txt "foo"] ]; + "search", + [[%html {|

foo

|}]], + [search [p [txt "foo"]] ]; + "picture", [[%html {|
test picture/img.png From 1b91cce75b7d5b905eff235f4fdfbdac120ed487 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:26:45 +0200 Subject: [PATCH 05/24] Add support for the data element The data element links a content with a machine-readable value. The value attribute is required by the specification, so it is exposed as a mandatory labeled argument, following the img and optgroup precedents. Spec: https://html.spec.whatwg.org/multipage/text-level-semantics.html#the-data-element --- CHANGES.md | 1 + lib/html_f.ml | 3 +++ lib/html_sigs.mli | 8 ++++++++ lib/html_types.mli | 24 +++++++++++++++++++++--- test/test_html.ml | 4 ++++ test/test_ppx.ml | 4 ++++ 6 files changed, 41 insertions(+), 3 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 1f5efdbc3..5545936ed 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,7 @@ * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element +* Add support for the `data` element * Fix typo `whitout` in type definition (#324 by Martin @MBodin Bodin) * Add support for the clip-path presentation attribute diff --git a/lib/html_f.ml b/lib/html_f.ml index 68fa1b7ef..5b0bbe86e 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -605,6 +605,9 @@ struct let time = star "time" + let data ~value ?(a = []) elts = + Xml.node ~a: ((a_value value) :: a) "data" elts + let var = star "var" let a = star "a" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 84b612e2d..61ecf2e4c 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -860,6 +860,14 @@ module type T = sig val time : ([< | time_attrib], [< | time_content_fun], [> | time]) star + val data : + value: text wrap -> + ([< | data_attrib], [< | data_content_fun], [> | data]) star + (** [data ~value content] represents [content] together with its + machine-readable [value] attribute. + @see + data element documentation on MDN *) + val var : ([< | var_attrib], [< | var_content_fun], [> | var]) star (** {3 Hypertext} *) diff --git a/lib/html_types.mli b/lib/html_types.mli index a3342511c..c75c55a00 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -562,6 +562,7 @@ type core_phrasing = | `Em | `Dfn | `Datalist + | `Data | `Command | `Code | `Cite @@ -604,6 +605,7 @@ type core_phrasing_without_noscript = | `Em | `Dfn | `Datalist + | `Data | `Command | `Code | `Cite @@ -643,6 +645,7 @@ type core_phrasing_without_interactive = | `Em | `Dfn | `Datalist + | `Data | `Command | `Code | `Cite @@ -685,6 +688,7 @@ type core_phrasing_without_media = | `Em | `Dfn | `Datalist + | `Data | `Command | `Code | `Cite @@ -730,7 +734,7 @@ type (+'a, +'b) between_phrasing_and_phrasing_without_interactive = phrasing, phrasing_without_media) transparent > `Abbr `B `Bdi `Bdo `Br `Canvas `Cite `Code `Command - `Datalist `Del `Dfn `Em `I `Img `Picture `Ins `Kbd `Map `Mark `Meter + `Data `Datalist `Del `Dfn `Em `I `Img `Picture `Ins `Kbd `Map `Mark `Meter `Noscript `Object `PCDATA `Progress `Q `Ruby `S `Samp `Script `Small `Span `Strong `Sub `Sup `Svg `Template `Time `U `Var `Wbr ] as 'a) @@ -762,6 +766,7 @@ type phrasing_without_dfn = | `I | `Em | `Datalist + | `Data | `Command | `Code | `Cite @@ -802,6 +807,7 @@ type phrasing_without_label = | `Em | `Dfn | `Datalist + | `Data | `Command | `Code | `Cite @@ -844,6 +850,7 @@ type phrasing_without_progress = | `Em | `Dfn | `Datalist + | `Data | `Command | `Code | `Cite @@ -885,6 +892,7 @@ type phrasing_without_time = | `Em | `Dfn | `Datalist + | `Data | `Command | `Code | `Cite @@ -928,6 +936,7 @@ type phrasing_without_meter = | `Em | `Dfn | `Datalist + | `Data | `Command | `Code | `Cite @@ -1124,7 +1133,7 @@ type flow5_without_header_footer = type +'a between_flow5_and_flow5_without_interactive_header_footer = [< flow5 > `Abbr `Address `Article `Aside `Audio `B `Bdi `Bdo `Blockquote `Br - `Button `Canvas `Cite `Code `Command `Datalist `Del `Dfn `Dialog `Div `Dl `Em + `Button `Canvas `Cite `Code `Command `Data `Datalist `Del `Dfn `Dialog `Div `Dl `Em `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Img `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript `Object `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `S `Samp `Script @@ -1139,7 +1148,7 @@ type (+'a, +'b) between_flow5_and_flow5_without_header_footer = transparent > `A `Abbr `Address `Article `Aside `Audio `Audio_interactive `B `Bdi `Bdo `Blockquote `Br `Button `Canvas `Cite `Code `Command - `Datalist `Del `Details `Dfn `Dialog `Div `Dl `Em `Embed `Fieldset + `Data `Datalist `Del `Details `Dfn `Dialog `Div `Dl `Em `Embed `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Iframe `Img `Img_interactive `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript `Object `Object_interactive @@ -1766,6 +1775,15 @@ type strong_content_fun = [ | phrasing ] type strong_attrib = [ | common ] +(* NAME: data, KIND: star, TYPE: [= common ], [= phrasing ], [=`Data], ARG: [= phrasing ], ATTRIB: OUT: [=`Data] *) +type data = [ | `Data ] + +type data_content = [ | phrasing ] + +type data_content_fun = [ | phrasing ] + +type data_attrib = [ | common ] + (* NAME: time, KIND: star, TYPE: [= common |`Datetime |`Pubdate], [= phrasing_without_time ], [=`Time], ARG: [= phrasing_without_time ], ATTRIB: OUT: [=`Time] *) type time = [ | `Time ] diff --git a/test/test_html.ml b/test/test_html.ml index 43d0c02b9..95fefedfe 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -18,6 +18,10 @@ let html_elements = "html elements", tyxml_tests Html.[ search [p [txt "results"]], "

results

" ; + "data", + p [data ~value:"42" [txt "forty-two"]], + "

forty-two

" ; + "div", div [a []], "
" ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index b6f1f2dfe..9b139ff54 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -201,6 +201,10 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|

foo

|}]], [search [p [txt "foo"]] ]; + "data", + [[%html {|foo|}]], + [data ~value:"42" [txt "foo"] ]; + "picture", [[%html {|
test picture/img.png From 1237f38126e69c1e410f20807e0da7a41d44c080 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:30:19 +0200 Subject: [PATCH 06/24] Add support for the track element The track element specifies timed text tracks for audio and video elements. It is a void element with a required src attribute, exposed as a mandatory labeled argument. New attributes: a_kind, a_track_srclang and a_default. The existing a_srclang function stays untouched (it is deprecated and wrongly typed as XML_lang); a_track_srclang uses the reflect.attribute renaming so that maps to it in the PPX. audio and video accept a new optional ?tracks argument, mirroring ?srcs, so that track children do not leak into the transparent content type parameter. The PPX assembler for audio and video partitions track children into that argument. Spec: https://html.spec.whatwg.org/multipage/media.html#the-track-element --- CHANGES.md | 3 +++ lib/html_f.ml | 25 +++++++++++++++++++++++-- lib/html_sigs.mli | 26 ++++++++++++++++++++++++++ lib/html_types.mli | 13 +++++++++++++ syntax/element_content.ml | 15 ++++++++++----- test/test_html.ml | 9 +++++++++ test/test_ppx.ml | 5 +++++ 7 files changed, 89 insertions(+), 7 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5545936ed..6def071da 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,9 @@ * Add support for the `bdi` element * Add support for the `search` element * Add support for the `data` element +* Add support for the `track` element and its `kind`, `srclang` + (as `a_track_srclang`) and `default` attributes; `audio` and `video` + now accept an optional `?tracks` argument * Fix typo `whitout` in type definition (#324 by Martin @MBodin Bodin) * Add support for the clip-path presentation attribute diff --git a/lib/html_f.ml b/lib/html_f.ml index 5b0bbe86e..5b3df86cf 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -41,7 +41,8 @@ struct Xml_print.compose_doctype "html" [] let emptytags = [ "area"; "base"; "br"; "col"; "command"; "embed"; "hr"; "img"; - "input"; "keygen"; "link"; "meta"; "param"; "source"; "wbr" ] + "input"; "keygen"; "link"; "meta"; "param"; "source"; "track"; + "wbr" ] end type 'a wrap = 'a W.t @@ -410,6 +411,14 @@ struct (*let a_srcdoc*) let a_srclang = string_attrib "srclang" + let a_kind x = + user_attrib C.string_of_big_variant "kind" x + + let a_track_srclang = string_attrib "srclang" + + let a_default = + constant_attrib "default" + let a_srcset = srcset_attrib "srcset" let a_img_sizes = comma_sep_attrib "sizes" @@ -694,12 +703,17 @@ struct let search = star "search" - let video_audio name ?src ?srcs ?(a = []) elts = + let video_audio name ?src ?srcs ?tracks ?(a = []) elts = let a = match src with | None -> a | Some uri -> (a_src uri) :: a in + let elts = + match tracks with + | None -> elts + | Some tracks -> W.append tracks elts + in match srcs with | None -> Xml.node name ~a elts | Some srcs -> Xml.node name ~a (W.append srcs elts) @@ -724,6 +738,9 @@ struct let source = terminal "source" + let track ~src ?(a = []) () = + Xml.leaf ~a: ((a_src src) :: a) "track" + let meter = star "meter" let output_elt = star "output" @@ -980,6 +997,10 @@ struct | `Open -> "open" | `None -> "none" | `Metadata -> "metadata" + | `Subtitles -> "subtitles" + | `Captions -> "captions" + | `Descriptions -> "descriptions" + | `Chapters -> "chapters" | `Audio -> "audio" | `Pubdate -> "pubdate" | `Required -> "required" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 61ecf2e4c..24352e99b 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -375,6 +375,24 @@ module type T = sig val a_srclang : nmtoken wrap -> [> | `XML_lang] attrib [@@ocaml.deprecated "Use a_xml_lang instead."] + val a_kind : + [< | `Subtitles | `Captions | `Descriptions | `Chapters | `Metadata] + wrap -> [> | `Kind] attrib + (** How a text track is meant to be used, for [track] elements. + @see + kind attribute documentation on MDN *) + + val a_track_srclang : languagecode wrap -> [> | `Srclang] attrib + [@@reflect.attribute "srclang" ["track"]] + (** Language of the text track data, for [track] elements. *) + + val a_default : unit -> [> | `Default] attrib + (** Indicates that a text track is to be enabled if the user's + preferences do not indicate that another track would be more + appropriate. + @see + default attribute documentation on MDN *) + type image_candidate = [ `Url of uri | `Url_width of uri * number @@ -907,12 +925,14 @@ module type T = sig val audio : ?src:Xml.uri wrap -> ?srcs:(([< | source] elt) list_wrap) -> + ?tracks:(([< | track] elt) list_wrap) -> ([< | audio_attrib], 'a, [> 'a audio ]) star [@@reflect.element "audio_video"] val video : ?src:Xml.uri wrap -> ?srcs: (([< | source] elt) list_wrap) -> + ?tracks:(([< | track] elt) list_wrap) -> ([< | video_attrib], 'a, [> 'a video]) star [@@reflect.element "audio_video"] @@ -920,6 +940,12 @@ module type T = sig val source : ([< | source_attrib], [> | source]) nullary + val track : + src: Xml.uri wrap -> + ([< | track_attrib], [> | track]) nullary + (** @see + track element documentation on MDN *) + val area : alt: text wrap -> ([< diff --git a/lib/html_types.mli b/lib/html_types.mli index c75c55a00..17049c8fb 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -1952,6 +1952,15 @@ type source_content_fun = notag type source_attrib = [ | common | `Src | `Srcset | `Mime_type | `Media ] +(* NAME: track, KIND: nullary, TYPE: [= common |`Kind |`Srclang |`Label |`Default ], [=`Track], ARG: notag, ATTRIB: OUT: [=`Track] *) +type track = [ | `Track ] + +type track_content = notag + +type track_content_fun = notag + +type track_attrib = [ | common | `Kind | `Srclang | `Label | `Default ] + (* NAME: area, KIND: nullary, TYPE: [= common | `Alt | `Coords | `Shape| `Target | `Rel | `Media| `Hreflang | `Mime_type],[=`Area], ARG: notag, ATTRIB: OUT: [=`Area] *) type area = [ | `Area ] @@ -2439,6 +2448,10 @@ type big_variant = | `Open | `Audio | `Metadata + | `Subtitles + | `Captions + | `Descriptions + | `Chapters | `None | `Pubdate | `Required diff --git a/syntax/element_content.ml b/syntax/element_content.ml index 8a352cc75..ce20cb412 100644 --- a/syntax/element_content.ml +++ b/syntax/element_content.ml @@ -160,12 +160,17 @@ let object_ ~lang ~loc ~name children = let audio_video ~lang ~loc ~name children = let sources, others = partition (html "source") children in + let tracks, others = partition (html "track") others in - if sources <> [] then - (Labelled "srcs", Common.list_wrap_value lang loc sources) :: - star ~lang ~loc ~name others - else - star ~lang ~loc ~name others + let sources = + if sources = [] then [] + else [Labelled "srcs", Common.list_wrap_value lang loc sources] + in + let tracks = + if tracks = [] then [] + else [Labelled "tracks", Common.list_wrap_value lang loc tracks] + in + sources @ tracks @ star ~lang ~loc ~name others let table ~lang ~loc ~name children = let caption, others = partition (html "caption") children in diff --git a/test/test_html.ml b/test/test_html.ml index 95fefedfe..5567d71c0 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -22,6 +22,15 @@ let html_elements = "html elements", tyxml_tests Html.[ p [data ~value:"42" [txt "forty-two"]], "

forty-two

" ; + "track", + video ~tracks:[ + track ~src:"video_en.vtt" + ~a:[a_kind `Subtitles; a_track_srclang "en"; + a_label "English"; a_default ()] () + ] [], + "" ; + "div", div [a []], "
" ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 9b139ff54..886bd603c 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -205,6 +205,11 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|foo|}]], [data ~value:"42" [txt "foo"] ]; + "track in video", + [[%html {||}]], + [video ~tracks:[track ~src:"v.vtt" + ~a:[a_kind `Subtitles; a_track_srclang "en"; a_default ()] ()] []]; + "picture", [[%html {|
test picture/img.png From b4704e36ed467149d011780946f217ec637ce9f2 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:32:39 +0200 Subject: [PATCH 07/24] Add support for the slot element The slot element (Web Components) defines a placeholder inside a shadow tree. Its content model is transparent, so it uses the same phantom type encoding as canvas and map: the children type is carried in the type parameter and checked at the usage site. The name attribute is provided by the existing a_name function. Spec: https://html.spec.whatwg.org/multipage/scripting.html#the-slot-element --- CHANGES.md | 1 + lib/html_f.ml | 2 ++ lib/html_sigs.mli | 4 ++++ lib/html_types.mli | 19 ++++++++++++++++--- test/test_html.ml | 4 ++++ test/test_ppx.ml | 4 ++++ 6 files changed, 31 insertions(+), 3 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 6def071da..9c7a30940 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,7 @@ * Add support for the `bdi` element * Add support for the `search` element * Add support for the `data` element +* Add support for the `slot` element * Add support for the `track` element and its `kind`, `srclang` (as `a_track_srclang`) and `default` attributes; `audio` and `video` now accept an optional `?tracks` argument diff --git a/lib/html_f.ml b/lib/html_f.ml index 5b3df86cf..61c956481 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -695,6 +695,8 @@ struct let template = star "template" + let slot = star "slot" + let article = star "article" let aside = star "aside" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 24352e99b..a37959f61 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -1124,6 +1124,10 @@ module type T = sig (** @see Template element documentation on MDN *) + val slot : ([< | slot_attrib], 'a, [> | 'a slot]) star + (** @see + slot element documentation on MDN *) + val meta : ([< | meta_attrib], [> | meta]) nullary (** {3 Style Sheets} *) diff --git a/lib/html_types.mli b/lib/html_types.mli index 17049c8fb..d8ea3392e 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -447,6 +447,7 @@ type (+'interactive, +'noscript, +'regular, +'media) transparent = | `Del of 'regular | `Object of 'regular | `Object_interactive of 'regular + | `Slot of 'regular | `Audio_interactive of 'media | `Video_interactive of 'media | `Audio of 'media @@ -461,6 +462,7 @@ type (+'noscript, +'regular, +'media) transparent_without_interactive = | `Object of 'regular | `Canvas of 'regular | `Map of 'regular + | `Slot of 'regular | `Audio of 'media | `Video of 'media ] @@ -474,6 +476,7 @@ type (+'interactive, +'regular, +'media) transparent_without_noscript = | `Map of 'regular | `Object of 'regular | `Object_interactive of 'regular + | `Slot of 'regular | `Video of 'media | `Audio of 'media | `Video_interactive of 'media @@ -490,6 +493,7 @@ type (+'interactive, +'noscript, +'regular) transparent_without_media = | `Canvas of 'regular | `Object of 'regular | `Object_interactive of 'regular + | `Slot of 'regular ] (** Metadata without title *) @@ -736,7 +740,7 @@ type (+'a, +'b) between_phrasing_and_phrasing_without_interactive = > `Abbr `B `Bdi `Bdo `Br `Canvas `Cite `Code `Command `Data `Datalist `Del `Dfn `Em `I `Img `Picture `Ins `Kbd `Map `Mark `Meter `Noscript `Object `PCDATA `Progress `Q `Ruby `S `Samp `Script - `Small `Span `Strong `Sub `Sup `Svg `Template `Time `U `Var `Wbr ] as 'a) + `Slot `Small `Span `Strong `Sub `Sup `Svg `Template `Time `U `Var `Wbr ] as 'a) (** Phrasing without the interactive markups *) type phrasing_without_dfn = @@ -1137,7 +1141,7 @@ type +'a between_flow5_and_flow5_without_interactive_header_footer = `Fieldset `Figure `Form `H1 `H2 `H3 `H4 `H5 `H6 `Hgroup `Hr `I `Img `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript `Object `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `S `Samp `Script - `Search `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg `Table + `Search `Section `Select `Slot `Small `Span `Strong `Style `Sub `Sup `Svg `Table `Template `Textarea `Time `U `Ul `Var `Video `Wbr] as 'a type (+'a, +'b) between_flow5_and_flow5_without_header_footer = @@ -1153,7 +1157,7 @@ type (+'a, +'b) between_flow5_and_flow5_without_header_footer = `Img `Img_interactive `Picture `Input `Ins `Kbd `Keygen `Label `Map `Mark `Menu `Meter `Nav `Noscript `Object `Object_interactive `Ol `Output `P `PCDATA `Pre `Progress `Q `Ruby `S `Samp `Script - `Search `Section `Select `Small `Span `Strong `Style `Sub `Sup `Svg + `Search `Section `Select `Slot `Small `Span `Strong `Style `Sub `Sup `Svg `Table `Template `Textarea `Time `U `Ul `Var `Video `Video_interactive `Wbr ] as 'a @@ -2392,6 +2396,15 @@ type template_content = [ | flow5 ] type template_content_fun = [ | flow5 ] +(* NAME: slot, KIND: star, TYPE: [= common | `Name ],'a, [=`Slot of 'a], ARG: 'a, ATTRIB: OUT: [=`Slot of 'a] *) +type 'a slot = [ | `Slot of 'a ] + +type slot_content = flow5 +type slot_ = slot_content slot +type slot_content_fun = flow5 + +type slot_attrib = [ | common | `Name ] + (* NAME: link, KIND: nullary, TYPE: [= common | `Hreflang | `Media | `Rel | `Href | `Sizes | `Mime_type ], [=`Link], ARG: notag, ATTRIB: OUT: [=`Link] *) type link = [ | `Link ] diff --git a/test/test_html.ml b/test/test_html.ml index 5567d71c0..173647e02 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -22,6 +22,10 @@ let html_elements = "html elements", tyxml_tests Html.[ p [data ~value:"42" [txt "forty-two"]], "

forty-two

" ; + "slot", + div [slot ~a:[a_name "icon"] [txt "fallback"]], + "
fallback
" ; + "track", video ~tracks:[ track ~src:"video_en.vtt" diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 886bd603c..ad15d36c7 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -205,6 +205,10 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|foo|}]], [data ~value:"42" [txt "foo"] ]; + "slot", + [[%html {|
fallback
|}]], + [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "track in video", [[%html {||}]], [video ~tracks:[track ~src:"v.vtt" From d9ce29d223e2132710f06603767a87873098cadc Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:38:17 +0200 Subject: [PATCH 08/24] Add missing global attributes New global attributes, available on every element: - popover (a_popover, values auto, manual, hint; a bare popover attribute parses as auto in the PPX) - inert (a_inert) - enterkeyhint (a_enterkeyhint) - autocapitalize (a_autocapitalize) - autocorrect (a_autocorrect, on/off boolean) - writingsuggestions (a_writingsuggestions, true/false boolean) - nonce (a_nonce) - slot (a_slot) - is (a_is) Also allow the auto value for the dir attribute (a_dir and the required dir argument of bdo). Spec: https://html.spec.whatwg.org/multipage/interaction.html and https://html.spec.whatwg.org/multipage/popover.html --- CHANGES.md | 5 +++++ lib/html_f.ml | 36 ++++++++++++++++++++++++++++++++++ lib/html_sigs.mli | 40 ++++++++++++++++++++++++++++++++++++-- lib/html_types.mli | 24 +++++++++++++++++++++++ syntax/attribute_value.ml | 2 ++ syntax/attribute_value.mli | 1 + test/test_html.ml | 10 ++++++++++ test/test_ppx.ml | 15 ++++++++++++++ 8 files changed, 131 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 9c7a30940..256e6131f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -3,6 +3,11 @@ * Fix the development-profile build with recent compilers: anonymize unused functor parameters in printer and functor signatures (warning 67) +* Add the global attributes `popover` (`a_popover`), `inert` (`a_inert`), + `enterkeyhint` (`a_enterkeyhint`), `autocapitalize` (`a_autocapitalize`), + `autocorrect` (`a_autocorrect`), `writingsuggestions` + (`a_writingsuggestions`), `nonce` (`a_nonce`), `slot` (`a_slot`) and + `is` (`a_is`); allow `` `Auto`` for the `dir` attribute * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 61c956481..779afb0b7 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -287,6 +287,12 @@ struct let a_autocomplete x = user_attrib C.string_of_autocomplete "autocomplete" x + let a_autocapitalize x = + user_attrib C.string_of_big_variant "autocapitalize" x + + let a_autocorrect x = + user_attrib C.onoff_of_bool "autocorrect" x + let a_async = constant_attrib "async" @@ -322,6 +328,9 @@ struct let a_draggable d = bool_attrib "draggable" d + let a_enterkeyhint x = + user_attrib C.string_of_big_variant "enterkeyhint" x + let a_form = string_attrib "form" let a_formaction = uri_attrib "formaction" @@ -340,6 +349,11 @@ struct let a_icon = uri_attrib "icon" + let a_inert = + constant_attrib "inert" + + let a_is = string_attrib "is" + let a_ismap = constant_attrib "ismap" @@ -363,6 +377,8 @@ struct let a_inputmode x = user_attrib C.string_of_big_variant "inputmode" x + let a_nonce = string_attrib "nonce" + let a_novalidate = constant_attrib "novalidate" @@ -375,6 +391,9 @@ struct let a_placeholder = string_attrib "placeholder" + let a_popover x = + user_attrib C.string_of_big_variant "popover" x + let a_poster = uri_attrib "poster" let a_preload x = @@ -394,6 +413,9 @@ struct let a_sandbox x = user_attrib C.string_of_sandbox "sandbox" x + let a_writingsuggestions = + bool_attrib "writingsuggestions" + let a_spellcheck sc = bool_attrib "spellcheck" sc @@ -406,6 +428,8 @@ struct let a_sizes sizes = user_attrib C.string_of_sizes "sizes" sizes + let a_slot = string_attrib "slot" + let a_span = int_attrib "span" (*let a_srcdoc*) @@ -1034,6 +1058,18 @@ struct | `Yes -> "yes" | `No -> "no" | `Auto -> "auto" + | `Manual -> "manual" + | `Hint -> "hint" + | `On -> "on" + | `Off -> "off" + | `Enter -> "enter" + | `Done -> "done" + | `Go -> "go" + | `Previous -> "previous" + | `Send -> "send" + | `Sentences -> "sentences" + | `Words -> "words" + | `Characters -> "characters" | `Circle -> "circle" | `Poly -> "poly" | `Alternate -> "alternate" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index a37959f61..165675e6a 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -264,6 +264,14 @@ module type T = sig val a_autocomplete : autocomplete_option wrap -> [> | `Autocomplete] attrib (** @see autocomplete documentation. *) + val a_autocapitalize : + [< | `Off | `None | `On | `Sentences | `Words | `Characters ] wrap -> + [> | `Autocapitalize] attrib + (** @see autocapitalize documentation. *) + + val a_autocorrect : (bool[@onoff]) wrap -> [> | `Autocorrect] attrib + (** @see autocorrect documentation. *) + val a_async : unit -> [> | `Async] attrib val a_autofocus : unit -> [> | `Autofocus] attrib @@ -288,10 +296,15 @@ module type T = sig val a_controls : unit -> [> | `Controls] attrib - val a_dir : [< | `Rtl | `Ltr] wrap -> [> | `Dir] attrib + val a_dir : [< | `Rtl | `Ltr | `Auto] wrap -> [> | `Dir] attrib val a_draggable : bool wrap -> [> | `Draggable] attrib + val a_enterkeyhint : + [< | `Enter | `Done | `Go | `Next | `Previous | `Search | `Send ] wrap -> + [> | `Enterkeyhint] attrib + (** @see enterkeyhint documentation. *) + val a_form : idref wrap -> [> | `Form] attrib val a_formaction : Xml.uri wrap -> [> | `Formaction] attrib @@ -308,6 +321,13 @@ module type T = sig val a_icon : Xml.uri wrap -> [> | `Icon] attrib + val a_inert : unit -> [> | `Inert] attrib + (** @see inert documentation. *) + + val a_is : text wrap -> [> | `Is] attrib + (** Name of a customized built-in element. + @see is documentation. *) + val a_ismap : unit -> [> | `Ismap] attrib val a_keytype : text wrap -> [> | `Keytype] attrib @@ -333,6 +353,10 @@ module type T = sig [> `Inputmode] attrib (** @see inputmode documentation. *) + val a_nonce : text wrap -> [> | `Nonce] attrib + (** Cryptographic nonce used by Content Security Policy. + @see nonce documentation. *) + val a_novalidate : unit -> [> | `Novalidate] attrib val a_open : unit -> [> | `Open] attrib @@ -343,6 +367,11 @@ module type T = sig val a_placeholder : text wrap -> [> | `Placeholder] attrib + val a_popover : [< | popover_value] wrap -> [> | `Popover] attrib + (** In HTML, a bare [popover] attribute is equivalent to + [popover="auto"]. + @see popover documentation. *) + val a_poster : Xml.uri wrap -> [> | `Poster] attrib val a_preload : [< | `None | `Metadata | `Audio] wrap -> [> | `Preload] attrib @@ -363,12 +392,19 @@ module type T = sig val a_spellcheck : bool wrap -> [> | `Spellcheck] attrib + val a_writingsuggestions : bool wrap -> [> | `Writingsuggestions] attrib + (** @see writingsuggestions documentation. *) + val a_scoped : unit -> [> | `Scoped] attrib val a_seamless : unit -> [> | `Seamless] attrib val a_sizes : (number * number) list option wrap -> [> | `Sizes] attrib + val a_slot : text wrap -> [> | `Slot] attrib + (** Name of the shadow tree slot the element is assigned to. + @see slot documentation. *) + val a_span : number wrap -> [> | `Span] attrib (** @deprecated Use {!a_xml_lang} instead. *) @@ -846,7 +882,7 @@ module type T = sig val wbr : ([< | wbr_attrib], [> | wbr]) nullary val bdo : - dir: [< | `Ltr | `Rtl] wrap -> + dir: [< | `Ltr | `Rtl | `Auto] wrap -> ([< | bdo_attrib], [< | bdo_content_fun], [> | bdo]) star val bdi : ([< | bdi_attrib], [< | bdi_content_fun], [> | bdi]) star diff --git a/lib/html_types.mli b/lib/html_types.mli index d8ea3392e..1e0a3a48b 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -289,20 +289,29 @@ type i18n = [ | `XML_lang | `Lang ] type core = [ | `Accesskey + | `Autocapitalize + | `Autocorrect | `Class | `Contenteditable | `Contextmenu | `Dir | `Draggable + | `Enterkeyhint | `Hidden | `Id + | `Inert | i18n + | `Is + | `Nonce + | `Popover + | `Slot | `Spellcheck | `Style_Attr | `Tabindex | `Translate | `Title | `User_data + | `Writingsuggestions | `XMLns ] @@ -2499,8 +2508,21 @@ type big_variant = | `One | `Zero | `Auto + | `Manual + | `Hint | `No | `Yes + | `On + | `Off + | `Enter + | `Done + | `Go + | `Next + | `Previous + | `Send + | `Sentences + | `Words + | `Characters | `Defer | `Verbatim | `Latin @@ -2555,3 +2577,5 @@ type input_type = type script_type = [ `Javascript | `Module | `Mime of string ] type autocomplete_option = [ `On | `Off | `Tokens of string list] + +type popover_value = [ `Auto | `Manual | `Hint ] diff --git a/syntax/attribute_value.ml b/syntax/attribute_value.ml index 4630d6e11..96973c5a3 100644 --- a/syntax/attribute_value.ml +++ b/syntax/attribute_value.ml @@ -580,6 +580,8 @@ let script_type = let sandbox = spaces variant +let popover = variant_or_empty "Auto" + let in_ = total_variant Svg_types_reflected.in_value let in2 = in_ diff --git a/syntax/attribute_value.mli b/syntax/attribute_value.mli index 339afa6bd..997905a2f 100644 --- a/syntax/attribute_value.mli +++ b/syntax/attribute_value.mli @@ -220,6 +220,7 @@ val script_type : parser These parsers are named after the attribute for which they are used. *) val sandbox : parser +val popover : parser val in_ : parser val in2 : parser val xmlns : parser diff --git a/test/test_html.ml b/test/test_html.ml index 173647e02..698d8b720 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,16 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "global attributes", + div ~a:[a_popover `Auto; a_inert (); a_dir `Auto; + a_autocapitalize `Words; a_autocorrect true; + a_writingsuggestions false; a_enterkeyhint `Go; + a_nonce "n0nce"; a_slot "myslot"; a_is "word-count"] [], + "
" ; + "input", input ~a:[a_formaction "post.html"; a_formmethod `Post] (), ""; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index ad15d36c7..6f8b21e89 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,21 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "popover bare", + [[%html {|
|}]], + [div ~a:[a_popover `Auto] [] ]; + + "popover manual", + [[%html {|
|}]], + [div ~a:[a_popover `Manual] [] ]; + + "global attributes", + [[%html {|
|}]], + [div ~a:[a_inert (); a_dir `Auto; a_autocapitalize `Sentences; + a_autocorrect false; a_writingsuggestions true; + a_enterkeyhint `Send; a_nonce "n"; a_slot "s"; + a_is "my-elt"] [] ]; + "track in video", [[%html {||}]], [video ~tracks:[track ~src:"v.vtt" From af331bc6a4ef16311ffd80ec8aaf29a3273d363d Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:39:32 +0200 Subject: [PATCH 09/24] Add the microdata global attributes New global attributes: itemscope (a_itemscope), itemtype (a_itemtype), itemid (a_itemid), itemprop (a_itemprop) and itemref (a_itemref). Spec: https://html.spec.whatwg.org/multipage/microdata.html --- CHANGES.md | 2 ++ lib/html_f.ml | 11 +++++++++++ lib/html_sigs.mli | 21 +++++++++++++++++++++ lib/html_types.mli | 5 +++++ test/test_html.ml | 8 ++++++++ test/test_ppx.ml | 6 ++++++ 6 files changed, 53 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 256e6131f..e957bc1b7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,8 @@ `autocorrect` (`a_autocorrect`), `writingsuggestions` (`a_writingsuggestions`), `nonce` (`a_nonce`), `slot` (`a_slot`) and `is` (`a_is`); allow `` `Auto`` for the `dir` attribute +* Add the microdata global attributes `itemscope`, `itemtype`, `itemid`, + `itemprop` and `itemref` * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 779afb0b7..b2553d4a0 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -354,6 +354,17 @@ struct let a_is = string_attrib "is" + let a_itemscope = + constant_attrib "itemscope" + + let a_itemtype = space_sep_attrib "itemtype" + + let a_itemid = uri_attrib "itemid" + + let a_itemprop = space_sep_attrib "itemprop" + + let a_itemref = space_sep_attrib "itemref" + let a_ismap = constant_attrib "ismap" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 165675e6a..e6dd4f4f6 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -328,6 +328,27 @@ module type T = sig (** Name of a customized built-in element. @see is documentation. *) + val a_itemscope : unit -> [> | `Itemscope] attrib + (** Microdata: creates a new item. + @see itemscope documentation. *) + + val a_itemtype : string list wrap -> [> | `Itemtype] attrib + (** Microdata: space-separated list of vocabulary URLs for the item. + @see itemtype documentation. *) + + val a_itemid : Xml.uri wrap -> [> | `Itemid] attrib + (** Microdata: global identifier of the item. + @see itemid documentation. *) + + val a_itemprop : string list wrap -> [> | `Itemprop] attrib + (** Microdata: space-separated list of names of the property. + @see itemprop documentation. *) + + val a_itemref : idrefs wrap -> [> | `Itemref] attrib + (** Microdata: additional elements to crawl to find the + name-value pairs of the item. + @see itemref documentation. *) + val a_ismap : unit -> [> | `Ismap] attrib val a_keytype : text wrap -> [> | `Keytype] attrib diff --git a/lib/html_types.mli b/lib/html_types.mli index 1e0a3a48b..edabdafb3 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -302,6 +302,11 @@ type core = | `Inert | i18n | `Is + | `Itemid + | `Itemprop + | `Itemref + | `Itemscope + | `Itemtype | `Nonce | `Popover | `Slot diff --git a/test/test_html.ml b/test/test_html.ml index 698d8b720..91a3c3169 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,14 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "microdata", + div ~a:[a_itemscope (); a_itemtype ["https://schema.org/Person"]; + a_itemid "urn:isbn:123"; a_itemref ["a"; "b"]] + [span ~a:[a_itemprop ["name"]] [txt "X"]], + "
" + ^ "X
" ; + "global attributes", div ~a:[a_popover `Auto; a_inert (); a_dir `Auto; a_autocapitalize `Words; a_autocorrect true; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 6f8b21e89..073e03935 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,12 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "microdata", + [[%html {|
X
|}]], + [div ~a:[a_itemscope (); a_itemtype ["https://schema.org/Person"]; + a_itemid "urn:isbn:123"; a_itemref ["a"; "b"]] + [span ~a:[a_itemprop ["name"]] [txt "X"]] ]; + "popover bare", [[%html {|
|}]], [div ~a:[a_popover `Auto] [] ]; From f1148abe76752f9361e2b69a1f29a13542a7548a Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:42:00 +0200 Subject: [PATCH 10/24] Add the part and exportparts global attributes These attributes expose shadow-tree parts to outside styling. They are defined by the W3C CSS Shadow Parts specification (not by the WHATWG HTML standard) but are global attributes implemented by all browsers. Spec: https://drafts.csswg.org/css-shadow-parts/ --- CHANGES.md | 1 + lib/html_f.ml | 4 ++++ lib/html_sigs.mli | 13 +++++++++++++ lib/html_types.mli | 2 ++ test/test_html.ml | 6 ++++++ test/test_ppx.ml | 4 ++++ 6 files changed, 30 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index e957bc1b7..e4709d91a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -10,6 +10,7 @@ `is` (`a_is`); allow `` `Auto`` for the `dir` attribute * Add the microdata global attributes `itemscope`, `itemtype`, `itemid`, `itemprop` and `itemref` +* Add the `part` and `exportparts` global attributes (CSS Shadow Parts) * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index b2553d4a0..50fc87247 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -402,6 +402,10 @@ struct let a_placeholder = string_attrib "placeholder" + let a_part = space_sep_attrib "part" + + let a_exportparts = comma_sep_attrib "exportparts" + let a_popover x = user_attrib C.string_of_big_variant "popover" x diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index e6dd4f4f6..bfd7a0bc1 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -388,6 +388,19 @@ module type T = sig val a_placeholder : text wrap -> [> | `Placeholder] attrib + val a_part : string list wrap -> [> | `Part] attrib + (** Space-separated list of part names of the element, exposed to + shadow-tree styling. Defined by the CSS Shadow Parts + specification, not by the HTML standard. + @see part documentation. *) + + val a_exportparts : text list wrap -> [> | `Exportparts] attrib + (** Comma-separated list of part mappings ([name] or + [name:exposed-name]) forwarded from a nested shadow tree. + Defined by the CSS Shadow Parts specification, not by the HTML + standard. + @see exportparts documentation. *) + val a_popover : [< | popover_value] wrap -> [> | `Popover] attrib (** In HTML, a bare [popover] attribute is equivalent to [popover="auto"]. diff --git a/lib/html_types.mli b/lib/html_types.mli index edabdafb3..3526e10a4 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -297,6 +297,7 @@ type core = | `Dir | `Draggable | `Enterkeyhint + | `Exportparts | `Hidden | `Id | `Inert @@ -308,6 +309,7 @@ type core = | `Itemscope | `Itemtype | `Nonce + | `Part | `Popover | `Slot | `Spellcheck diff --git a/test/test_html.ml b/test/test_html.ml index 91a3c3169..a7a8b6f6c 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,12 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "shadow parts", + div ~a:[a_part ["label"; "value"]; + a_exportparts ["inner-label"; "inner-value:value"]] [], + "
" ; + "microdata", div ~a:[a_itemscope (); a_itemtype ["https://schema.org/Person"]; a_itemid "urn:isbn:123"; a_itemref ["a"; "b"]] diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 073e03935..3d2b0dc32 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,10 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "shadow parts", + [[%html {||}]], + [span ~a:[a_part ["label"; "value"]; a_exportparts ["a"; "b:c"]] [] ]; + "microdata", [[%html {|
X
|}]], [div ~a:[a_itemscope (); a_itemtype ["https://schema.org/Person"]; From ba626e7bde22dd9b10f3996a6fedbb51c7db1a23 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:44:17 +0200 Subject: [PATCH 11/24] Add popover target and invoker command attributes New attributes on button (and, for the popover ones, input): - popovertarget (a_popovertarget) and popovertargetaction (a_popovertargetaction) to control popovers from a button - command (a_command) and commandfor (a_commandfor), the Invoker Commands API; custom commands are expressed with the Other constructor of the new command_value type, following the linktype precedent Spec: https://html.spec.whatwg.org/multipage/popover.html and https://html.spec.whatwg.org/multipage/form-elements.html#attr-button-command --- CHANGES.md | 3 +++ lib/html_f.ml | 19 +++++++++++++++++++ lib/html_sigs.mli | 17 +++++++++++++++++ lib/html_types.mli | 27 +++++++++++++++++++++++++++ syntax/attribute_value.ml | 2 ++ syntax/attribute_value.mli | 1 + test/test_html.ml | 15 +++++++++++++++ test/test_ppx.ml | 13 +++++++++++++ 8 files changed, 97 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index e4709d91a..8564c6a62 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,9 @@ * Add the microdata global attributes `itemscope`, `itemtype`, `itemid`, `itemprop` and `itemref` * Add the `part` and `exportparts` global attributes (CSS Shadow Parts) +* Add the `popovertarget` and `popovertargetaction` attributes on + buttons and inputs, and the `command` and `commandfor` attributes + (Invoker Commands) on buttons * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 50fc87247..2e3a19002 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -409,6 +409,16 @@ struct let a_popover x = user_attrib C.string_of_big_variant "popover" x + let a_popovertarget = string_attrib "popovertarget" + + let a_popovertargetaction x = + user_attrib C.string_of_big_variant "popovertargetaction" x + + let a_command x = + user_attrib C.string_of_big_variant "command" x + + let a_commandfor = string_attrib "commandfor" + let a_poster = uri_attrib "poster" let a_preload x = @@ -1085,6 +1095,15 @@ struct | `Sentences -> "sentences" | `Words -> "words" | `Characters -> "characters" + | `Show -> "show" + | `Hide -> "hide" + | `Toggle -> "toggle" + | `Show_modal -> "show-modal" + | `Close -> "close" + | `Request_close -> "request-close" + | `Show_popover -> "show-popover" + | `Hide_popover -> "hide-popover" + | `Toggle_popover -> "toggle-popover" | `Circle -> "circle" | `Poly -> "poly" | `Alternate -> "alternate" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index bfd7a0bc1..921e020dc 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -406,6 +406,23 @@ module type T = sig [popover="auto"]. @see popover documentation. *) + val a_popovertarget : idref wrap -> [> | `Popovertarget] attrib + (** Id of the popover element to control with a button. + @see popovertarget documentation. *) + + val a_popovertargetaction : + [< | `Show | `Hide | `Toggle ] wrap -> [> | `Popovertargetaction] attrib + (** @see popovertargetaction documentation. *) + + val a_command : [< | command_value] wrap -> [> | `Command] attrib + (** Action to perform on the element targeted by a button + (Invoker Commands API). + @see command documentation. *) + + val a_commandfor : idref wrap -> [> | `Commandfor] attrib + (** Id of the element a button command targets. + @see commandfor documentation. *) + val a_poster : Xml.uri wrap -> [> | `Poster] attrib val a_preload : [< | `None | `Metadata | `Audio] wrap -> [> | `Preload] attrib diff --git a/lib/html_types.mli b/lib/html_types.mli index 3526e10a4..8a3fc97f9 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -2200,6 +2200,8 @@ type input_attrib = | `Value | `Width | `Inputmode + | `Popovertarget + | `Popovertargetaction ] type textarea = [ | `Textarea ] @@ -2247,6 +2249,10 @@ type button_attrib = | `Name | `Text_Value | `Button_Type + | `Popovertarget + | `Popovertargetaction + | `Command + | `Commandfor ] (* NAME: select, KIND: star, TYPE: [= common |`Autofocus | `Multiple | `Name | `Size | `Form | `Disabled ], [ `Optgroup | `Option ],[=`Select], ARG: [ `Optgroup | `Option ], ATTRIB: OUT: [=`Select] *) @@ -2530,6 +2536,16 @@ type big_variant = | `Sentences | `Words | `Characters + | `Show + | `Hide + | `Toggle + | `Show_modal + | `Close + | `Request_close + | `Show_popover + | `Hide_popover + | `Toggle_popover + | `Other of string | `Defer | `Verbatim | `Latin @@ -2586,3 +2602,14 @@ type script_type = [ `Javascript | `Module | `Mime of string ] type autocomplete_option = [ `On | `Off | `Tokens of string list] type popover_value = [ `Auto | `Manual | `Hint ] + +(** Values for the [command] attribute of button elements. Custom + commands (starting with [--]) use the [`Other] constructor. *) +type command_value = + [ `Show_modal + | `Close + | `Request_close + | `Show_popover + | `Hide_popover + | `Toggle_popover + | `Other of string ] [@@reflect.total_variant] diff --git a/syntax/attribute_value.ml b/syntax/attribute_value.ml index 96973c5a3..d0b13b5a7 100644 --- a/syntax/attribute_value.ml +++ b/syntax/attribute_value.ml @@ -582,6 +582,8 @@ let sandbox = spaces variant let popover = variant_or_empty "Auto" +let command = total_variant Html_types_reflected.command_value + let in_ = total_variant Svg_types_reflected.in_value let in2 = in_ diff --git a/syntax/attribute_value.mli b/syntax/attribute_value.mli index 997905a2f..d175bc595 100644 --- a/syntax/attribute_value.mli +++ b/syntax/attribute_value.mli @@ -221,6 +221,7 @@ val script_type : parser val sandbox : parser val popover : parser +val command : parser val in_ : parser val in2 : parser val xmlns : parser diff --git a/test/test_html.ml b/test/test_html.ml index a7a8b6f6c..9a8dd9b0c 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,21 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "popovertarget", + button ~a:[a_popovertarget "pop"; a_popovertargetaction `Toggle] + [txt "Toggle"], + "" ; + + "invoker commands", + div [ + button ~a:[a_commandfor "dlg"; a_command `Show_modal] [txt "Open"] ; + button ~a:[a_commandfor "dlg"; a_command (`Other "--my-cmd")] + [txt "Custom"] + ], + "
" + ^ "
" ; + "shadow parts", div ~a:[a_part ["label"; "value"]; a_exportparts ["inner-label"; "inner-value:value"]] [], diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 3d2b0dc32..c6229320a 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,19 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "popovertarget", + [[%html {||}]], + [button ~a:[a_popovertarget "p"; a_popovertargetaction `Toggle] + [txt "x"] ]; + + "invoker commands", + [[%html {||}]], + [button ~a:[a_commandfor "d"; a_command `Request_close] [txt "x"] ]; + + "custom command", + [[%html {||}]], + [button ~a:[a_commandfor "d"; a_command (`Other "--my-cmd")] [txt "x"] ]; + "shadow parts", [[%html {||}]], [span ~a:[a_part ["label"; "value"]; a_exportparts ["a"; "b:c"]] [] ]; From 2837d666ef5f8798b2c95b2937526a0d766fa5d2 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:46:33 +0200 Subject: [PATCH 12/24] Add loading, decoding, fetchpriority, srcdoc and allow attributes - loading (a_loading, lazy/eager) on img and iframe - decoding (a_decoding, sync/async/auto) on img - fetchpriority (a_fetchpriority, high/low/auto) on img (also used by link and script in a following commit) - srcdoc (a_srcdoc) and allow (a_allow) on iframe - also allow the existing crossorigin, usemap and referrerpolicy attributes on img, as specified Spec: https://html.spec.whatwg.org/multipage/embedded-content.html and https://html.spec.whatwg.org/multipage/urls-and-fetching.html --- CHANGES.md | 3 +++ lib/html_f.ml | 19 ++++++++++++++++++- lib/html_sigs.mli | 17 +++++++++++++++++ lib/html_types.mli | 17 ++++++++++++++--- test/test_html.ml | 11 +++++++++++ test/test_ppx.ml | 9 +++++++++ 6 files changed, 72 insertions(+), 4 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 8564c6a62..4e6259345 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -14,6 +14,9 @@ * Add the `popovertarget` and `popovertargetaction` attributes on buttons and inputs, and the `command` and `commandfor` attributes (Invoker Commands) on buttons +* Add the `loading`, `decoding` and `fetchpriority` attributes on images, + and the `srcdoc`, `allow` and `loading` attributes on iframes; also + allow `crossorigin`, `usemap` and `referrerpolicy` on images * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 2e3a19002..1884494f3 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -275,6 +275,8 @@ struct let a_name = string_attrib "name" + let a_allow = string_attrib "allow" + let a_allowfullscreen = constant_attrib "allowfullscreen" @@ -372,6 +374,15 @@ struct let a_list = string_attrib "list" + let a_loading x = + user_attrib C.string_of_big_variant "loading" x + + let a_decoding x = + user_attrib C.string_of_big_variant "decoding" x + + let a_fetchpriority x = + user_attrib C.string_of_big_variant "fetchpriority" x + let a_loop = constant_attrib "loop" @@ -457,7 +468,8 @@ struct let a_span = int_attrib "span" - (*let a_srcdoc*) + let a_srcdoc = string_attrib "srcdoc" + let a_srclang = string_attrib "srclang" let a_kind x = @@ -1095,6 +1107,11 @@ struct | `Sentences -> "sentences" | `Words -> "words" | `Characters -> "characters" + | `Lazy -> "lazy" + | `Eager -> "eager" + | `Sync -> "sync" + | `High -> "high" + | `Low -> "low" | `Show -> "show" | `Hide -> "hide" | `Toggle -> "toggle" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 921e020dc..b7487b065 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -257,6 +257,10 @@ module type T = sig (** {3 Other attributes} *) + val a_allow : text wrap -> [> | `Allow] attrib + (** Permissions policy of an iframe. + @see allow documentation. *) + val a_allowfullscreen : unit -> [> | `Allowfullscreen] attrib val a_allowpaymentrequest : unit -> [> | `Allowpaymentrequest] attrib @@ -355,6 +359,15 @@ module type T = sig val a_list : idref wrap -> [> | `List] attrib + val a_loading : [< | `Lazy | `Eager ] wrap -> [> | `Loading] attrib + (** @see loading documentation. *) + + val a_decoding : [< | `Sync | `Async | `Auto ] wrap -> [> | `Decoding] attrib + (** @see decoding documentation. *) + + val a_fetchpriority : [< | `High | `Low | `Auto ] wrap -> [> | `Fetchpriority] attrib + (** @see fetchpriority documentation. *) + val a_loop : unit -> [> | `Loop] attrib val a_low : float_number wrap -> [> | `Low] attrib @@ -458,6 +471,10 @@ module type T = sig val a_span : number wrap -> [> | `Span] attrib + val a_srcdoc : text wrap -> [> | `Srcdoc] attrib + (** Inline HTML document of an iframe, given as escaped text. + @see srcdoc documentation. *) + (** @deprecated Use {!a_xml_lang} instead. *) val a_srclang : nmtoken wrap -> [> | `XML_lang] attrib [@@ocaml.deprecated "Use a_xml_lang instead."] diff --git a/lib/html_types.mli b/lib/html_types.mli index 8a3fc97f9..ac1156365 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -1861,16 +1861,18 @@ type iframe_content_fun = [ | `PCDATA ] type iframe_attrib = [ | common + | `Allow | `Allowfullscreen | `Allowpaymentrequest | `Src - | (*| `Srcdoc*) - `Name + | `Srcdoc + | `Name | `Sandbox | `Seamless | `Width | `Height | `Referrerpolicy + | `Loading ] type object__content = [ | flow5 | `Param ] @@ -1913,7 +1915,11 @@ type img = [ `Img ] type img_interactive = [ `Img | `Img_interactive ] type img_content = notag type img_content_fun = notag -type img_attrib = [ | common | `Height | `Ismap | `Width | `Srcset | `Img_sizes] +type img_attrib = + [ | common | `Height | `Ismap | `Width | `Srcset | `Img_sizes + | `Crossorigin | `Usemap | `Referrerpolicy + | `Loading | `Decoding | `Fetchpriority + ] (* Attributes used by audio and video. *) type media_attrib = @@ -2546,6 +2552,11 @@ type big_variant = | `Hide_popover | `Toggle_popover | `Other of string + | `Lazy + | `Eager + | `Sync + | `High + | `Low | `Defer | `Verbatim | `Latin diff --git a/test/test_html.ml b/test/test_html.ml index 9a8dd9b0c..3b7bc830b 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,17 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "img loading", + img ~src:"x.png" ~alt:"x" + ~a:[a_loading `Lazy; a_decoding `Async; a_fetchpriority `Low] (), + "\"x\"" ; + + "iframe srcdoc", + iframe ~a:[a_srcdoc "

Hi

"; a_allow "fullscreen"; a_loading `Lazy] [], + "" ; + "popovertarget", button ~a:[a_popovertarget "pop"; a_popovertargetaction `Toggle] [txt "Toggle"], diff --git a/test/test_ppx.ml b/test/test_ppx.ml index c6229320a..fd028c0ba 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,15 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "img loading", + [[%html {|x|}]], + [img ~src:"x.png" ~alt:"x" + ~a:[a_loading `Eager; a_decoding `Auto; a_fetchpriority `High] () ]; + + "iframe srcdoc", + [[%html {||}]], + [iframe ~a:[a_srcdoc "hello"; a_allow "fullscreen"; a_loading `Lazy] [] ]; + "popovertarget", [[%html {||}]], [button ~a:[a_popovertarget "p"; a_popovertargetaction `Toggle] From ae969eaa1b9ecc00c97720458593e2177feab352 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:50:09 +0200 Subject: [PATCH 13/24] Add as, imagesrcset, imagesizes, blocking and nomodule attributes - as (a_as) on link, for preload destinations (the common subset documented by MDN; other destinations remain reachable with Unsafe.string_attrib) - imagesrcset (a_imagesrcset) and imagesizes (a_imagesizes) on link - blocking (a_blocking) on link, script and style, with a new blocking_token type and a new string_of_blocking function in the Wrapped_functions module type - nomodule (a_nomodule) on script - also allow disabled, referrerpolicy and fetchpriority on link and script where specified Spec: https://html.spec.whatwg.org/multipage/semantics.html and https://html.spec.whatwg.org/multipage/urls-and-fetching.html --- CHANGES.md | 4 ++++ lib/html_f.ml | 30 ++++++++++++++++++++++++++++++ lib/html_sigs.mli | 30 ++++++++++++++++++++++++++++++ lib/html_types.mli | 18 +++++++++++++++++- syntax/attribute_value.ml | 2 ++ syntax/attribute_value.mli | 1 + test/test_html.ml | 4 ++++ test/test_ppx.ml | 15 +++++++++++++++ 8 files changed, 103 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 4e6259345..f80144c6d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,10 @@ * Add the `loading`, `decoding` and `fetchpriority` attributes on images, and the `srcdoc`, `allow` and `loading` attributes on iframes; also allow `crossorigin`, `usemap` and `referrerpolicy` on images +* Add the `as` (`a_as`), `imagesrcset` and `imagesizes` attributes on + links, the `nomodule` attribute on scripts, and the `blocking` + attribute on links, scripts and styles. The `Wrapped_functions` + module type has a new `string_of_blocking` function. * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 1884494f3..5f828f484 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -295,6 +295,9 @@ struct let a_autocorrect x = user_attrib C.onoff_of_bool "autocorrect" x + let a_as x = + user_attrib C.string_of_big_variant "as" x + let a_async = constant_attrib "async" @@ -399,6 +402,9 @@ struct let a_inputmode x = user_attrib C.string_of_big_variant "inputmode" x + let a_nomodule = + constant_attrib "nomodule" + let a_nonce = string_attrib "nonce" let a_novalidate = @@ -446,6 +452,9 @@ struct let a_reversed = constant_attrib "reversed" + let a_blocking x = + user_attrib C.string_of_blocking "blocking" x + let a_sandbox x = user_attrib C.string_of_sandbox "sandbox" x @@ -482,6 +491,10 @@ struct let a_srcset = srcset_attrib "srcset" + let a_imagesrcset = srcset_attrib "imagesrcset" + + let a_imagesizes = comma_sep_attrib "imagesizes" + let a_img_sizes = comma_sep_attrib "sizes" let a_start = int_attrib "start" @@ -1112,6 +1125,17 @@ struct | `Sync -> "sync" | `High -> "high" | `Low -> "low" + | `Document -> "document" + | `Embed -> "embed" + | `Fetch -> "fetch" + | `Font -> "font" + | `Image -> "image" + | `Object -> "object" + | `Script -> "script" + | `Style -> "style" + | `Track -> "track" + | `Video -> "video" + | `Worker -> "worker" | `Show -> "show" | `Hide -> "hide" | `Toggle -> "toggle" @@ -1220,6 +1244,12 @@ struct | None -> "any" + let string_of_blocking_token = function + | `Render -> "render" + + let string_of_blocking l = + String.concat " " (List.map string_of_blocking_token l) + let string_of_sandbox l = String.concat " " (List.map string_of_sandbox_token l) diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index b7487b065..995fcec7e 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -276,6 +276,15 @@ module type T = sig val a_autocorrect : (bool[@onoff]) wrap -> [> | `Autocorrect] attrib (** @see autocorrect documentation. *) + val a_as : + [< | `Audio | `Document | `Embed | `Fetch | `Font | `Image | `Object + | `Script | `Style | `Track | `Video | `Worker ] wrap -> + [> | `As] attrib + (** Destination of a preload link. This covers the destinations + listed by MDN; other spec destinations can be produced with + {!Unsafe.string_attrib}. + @see as documentation. *) + val a_async : unit -> [> | `Async] attrib val a_autofocus : unit -> [> | `Autofocus] attrib @@ -387,6 +396,11 @@ module type T = sig [> `Inputmode] attrib (** @see inputmode documentation. *) + val a_nomodule : unit -> [> | `Nomodule] attrib + (** Indicates that a classic script must not run in browsers that + support module scripts. + @see nomodule documentation. *) + val a_nonce : text wrap -> [> | `Nonce] attrib (** Cryptographic nonce used by Content Security Policy. @see nonce documentation. *) @@ -452,6 +466,11 @@ module type T = sig val a_reversed : unit -> [> | `Reversed] attrib + val a_blocking : [< | blocking_token ] list wrap -> [> | `Blocking] attrib + (** Space-separated list of operations blocked on the fetching of + a script, style sheet or style-relevant link. + @see blocking documentation. *) + val a_sandbox : [< | sandbox_token ] list wrap -> [> | `Sandbox] attrib val a_spellcheck : bool wrap -> [> | `Spellcheck] attrib @@ -504,6 +523,14 @@ module type T = sig val a_srcset : image_candidate list wrap -> [> | `Srcset] attrib + val a_imagesrcset : image_candidate list wrap -> [> | `Imagesrcset] attrib + (** Images to preload, for link elements with [rel=preload] and + [as=image]. + @see imagesrcset documentation. *) + + val a_imagesizes : text list wrap -> [> | `Imagesizes] attrib + (** @see imagesizes documentation. *) + val a_img_sizes : text list wrap -> [> | `Img_sizes] attrib [@@reflect.attribute "sizes" ["img"]] @@ -1396,6 +1423,9 @@ module type Wrapped_functions = sig val string_of_numbers : (Html_types.numbers, string) Xml.W.ft + val string_of_blocking : + ([< Html_types.blocking_token] list, string) Xml.W.ft + val string_of_sandbox : ([< Html_types.sandbox_token] list, string) Xml.W.ft diff --git a/lib/html_types.mli b/lib/html_types.mli index ac1156365..aebd28d15 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -2402,13 +2402,14 @@ type style_content = [ | `PCDATA ] type style_content_fun = [ | `PCDATA ] -type style_attrib = [ | common | `Media | `Mime_type | `Scoped ] +type style_attrib = [ | common | `Media | `Mime_type | `Scoped | `Blocking ] type script = [ | `Script ] type script_attrib = [ | common | subresource_integrity | `Async | `Charset | `Src | `Defer | `Script_type + | `Blocking | `Fetchpriority | `Nomodule | `Referrerpolicy ] type script_content = [ | `PCDATA ] @@ -2443,6 +2444,8 @@ type link_content_fun = notag type link_attrib = [ | common | subresource_integrity | `Hreflang | `Media | `Rel | `Href | `Sizes | `Mime_type + | `As | `Imagesrcset | `Imagesizes | `Blocking | `Fetchpriority + | `Disabled | `Referrerpolicy ] type picture = [ | `Picture ] @@ -2557,6 +2560,17 @@ type big_variant = | `Sync | `High | `Low + | `Document + | `Embed + | `Fetch + | `Font + | `Image + | `Object + | `Script + | `Style + | `Track + | `Video + | `Worker | `Defer | `Verbatim | `Latin @@ -2582,6 +2596,8 @@ type sandbox_token = | `Allow_same_origin | `Allow_script ] +type blocking_token = [ `Render ] + type input_type = [ `Button diff --git a/syntax/attribute_value.ml b/syntax/attribute_value.ml index d0b13b5a7..5d2b32ff9 100644 --- a/syntax/attribute_value.ml +++ b/syntax/attribute_value.ml @@ -580,6 +580,8 @@ let script_type = let sandbox = spaces variant +let blocking = spaces variant + let popover = variant_or_empty "Auto" let command = total_variant Html_types_reflected.command_value diff --git a/syntax/attribute_value.mli b/syntax/attribute_value.mli index d175bc595..22e0b3443 100644 --- a/syntax/attribute_value.mli +++ b/syntax/attribute_value.mli @@ -220,6 +220,7 @@ val script_type : parser These parsers are named after the attribute for which they are used. *) val sandbox : parser +val blocking : parser val popover : parser val command : parser val in_ : parser diff --git a/test/test_html.ml b/test/test_html.ml index 3b7bc830b..8245e1c7d 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,10 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "script nomodule", + script ~a:[a_nomodule (); a_blocking [`Render]] (txt ""), + "" ; + "img loading", img ~src:"x.png" ~alt:"x" ~a:[a_loading `Lazy; a_decoding `Async; a_fetchpriority `Low] (), diff --git a/test/test_ppx.ml b/test/test_ppx.ml index fd028c0ba..82ed4b569 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,21 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "link preload", + [[%html {||}]], + [link ~rel:[`Stylesheet] ~href:"a.css" + ~a:[a_blocking [`Render]; a_fetchpriority `Low] () ]; + + "link imagesrcset", + [[%html {||}]], + [link ~rel:[`Other "preload"] ~href:"i.png" + ~a:[a_as `Image; a_imagesrcset [`Url_pixel ("i2.png", 2.)]; + a_imagesizes ["50vw"]] () ]; + + "script nomodule", + [[%html {||}]], + [script ~a:[a_nomodule (); a_src "a.js"] (txt "") ]; + "img loading", [[%html {|x|}]], [img ~src:"x.png" ~alt:"x" From 25fd2f6edc9167b2d4c9a1c165fd5ea0aee5b783 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:51:31 +0200 Subject: [PATCH 14/24] Add the ping attribute on a and area Also allow the existing referrerpolicy attribute on a and area, as specified. Spec: https://html.spec.whatwg.org/multipage/links.html#ping --- CHANGES.md | 2 ++ lib/html_f.ml | 2 ++ lib/html_sigs.mli | 5 +++++ lib/html_types.mli | 4 +++- test/test_html.ml | 6 ++++++ test/test_ppx.ml | 5 +++++ 6 files changed, 23 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index f80144c6d..13a82bb3a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -21,6 +21,8 @@ links, the `nomodule` attribute on scripts, and the `blocking` attribute on links, scripts and styles. The `Wrapped_functions` module type has a new `string_of_blocking` function. +* Add the `ping` attribute on `a` and `area`; also allow + `referrerpolicy` there * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 5f828f484..dc8fd0523 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -417,6 +417,8 @@ struct let a_pattern = string_attrib "pattern" + let a_ping = space_sep_attrib "ping" + let a_placeholder = string_attrib "placeholder" let a_part = space_sep_attrib "part" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 995fcec7e..6d4b30f72 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -413,6 +413,11 @@ module type T = sig val a_pattern : text wrap -> [> | `Pattern] attrib + val a_ping : string list wrap -> [> | `Ping] attrib + (** Space-separated list of URLs to ping when following the + hyperlink. + @see ping documentation. *) + val a_placeholder : text wrap -> [> | `Placeholder] attrib val a_part : string list wrap -> [> | `Part] attrib diff --git a/lib/html_types.mli b/lib/html_types.mli index aebd28d15..f3275d6ab 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -1831,7 +1831,7 @@ type 'a a = [ | `A of 'a ] type a_ = [ `A of a_content ] (* should not be used as it may break *) type a_attrib = [ | common | `Href | `Hreflang | `Media | `Rel | `Target | `Mime_type - | `Download + | `Download | `Ping | `Referrerpolicy ] (* NAME: del, KIND: star, TYPE: [= common | `Cite | `Datetime ], 'a,[=`Del of 'a], ARG: 'a, ATTRIB: OUT: [=`Del of 'a] *) @@ -2006,6 +2006,8 @@ type area_attrib = | `Hreflang | `Mime_type | `Download + | `Ping + | `Referrerpolicy ] (* NAME: map, KIND: plus, TYPE: [=common | `Name ],'a, [=`Map of 'a], ARG: 'a, ATTRIB: OUT: [=`Map of 'a] *) diff --git a/test/test_html.ml b/test/test_html.ml index 8245e1c7d..76b31e1c4 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,12 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "a ping", + p [a ~a:[a_href "/x"; a_ping ["https://t.example/ping"]; + a_referrerpolicy `No_referrer] [txt "x"]], + "

x

" ; + "script nomodule", script ~a:[a_nomodule (); a_blocking [`Render]] (txt ""), "" ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 82ed4b569..5d736a42d 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,11 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "a ping", + [[%html {|x|}]], + [a ~a:[a_href "/x"; a_ping ["https://a.example"; "https://b.example"]] + [txt "x"] ]; + "link preload", [[%html {||}]], [link ~rel:[`Stylesheet] ~href:"a.css" From 716020e9eb23df82ac4377759c4a2698e7775402 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:53:17 +0200 Subject: [PATCH 15/24] Add dirname and capture attributes on form controls - dirname (a_dirname) on input and textarea - capture (a_capture, user/environment) on input; this attribute is defined by the W3C HTML Media Capture specification - also allow the existing autocomplete attribute on select and textarea, as specified Spec: https://html.spec.whatwg.org/multipage/form-control-infrastructure.html and https://www.w3.org/TR/html-media-capture/ --- CHANGES.md | 3 +++ lib/html_f.ml | 7 +++++++ lib/html_sigs.mli | 11 +++++++++++ lib/html_types.mli | 7 +++++++ test/test_html.ml | 13 +++++++++++++ test/test_ppx.ml | 6 ++++++ 6 files changed, 47 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 13a82bb3a..62d9ffae3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -23,6 +23,9 @@ module type has a new `string_of_blocking` function. * Add the `ping` attribute on `a` and `area`; also allow `referrerpolicy` there +* Add the `dirname` attribute on inputs and textareas and the `capture` + attribute (W3C HTML Media Capture) on inputs; also allow + `autocomplete` on selects and textareas * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index dc8fd0523..ff33246c2 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -319,6 +319,9 @@ struct let a_challenge = string_attrib "challenge" + let a_capture x = + user_attrib C.string_of_big_variant "capture" x + let a_contenteditable ce = bool_attrib "contenteditable" ce @@ -330,6 +333,8 @@ struct let a_dir x = user_attrib C.string_of_big_variant "dir" x + let a_dirname = string_attrib "dirname" + let a_draggable d = bool_attrib "draggable" d @@ -1127,6 +1132,8 @@ struct | `Sync -> "sync" | `High -> "high" | `Low -> "low" + | `User -> "user" + | `Environment -> "environment" | `Document -> "document" | `Embed -> "embed" | `Fetch -> "fetch" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 6d4b30f72..196e6438c 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -303,6 +303,12 @@ module type T = sig val a_challenge : text wrap -> [> | `Challenge] attrib + val a_capture : [< | `User | `Environment ] wrap -> [> | `Capture] attrib + (** Preferred camera for file inputs capturing media. Defined by + the W3C HTML Media Capture specification. The bare form of the + attribute is not supported by the PPX; use an explicit value. + @see capture documentation. *) + val a_contenteditable : bool wrap -> [> | `Contenteditable] attrib val a_contextmenu : idref wrap -> [> | `Contextmenu] attrib @@ -311,6 +317,11 @@ module type T = sig val a_dir : [< | `Rtl | `Ltr | `Auto] wrap -> [> | `Dir] attrib + val a_dirname : text wrap -> [> | `Dirname] attrib + (** Name of the form control field used to submit the element's + text directionality. + @see dirname documentation. *) + val a_draggable : bool wrap -> [> | `Draggable] attrib val a_enterkeyhint : diff --git a/lib/html_types.mli b/lib/html_types.mli index f3275d6ab..5ea347d4b 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -2210,6 +2210,8 @@ type input_attrib = | `Inputmode | `Popovertarget | `Popovertargetaction + | `Dirname + | `Capture ] type textarea = [ | `Textarea ] @@ -2229,6 +2231,8 @@ type textarea_attrib = | `Wrap | `Rows | `Cols + | `Dirname + | `Autocomplete ] type textarea_content = [ | `PCDATA ] @@ -2272,6 +2276,7 @@ type select_content_fun = [ | `Optgroup | `Option ] type select_attrib = [ | common | `Autofocus | `Multiple | `Name | `Size | `Form | `Disabled | `Required + | `Autocomplete ] (* NAME: datalist, KIND: nullary, TYPE: [= common ], [=`Datalist], ARG: notag, ATTRIB: OUT: [=`Datalist] *) @@ -2562,6 +2567,8 @@ type big_variant = | `Sync | `High | `Low + | `User + | `Environment | `Document | `Embed | `Fetch diff --git a/test/test_html.ml b/test/test_html.ml index 76b31e1c4..e9b3c9d8f 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,19 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "form control attributes", + div [ + input ~a:[a_input_type `File; a_capture `Environment] () ; + input ~a:[a_input_type `Text; a_name "comment"; + a_dirname "comment.dir"] () ; + textarea ~a:[a_dirname "t.dir"; a_autocomplete `Off] (txt "") ; + select ~a:[a_autocomplete `Off] [] + ], + "
" + ^ "" + ^ "" + ^ "
" ; + "a ping", p [a ~a:[a_href "/x"; a_ping ["https://t.example/ping"]; a_referrerpolicy `No_referrer] [txt "x"]], diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 5d736a42d..ae74c098d 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,12 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "form control attributes", + [[%html {|
|}]], + [div [input ~a:[a_dirname "c.dir"; a_capture `User] () ; + select ~a:[a_autocomplete `Off] [] ; + textarea ~a:[a_autocomplete `On] (txt "")] ]; + "a ping", [[%html {|x|}]], [a ~a:[a_href "/x"; a_ping ["https://a.example"; "https://b.example"]] From 665b1f8f1ef7a150246541ac4f2ef6351021173d Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:56:27 +0200 Subject: [PATCH 16/24] Add ol type, th abbr, dialog closedby and meta media attributes - type (a_ol_type) on ordered lists, with a new ol_type value type and a new string_of_ol_type function in the Wrapped_functions module type; the values are case-sensitive so the PPX uses a dedicated parser - abbr (a_abbr) on th cells - closedby (a_closedby) on dialogs - allow the existing media attribute on meta (theme-color) Spec: https://html.spec.whatwg.org/multipage/grouping-content.html#attr-ol-type --- CHANGES.md | 4 ++++ lib/html_f.ml | 16 ++++++++++++++++ lib/html_sigs.mli | 17 +++++++++++++++++ lib/html_types.mli | 16 ++++++++++++---- syntax/attribute_value.ml | 12 ++++++++++++ syntax/attribute_value.mli | 1 + test/test_html.ml | 12 ++++++++++++ test/test_ppx.ml | 19 +++++++++++++++++++ 8 files changed, 93 insertions(+), 4 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 62d9ffae3..3ad9c7ead 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -26,6 +26,10 @@ * Add the `dirname` attribute on inputs and textareas and the `capture` attribute (W3C HTML Media Capture) on inputs; also allow `autocomplete` on selects and textareas +* Add the `type` attribute of ordered lists (`a_ol_type`), the `abbr` + attribute on th cells, the `closedby` attribute on dialogs, and allow + `media` on meta. The `Wrapped_functions` module type has a new + `string_of_ol_type` function. * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index ff33246c2..577ad66d8 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -275,6 +275,8 @@ struct let a_name = string_attrib "name" + let a_abbr = string_attrib "abbr" + let a_allow = string_attrib "allow" let a_allowfullscreen = @@ -319,6 +321,9 @@ struct let a_challenge = string_attrib "challenge" + let a_closedby x = + user_attrib C.string_of_big_variant "closedby" x + let a_capture x = user_attrib C.string_of_big_variant "capture" x @@ -506,6 +511,9 @@ struct let a_start = int_attrib "start" + let a_ol_type x = + user_attrib C.string_of_ol_type "type" x + let a_step step = user_attrib C.string_of_step "step" step @@ -1134,6 +1142,7 @@ struct | `Low -> "low" | `User -> "user" | `Environment -> "environment" + | `Closerequest -> "closerequest" | `Document -> "document" | `Embed -> "embed" | `Fetch -> "fetch" @@ -1256,6 +1265,13 @@ struct let string_of_blocking_token = function | `Render -> "render" + let string_of_ol_type = function + | `Decimal -> "1" + | `Lower_alpha -> "a" + | `Upper_alpha -> "A" + | `Lower_roman -> "i" + | `Upper_roman -> "I" + let string_of_blocking l = String.concat " " (List.map string_of_blocking_token l) diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 196e6438c..8163d2af1 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -257,6 +257,11 @@ module type T = sig (** {3 Other attributes} *) + val a_abbr : text wrap -> [> | `Abbr] attrib + (** Alternative label of a header cell, for reference in other + cells. + @see abbr attribute documentation. *) + val a_allow : text wrap -> [> | `Allow] attrib (** Permissions policy of an iframe. @see allow documentation. *) @@ -303,6 +308,11 @@ module type T = sig val a_challenge : text wrap -> [> | `Challenge] attrib + val a_closedby : + [< | `Any | `Closerequest | `None ] wrap -> [> | `Closedby] attrib + (** User actions that can close a dialog. + @see closedby documentation. *) + val a_capture : [< | `User | `Environment ] wrap -> [> | `Capture] attrib (** Preferred camera for file inputs capturing media. Defined by the W3C HTML Media Capture specification. The bare form of the @@ -552,6 +562,11 @@ module type T = sig val a_start : number wrap -> [> | `Start] attrib + val a_ol_type : [< | ol_type] wrap -> [> | `Ol_Type] attrib + [@@reflect.attribute "type" ["ol"]] + (** Numbering type of an ordered list. + @see type attribute documentation. *) + val a_step : float_number option wrap -> [> | `Step] attrib val a_translate : [< | `Yes | `No] wrap -> [> | `Translate] attrib @@ -1442,6 +1457,8 @@ module type Wrapped_functions = sig val string_of_blocking : ([< Html_types.blocking_token] list, string) Xml.W.ft + val string_of_ol_type : ([< Html_types.ol_type], string) Xml.W.ft + val string_of_sandbox : ([< Html_types.sandbox_token] list, string) Xml.W.ft diff --git a/lib/html_types.mli b/lib/html_types.mli index 5ea347d4b..1ad3d83e1 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -1486,7 +1486,7 @@ type dialog_content = [ | flow5 ] type dialog_content_fun = [ | flow5 ] -type dialog_attrib = [ | common | `Open ] +type dialog_attrib = [ | common | `Open | `Closedby ] (* NAME: div, KIND: star, TYPE: [= common ], [= flow5 ], [=`Div], ARG: [= flow5 ], ATTRIB: OUT: [=`Div] *) type div = [ | `Div ] @@ -1504,7 +1504,7 @@ type ol_content = [ | `Li of [ | common | `Int_Value ] ] type ol_content_fun = [ | `Li of [ | common | `Int_Value ] ] -type ol_attrib = [ | common | `Reversed | `Start ] +type ol_attrib = [ | common | `Reversed | `Start | `Ol_Type ] (* NAME: li, KIND: star, TYPE: [= common | `Int_Value] as 'a, [=flow5 ], [=`Li of 'a], ARG: [=flow5 ], ATTRIB: OUT: [=`Li of 'a] *) type li_content = [ | flow5 ] @@ -2108,7 +2108,7 @@ type th_content = [ | flow5 ] type th_content_fun = [ | flow5 ] -type th_attrib = [ | common | `Colspan | `Headers | `Rowspan | `Scope ] +type th_attrib = [ | common | `Colspan | `Headers | `Rowspan | `Scope | `Abbr ] (* NAME: tr, KIND: star, TYPE: [= common ],[= `Td | `Th ], [=`Tr], ARG: [= `Td | `Th ], ATTRIB: OUT: [=`Tr] *) type tr = [ | `Tr ] @@ -2400,7 +2400,8 @@ type meta_content = notag type meta_content_fun = notag -type meta_attrib = [ | common | `Http_equiv | `Name | `Content | `Charset | `Property ] +type meta_attrib = + [ | common | `Http_equiv | `Name | `Content | `Charset | `Property | `Media ] (* NAME: style, KIND: star, TYPE: [= common | `Media | `Mime_type | `Scoped ], [= `PCDATA ], [=`Style], ARG: [= `PCDATA ], ATTRIB: OUT: [=`Style] *) type style = [ | `Style ] @@ -2569,6 +2570,8 @@ type big_variant = | `Low | `User | `Environment + | `Any + | `Closerequest | `Document | `Embed | `Fetch @@ -2639,6 +2642,11 @@ type autocomplete_option = [ `On | `Off | `Tokens of string list] type popover_value = [ `Auto | `Manual | `Hint ] +(** Values of the [type] attribute of ordered lists. The serialized + values are case-sensitive ("1", "a", "A", "i", "I"). *) +type ol_type = + [ `Decimal | `Lower_alpha | `Upper_alpha | `Lower_roman | `Upper_roman ] + (** Values for the [command] attribute of button elements. Custom commands (starting with [--]) use the [`Other] constructor. *) type command_value = diff --git a/syntax/attribute_value.ml b/syntax/attribute_value.ml index 5d2b32ff9..d53994c7f 100644 --- a/syntax/attribute_value.ml +++ b/syntax/attribute_value.ml @@ -582,6 +582,18 @@ let sandbox = spaces variant let blocking = spaces variant +(* The values of the ol type attribute are case-sensitive ("a" and + "A" are distinct), so the generic variant parser cannot be used. *) +let ol_type ?separated_by:_ ?default:_ loc name s = + begin match s with + | "1" -> Some [%expr `Decimal] + | "a" -> Some [%expr `Lower_alpha] + | "A" -> Some [%expr `Upper_alpha] + | "i" -> Some [%expr `Lower_roman] + | "I" -> Some [%expr `Upper_roman] + | _ -> Common.error loc "Invalid value %s in attribute %s" s name + end [@metaloc loc] + let popover = variant_or_empty "Auto" let command = total_variant Html_types_reflected.command_value diff --git a/syntax/attribute_value.mli b/syntax/attribute_value.mli index 22e0b3443..f5814b151 100644 --- a/syntax/attribute_value.mli +++ b/syntax/attribute_value.mli @@ -221,6 +221,7 @@ val script_type : parser val sandbox : parser val blocking : parser +val ol_type : parser val popover : parser val command : parser val in_ : parser diff --git a/test/test_html.ml b/test/test_html.ml index e9b3c9d8f..c81370da9 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,18 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "ol type", + ol ~a:[a_ol_type `Upper_roman; a_start 3] [li [txt "x"]], + "
  1. x
" ; + + "th abbr", + tablex [tbody [tr [th ~a:[a_abbr "Pop."] [txt "Population"]]]], + "
Population
" ; + + "dialog closedby", + dialog ~a:[a_closedby `Closerequest] [div []], + "
" ; + "form control attributes", div [ input ~a:[a_input_type `File; a_capture `Environment] () ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index ae74c098d..2e5bbd5ff 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,25 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "ol type lower", + [[%html {|
  1. x
|}]], + [ol ~a:[a_ol_type `Lower_alpha] [li [txt "x"]] ]; + + "ol type upper", + [[%html {|
  1. x
|}]], + [ol ~a:[a_ol_type `Upper_alpha] [li [txt "x"]] ]; + + "th abbr and dialog closedby", + [[%html {|
x
y
|}]], + [div [tablex [tbody [tr [th ~a:[a_abbr "P"] [txt "x"]]]] ; + dialog ~a:[a_closedby `Any] [txt "y"]] ]; + + "meta media", + [[%html {||}]], + [meta ~a:[a_name "theme-color"; + a_media [`Raw_mediadesc "(prefers-color-scheme: dark)"]; + a_content "black"] () ]; + "form control attributes", [[%html {|
|}]], [div [input ~a:[a_dirname "c.dir"; a_capture `User] () ; From 888e6b13a0fb77665f9c19689d7c27c6592d9f0e Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:57:38 +0200 Subject: [PATCH 17/24] Add playsinline and remote/PiP playback control attributes - playsinline (a_playsinline) on video (WHATWG) - disablepictureinpicture (a_disablepictureinpicture) on video (W3C Picture-in-Picture specification) - disableremoteplayback (a_disableremoteplayback) on audio and video (W3C Remote Playback specification) Spec: https://html.spec.whatwg.org/multipage/media.html --- CHANGES.md | 2 ++ lib/html_f.ml | 9 +++++++++ lib/html_sigs.mli | 13 +++++++++++++ lib/html_types.mli | 3 +++ test/test_html.ml | 7 +++++++ test/test_ppx.ml | 5 +++++ 6 files changed, 39 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 3ad9c7ead..101bf1517 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -30,6 +30,8 @@ attribute on th cells, the `closedby` attribute on dialogs, and allow `media` on meta. The `Wrapped_functions` module type has a new `string_of_ol_type` function. +* Add the `playsinline` and `disablepictureinpicture` attributes on + videos and the `disableremoteplayback` attribute on audios and videos * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 577ad66d8..64186821a 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -429,6 +429,15 @@ struct let a_ping = space_sep_attrib "ping" + let a_playsinline = + constant_attrib "playsinline" + + let a_disablepictureinpicture = + constant_attrib "disablepictureinpicture" + + let a_disableremoteplayback = + constant_attrib "disableremoteplayback" + let a_placeholder = string_attrib "placeholder" let a_part = space_sep_attrib "part" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 8163d2af1..3455ac211 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -441,6 +441,19 @@ module type T = sig val a_placeholder : text wrap -> [> | `Placeholder] attrib + val a_playsinline : unit -> [> | `Playsinline] attrib + (** Indicates that a video is to be played inline, within the + element's playback area. + @see playsinline documentation. *) + + val a_disablepictureinpicture : unit -> [> | `Disablepictureinpicture] attrib + (** Defined by the W3C Picture-in-Picture specification. + @see disablepictureinpicture documentation. *) + + val a_disableremoteplayback : unit -> [> | `Disableremoteplayback] attrib + (** Defined by the W3C Remote Playback specification. + @see disableremoteplayback documentation. *) + val a_part : string list wrap -> [> | `Part] attrib (** Space-separated list of part names of the element, exposed to shadow-tree styling. Defined by the CSS Shadow Parts diff --git a/lib/html_types.mli b/lib/html_types.mli index 1ad3d83e1..ce74fbe83 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -1930,6 +1930,7 @@ type media_attrib = | `Loop | `Muted | `Controls + | `Disableremoteplayback ] type 'a audio = [ | `Audio of 'a ] @@ -1958,6 +1959,8 @@ type video_attrib = | `Poster | `Width | `Height + | `Playsinline + | `Disablepictureinpicture ] (* NAME: canvas, KIND: star, TYPE: [= common |`Width |`Height],'a, [=`Canvas of 'a], ARG: 'a, ATTRIB: OUT: [=`Canvas of 'a] *) diff --git a/test/test_html.ml b/test/test_html.ml index c81370da9..6102462b9 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,13 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "video attributes", + video ~a:[a_playsinline (); a_disablepictureinpicture (); + a_disableremoteplayback ()] [], + "" ; + "ol type", ol ~a:[a_ol_type `Upper_roman; a_start 3] [li [txt "x"]], "
  1. x
" ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 2e5bbd5ff..b26a4acdc 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,11 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "video attributes", + [[%html {||}]], + [video ~a:[a_playsinline (); a_disablepictureinpicture (); + a_disableremoteplayback ()] [] ]; + "ol type lower", [[%html {|
  1. x
|}]], [ol ~a:[a_ol_type `Lower_alpha] [li [txt "x"]] ]; From 65fec0944e75232f17620150f3a83944b41dfb09 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 09:59:50 +0200 Subject: [PATCH 18/24] Add the declarative shadow DOM attributes on template New attributes on template elements: shadowrootmode (a_shadowrootmode, open/closed), shadowrootdelegatesfocus, shadowrootclonable and shadowrootserializable. Spec: https://html.spec.whatwg.org/multipage/scripting.html#the-template-element --- CHANGES.md | 3 +++ lib/html_f.ml | 13 +++++++++++++ lib/html_sigs.mli | 13 +++++++++++++ lib/html_types.mli | 9 ++++++++- test/test_html.ml | 10 ++++++++++ test/test_ppx.ml | 5 +++++ 6 files changed, 52 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 101bf1517..0d2adeaf7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -32,6 +32,9 @@ `string_of_ol_type` function. * Add the `playsinline` and `disablepictureinpicture` attributes on videos and the `disableremoteplayback` attribute on audios and videos +* Add the declarative shadow DOM attributes on templates: + `shadowrootmode`, `shadowrootdelegatesfocus`, `shadowrootclonable` + and `shadowrootserializable` * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 64186821a..7e60b514e 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -491,6 +491,18 @@ struct let a_seamless = constant_attrib "seamless" + let a_shadowrootmode x = + user_attrib C.string_of_big_variant "shadowrootmode" x + + let a_shadowrootdelegatesfocus = + constant_attrib "shadowrootdelegatesfocus" + + let a_shadowrootclonable = + constant_attrib "shadowrootclonable" + + let a_shadowrootserializable = + constant_attrib "shadowrootserializable" + let a_sizes sizes = user_attrib C.string_of_sizes "sizes" sizes @@ -1152,6 +1164,7 @@ struct | `User -> "user" | `Environment -> "environment" | `Closerequest -> "closerequest" + | `Closed -> "closed" | `Document -> "document" | `Embed -> "embed" | `Fetch -> "fetch" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 3455ac211..7393ef1bf 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -521,6 +521,19 @@ module type T = sig val a_seamless : unit -> [> | `Seamless] attrib + val a_shadowrootmode : [< | `Open | `Closed ] wrap -> [> | `Shadowrootmode] attrib + (** Declarative shadow root mode, for template elements. + @see shadowrootmode documentation. *) + + val a_shadowrootdelegatesfocus : unit -> [> | `Shadowrootdelegatesfocus] attrib + (** @see shadowrootdelegatesfocus documentation. *) + + val a_shadowrootclonable : unit -> [> | `Shadowrootclonable] attrib + (** @see shadowrootclonable documentation. *) + + val a_shadowrootserializable : unit -> [> | `Shadowrootserializable] attrib + (** @see shadowrootserializable documentation. *) + val a_sizes : (number * number) list option wrap -> [> | `Sizes] attrib val a_slot : text wrap -> [> | `Slot] attrib diff --git a/lib/html_types.mli b/lib/html_types.mli index ce74fbe83..9c509ef85 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -2430,7 +2430,13 @@ type script_content_fun = [ | `PCDATA ] (* NAME: template, KIND: star, TYPE: [= common ], [= flow5 ], [=`Template], ARG: [= flow5 ], ATTRIB: OUT: [=`Template] *) type template = [ | `Template ] -type template_attrib = [ | common ] +type template_attrib = + [ | common + | `Shadowrootmode + | `Shadowrootdelegatesfocus + | `Shadowrootclonable + | `Shadowrootserializable + ] type template_content = [ | flow5 ] @@ -2575,6 +2581,7 @@ type big_variant = | `Environment | `Any | `Closerequest + | `Closed | `Document | `Embed | `Fetch diff --git a/test/test_html.ml b/test/test_html.ml index 6102462b9..ec6974570 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,16 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "declarative shadow DOM", + div [template ~a:[a_shadowrootmode `Open; a_shadowrootdelegatesfocus (); + a_shadowrootclonable (); a_shadowrootserializable ()] + [p [txt "shadow"]]], + "
" ; + "video attributes", video ~a:[a_playsinline (); a_disablepictureinpicture (); a_disableremoteplayback ()] [], diff --git a/test/test_ppx.ml b/test/test_ppx.ml index b26a4acdc..fba562018 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,11 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "declarative shadow DOM", + [[%html {||}]], + [template ~a:[a_shadowrootmode `Closed; a_shadowrootclonable ()] + [p [txt "x"]] ]; + "video attributes", [[%html {||}]], [video ~a:[a_playsinline (); a_disablepictureinpicture (); From 04f26e47080914a190fcb3ae5f3a9a3bf1070671 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 10:01:41 +0200 Subject: [PATCH 19/24] Add pointer, wheel and auxclick event handler attributes New global event handler attributes: onauxclick, onwheel, onpointercancel, onpointerdown, onpointerenter, onpointerleave, onpointermove, onpointerout, onpointerover, onpointerup, ongotpointercapture and onlostpointercapture. In the DOM, PointerEvent and WheelEvent inherit from MouseEvent, so these handlers use the existing Xml.mouse_event_handler type; adding dedicated handler types to Xml_sigs.T would break every Xml implementation and is left to a future breaking release. Spec: https://html.spec.whatwg.org/multipage/webappapis.html#globaleventhandlers and https://www.w3.org/TR/pointerevents/ --- CHANGES.md | 2 ++ lib/html_f.ml | 16 ++++++++++++++++ lib/html_sigs.mli | 20 ++++++++++++++++++++ lib/html_types.mli | 12 ++++++++++++ test/test_html.ml | 4 ++++ test/test_ppx.ml | 4 ++++ 6 files changed, 58 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 0d2adeaf7..ca11cfd58 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -35,6 +35,8 @@ * Add the declarative shadow DOM attributes on templates: `shadowrootmode`, `shadowrootdelegatesfocus`, `shadowrootclonable` and `shadowrootserializable` +* Add the pointer event handler attributes (`a_onpointerdown`, etc.), + `a_onwheel` and `a_onauxclick` * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 7e60b514e..ecb938b76 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -164,6 +164,7 @@ struct let a_onmousewheel = Xml.event_handler_attrib "onmousewheel" (** Javascript mouse events *) + let a_onauxclick = Xml.mouse_event_handler_attrib "onauxclick" let a_onclick = Xml.mouse_event_handler_attrib "onclick" let a_oncontextmenu = Xml.mouse_event_handler_attrib "oncontextmenu" let a_ondblclick = Xml.mouse_event_handler_attrib "ondblclick" @@ -179,6 +180,21 @@ struct let a_onmouseover = Xml.mouse_event_handler_attrib "onmouseover" let a_onmousemove = Xml.mouse_event_handler_attrib "onmousemove" let a_onmouseout = Xml.mouse_event_handler_attrib "onmouseout" + let a_onwheel = Xml.mouse_event_handler_attrib "onwheel" + + (** Javascript pointer events *) + let a_onpointercancel = Xml.mouse_event_handler_attrib "onpointercancel" + let a_onpointerdown = Xml.mouse_event_handler_attrib "onpointerdown" + let a_onpointerenter = Xml.mouse_event_handler_attrib "onpointerenter" + let a_onpointerleave = Xml.mouse_event_handler_attrib "onpointerleave" + let a_onpointermove = Xml.mouse_event_handler_attrib "onpointermove" + let a_onpointerout = Xml.mouse_event_handler_attrib "onpointerout" + let a_onpointerover = Xml.mouse_event_handler_attrib "onpointerover" + let a_onpointerup = Xml.mouse_event_handler_attrib "onpointerup" + let a_ongotpointercapture = + Xml.mouse_event_handler_attrib "ongotpointercapture" + let a_onlostpointercapture = + Xml.mouse_event_handler_attrib "onlostpointercapture" (** Javascript touch events *) let a_ontouchstart = Xml.touch_event_handler_attrib "ontouchstart" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 7393ef1bf..9a0799706 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -227,6 +227,7 @@ module type T = sig (** {4 Mouse events} *) + val a_onauxclick : Xml.mouse_event_handler -> [> | `OnAuxClick] attrib val a_onclick : Xml.mouse_event_handler -> [> | `OnClick] attrib val a_oncontextmenu : Xml.mouse_event_handler -> [> | `OnContextMenu] attrib val a_ondblclick : Xml.mouse_event_handler -> [> | `OnDblClick] attrib @@ -242,6 +243,25 @@ module type T = sig val a_onmouseover : Xml.mouse_event_handler -> [> | `OnMouseOver] attrib val a_onmousemove : Xml.mouse_event_handler -> [> | `OnMouseMove] attrib val a_onmouseout : Xml.mouse_event_handler -> [> | `OnMouseOut] attrib + val a_onwheel : Xml.mouse_event_handler -> [> | `OnWheel] attrib + + (** {4 Pointer events} + + In the DOM, pointer events inherit from mouse events, so the + handlers use {!Xml.mouse_event_handler}. *) + + val a_onpointercancel : Xml.mouse_event_handler -> [> | `OnPointerCancel] attrib + val a_onpointerdown : Xml.mouse_event_handler -> [> | `OnPointerDown] attrib + val a_onpointerenter : Xml.mouse_event_handler -> [> | `OnPointerEnter] attrib + val a_onpointerleave : Xml.mouse_event_handler -> [> | `OnPointerLeave] attrib + val a_onpointermove : Xml.mouse_event_handler -> [> | `OnPointerMove] attrib + val a_onpointerout : Xml.mouse_event_handler -> [> | `OnPointerOut] attrib + val a_onpointerover : Xml.mouse_event_handler -> [> | `OnPointerOver] attrib + val a_onpointerup : Xml.mouse_event_handler -> [> | `OnPointerUp] attrib + val a_ongotpointercapture : + Xml.mouse_event_handler -> [> | `OnGotPointerCapture] attrib + val a_onlostpointercapture : + Xml.mouse_event_handler -> [> | `OnLostPointerCapture] attrib (** {4 Touch events} *) val a_ontouchstart : Xml.touch_event_handler -> [> | `OnTouchStart] attrib diff --git a/lib/html_types.mli b/lib/html_types.mli index 9c509ef85..db553f79d 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -328,6 +328,7 @@ type core = type events = [ | `OnAbort + | `OnAuxClick | `OnBlur | `OnCanPlay | `OnCanPlayThrough @@ -358,6 +359,17 @@ type events = | `OnMouseMove | `OnMouseOut | `OnMouseWheel + | `OnWheel + | `OnPointerCancel + | `OnPointerDown + | `OnPointerEnter + | `OnPointerLeave + | `OnPointerMove + | `OnPointerOut + | `OnPointerOver + | `OnPointerUp + | `OnGotPointerCapture + | `OnLostPointerCapture | `OnPause | `OnPlay | `OnPlaying diff --git a/test/test_html.ml b/test/test_html.ml index ec6974570..395fd6951 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,10 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "pointer events", + div ~a:[a_onpointerdown "d()"; a_onwheel "w()"; a_onauxclick "a()"] [], + "
" ; + "declarative shadow DOM", div [template ~a:[a_shadowrootmode `Open; a_shadowrootdelegatesfocus (); a_shadowrootclonable (); a_shadowrootserializable ()] diff --git a/test/test_ppx.ml b/test/test_ppx.ml index fba562018..f55f1e5e9 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,10 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "pointer events", + [[%html {|
|}]], + [div ~a:[a_onpointerdown "d()"; a_onpointerup "u()"; a_onwheel "w()"] [] ]; + "declarative shadow DOM", [[%html {||}]], [template ~a:[a_shadowrootmode `Closed; a_shadowrootclonable ()] From 406f8875bd1d9fa39c6d39fb3a05f17f5c92bfa6 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 10:04:02 +0200 Subject: [PATCH 20/24] Add missing global event handler attributes New global event handler attributes: onbeforeinput, onbeforematch, onbeforetoggle, oncancel, oncontextlost, oncontextrestored, oncopy, oncut, onpaste, oncuechange, onscrollend, onsecuritypolicyviolation, onslotchange and ontoggle. They all use the generic Xml.event_handler type, following the existing oninput and onchange precedents. Spec: https://html.spec.whatwg.org/multipage/webappapis.html#globaleventhandlers --- CHANGES.md | 5 +++++ lib/html_f.ml | 15 +++++++++++++++ lib/html_sigs.mli | 15 +++++++++++++++ lib/html_types.mli | 14 ++++++++++++++ test/test_html.ml | 6 ++++++ test/test_ppx.ml | 5 +++++ 6 files changed, 60 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index ca11cfd58..b774a3372 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -37,6 +37,11 @@ and `shadowrootserializable` * Add the pointer event handler attributes (`a_onpointerdown`, etc.), `a_onwheel` and `a_onauxclick` +* Add the missing global event handler attributes: `a_onbeforeinput`, + `a_onbeforematch`, `a_onbeforetoggle`, `a_oncancel`, `a_oncontextlost`, + `a_oncontextrestored`, `a_oncopy`, `a_oncut`, `a_onpaste`, + `a_oncuechange`, `a_onscrollend`, `a_onsecuritypolicyviolation`, + `a_onslotchange` and `a_ontoggle` * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index ecb938b76..7e79e57db 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -114,11 +114,20 @@ struct let a_onafterprint = Xml.event_handler_attrib "onafterprint" let a_onbeforeprint = Xml.event_handler_attrib "onbeforeprint" let a_onbeforeunload = Xml.event_handler_attrib "onbeforeunload" + let a_onbeforeinput = Xml.event_handler_attrib "onbeforeinput" + let a_onbeforematch = Xml.event_handler_attrib "onbeforematch" + let a_onbeforetoggle = Xml.event_handler_attrib "onbeforetoggle" let a_onblur = Xml.event_handler_attrib "onblur" + let a_oncancel = Xml.event_handler_attrib "oncancel" let a_oncanplay = Xml.event_handler_attrib "oncanplay" let a_oncanplaythrough = Xml.event_handler_attrib "oncanplaythrough" let a_onchange = Xml.event_handler_attrib "onchange" let a_onclose = Xml.event_handler_attrib "onclose" + let a_oncontextlost = Xml.event_handler_attrib "oncontextlost" + let a_oncontextrestored = Xml.event_handler_attrib "oncontextrestored" + let a_oncopy = Xml.event_handler_attrib "oncopy" + let a_oncut = Xml.event_handler_attrib "oncut" + let a_oncuechange = Xml.event_handler_attrib "oncuechange" let a_ondurationchange = Xml.event_handler_attrib "ondurationchange" let a_onemptied = Xml.event_handler_attrib "onemptied" let a_onended = Xml.event_handler_attrib "onended" @@ -131,6 +140,7 @@ struct let a_oninvalid = Xml.event_handler_attrib "oninvalid" let a_onoffline = Xml.event_handler_attrib "onoffline" let a_ononline = Xml.event_handler_attrib "ononline" + let a_onpaste = Xml.event_handler_attrib "onpaste" let a_onpause = Xml.event_handler_attrib "onpause" let a_onplay = Xml.event_handler_attrib "onplay" let a_onplaying = Xml.event_handler_attrib "onplaying" @@ -143,15 +153,20 @@ struct let a_onredo = Xml.event_handler_attrib "onredo" let a_onresize = Xml.event_handler_attrib "onresize" let a_onscroll = Xml.event_handler_attrib "onscroll" + let a_onscrollend = Xml.event_handler_attrib "onscrollend" + let a_onsecuritypolicyviolation = + Xml.event_handler_attrib "onsecuritypolicyviolation" let a_onseeked = Xml.event_handler_attrib "onseeked" let a_onseeking = Xml.event_handler_attrib "onseeking" let a_onselect = Xml.event_handler_attrib "onselect" let a_onshow = Xml.event_handler_attrib "onshow" + let a_onslotchange = Xml.event_handler_attrib "onslotchange" let a_onstalled = Xml.event_handler_attrib "onstalled" let a_onstorage = Xml.event_handler_attrib "onstorage" let a_onsubmit = Xml.event_handler_attrib "onsubmit" let a_onsuspend = Xml.event_handler_attrib "onsuspend" let a_ontimeupdate = Xml.event_handler_attrib "ontimeupdate" + let a_ontoggle = Xml.event_handler_attrib "ontoggle" let a_onundo = Xml.event_handler_attrib "onundo" let a_onunload = Xml.event_handler_attrib "onunload" let a_onvolumechange = Xml.event_handler_attrib "onvolumechange" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index 9a0799706..a3932ceab 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -176,11 +176,20 @@ module type T = sig val a_onafterprint : Xml.event_handler -> [> | `OnAfterPrint] attrib val a_onbeforeprint : Xml.event_handler -> [> | `OnBeforePrint] attrib val a_onbeforeunload : Xml.event_handler -> [> | `OnBeforeUnload] attrib + val a_onbeforeinput : Xml.event_handler -> [> | `OnBeforeInput] attrib + val a_onbeforematch : Xml.event_handler -> [> | `OnBeforeMatch] attrib + val a_onbeforetoggle : Xml.event_handler -> [> | `OnBeforeToggle] attrib val a_onblur : Xml.event_handler -> [> | `OnBlur] attrib + val a_oncancel : Xml.event_handler -> [> | `OnCancel] attrib val a_oncanplay : Xml.event_handler -> [> | `OnCanPlay] attrib val a_oncanplaythrough : Xml.event_handler -> [> | `OnCanPlayThrough] attrib val a_onchange : Xml.event_handler -> [> | `OnChange] attrib val a_onclose : Xml.event_handler -> [> | `OnClose] attrib + val a_oncontextlost : Xml.event_handler -> [> | `OnContextLost] attrib + val a_oncontextrestored : Xml.event_handler -> [> | `OnContextRestored] attrib + val a_oncopy : Xml.event_handler -> [> | `OnCopy] attrib + val a_oncut : Xml.event_handler -> [> | `OnCut] attrib + val a_oncuechange : Xml.event_handler -> [> | `OnCueChange] attrib val a_ondurationchange : Xml.event_handler -> [> | `OnDurationChange] attrib val a_onemptied : Xml.event_handler -> [> | `OnEmptied] attrib val a_onended : Xml.event_handler -> [> | `OnEnded] attrib @@ -194,6 +203,7 @@ module type T = sig val a_onmousewheel : Xml.event_handler -> [> | `OnMouseWheel] attrib val a_onoffline : Xml.event_handler -> [> | `OnOffLine] attrib val a_ononline : Xml.event_handler -> [> | `OnOnLine] attrib + val a_onpaste : Xml.event_handler -> [> | `OnPaste] attrib val a_onpause : Xml.event_handler -> [> | `OnPause] attrib val a_onplay : Xml.event_handler -> [> | `OnPlay] attrib val a_onplaying : Xml.event_handler -> [> | `OnPlaying] attrib @@ -206,15 +216,20 @@ module type T = sig val a_onredo : Xml.event_handler -> [> | `OnRedo] attrib val a_onresize : Xml.event_handler -> [> | `OnResize] attrib val a_onscroll : Xml.event_handler -> [> | `OnScroll] attrib + val a_onscrollend : Xml.event_handler -> [> | `OnScrollEnd] attrib + val a_onsecuritypolicyviolation : + Xml.event_handler -> [> | `OnSecurityPolicyViolation] attrib val a_onseeked : Xml.event_handler -> [> | `OnSeeked] attrib val a_onseeking : Xml.event_handler -> [> | `OnSeeking] attrib val a_onselect : Xml.event_handler -> [> | `OnSelect] attrib val a_onshow : Xml.event_handler -> [> | `OnShow] attrib + val a_onslotchange : Xml.event_handler -> [> | `OnSlotChange] attrib val a_onstalled : Xml.event_handler -> [> | `OnStalled] attrib val a_onstorage : Xml.event_handler -> [> | `OnStorage] attrib val a_onsubmit : Xml.event_handler -> [> | `OnSubmit] attrib val a_onsuspend : Xml.event_handler -> [> | `OnSuspend] attrib val a_ontimeupdate : Xml.event_handler -> [> | `OnTimeUpdate] attrib + val a_ontoggle : Xml.event_handler -> [> | `OnToggle] attrib val a_onundo : Xml.event_handler -> [> | `OnUndo] attrib val a_onunload : Xml.event_handler -> [> | `OnUnload] attrib val a_onvolumechange : Xml.event_handler -> [> | `OnVolumeChange] attrib diff --git a/lib/html_types.mli b/lib/html_types.mli index db553f79d..480120f1c 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -329,13 +329,22 @@ type events = [ | `OnAbort | `OnAuxClick + | `OnBeforeInput + | `OnBeforeMatch + | `OnBeforeToggle | `OnBlur + | `OnCancel | `OnCanPlay | `OnCanPlayThrough | `OnChange | `OnClick | `OnClose | `OnContextMenu + | `OnContextLost + | `OnContextRestored + | `OnCopy + | `OnCut + | `OnCueChange | `OnDblClick | `OnDrag | `OnDragEnd @@ -370,6 +379,7 @@ type events = | `OnPointerUp | `OnGotPointerCapture | `OnLostPointerCapture + | `OnPaste | `OnPause | `OnPlay | `OnPlaying @@ -377,14 +387,18 @@ type events = | `OnRateChange | `OnReadyStateChange | `OnScroll + | `OnScrollEnd + | `OnSecurityPolicyViolation | `OnSeeked | `OnSeeking | `OnSelect | `OnShow + | `OnSlotChange | `OnStalled | `OnSubmit | `OnSuspend | `OnTimeUpdate + | `OnToggle | `OnTouchStart | `OnTouchEnd | `OnTouchMove diff --git a/test/test_html.ml b/test/test_html.ml index 395fd6951..b39c6db98 100644 --- a/test/test_html.ml +++ b/test/test_html.ml @@ -39,6 +39,12 @@ let html_elements = "html elements", tyxml_tests Html.[ div [a []], "
" ; + "global event handlers", + div ~a:[a_onbeforetoggle "b()"; a_ontoggle "t()"; a_oncopy "c()"; + a_onpaste "p()"; a_onscrollend "s()"] [], + "
" ; + "pointer events", div ~a:[a_onpointerdown "d()"; a_onwheel "w()"; a_onauxclick "a()"] [], "
" ; diff --git a/test/test_ppx.ml b/test/test_ppx.ml index f55f1e5e9..46f1ac50b 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,11 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "global event handlers", + [[%html {|x|}]], + [dialog ~a:[a_oncancel "c()"; a_ontoggle "t()"; a_oncuechange "q()"] + [txt "x"] ]; + "pointer events", [[%html {|
|}]], [div ~a:[a_onpointerdown "d()"; a_onpointerup "u()"; a_onwheel "w()"] [] ]; From 08539d486e14b6fe995dd6c8a3e4f0fc2f05137e Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 10:05:27 +0200 Subject: [PATCH 21/24] Add window event handler attributes on body New attributes on body, following the onstorage and onpopstate precedents: onlanguagechange, onrejectionhandled and onunhandledrejection. Spec: https://html.spec.whatwg.org/multipage/webappapis.html#windoweventhandlers --- CHANGES.md | 2 ++ lib/html_f.ml | 5 +++++ lib/html_sigs.mli | 5 +++++ lib/html_types.mli | 3 +++ test/test_ppx.ml | 5 +++++ 5 files changed, 20 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index b774a3372..ea9614ef7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -42,6 +42,8 @@ `a_oncontextrestored`, `a_oncopy`, `a_oncut`, `a_onpaste`, `a_oncuechange`, `a_onscrollend`, `a_onsecuritypolicyviolation`, `a_onslotchange` and `a_ontoggle` +* Add the window event handler attributes `a_onlanguagechange`, + `a_onrejectionhandled` and `a_onunhandledrejection` on body * Add support for the `s` element * Add support for the `bdi` element * Add support for the `search` element diff --git a/lib/html_f.ml b/lib/html_f.ml index 7e79e57db..a80d1cd2b 100644 --- a/lib/html_f.ml +++ b/lib/html_f.ml @@ -136,6 +136,11 @@ struct let a_onformchange = Xml.event_handler_attrib "onformchange" let a_onforminput = Xml.event_handler_attrib "onforminput" let a_onhashchange = Xml.event_handler_attrib "onhashchange" + let a_onlanguagechange = Xml.event_handler_attrib "onlanguagechange" + let a_onrejectionhandled = + Xml.event_handler_attrib "onrejectionhandled" + let a_onunhandledrejection = + Xml.event_handler_attrib "onunhandledrejection" let a_oninput = Xml.event_handler_attrib "oninput" let a_oninvalid = Xml.event_handler_attrib "oninvalid" let a_onoffline = Xml.event_handler_attrib "onoffline" diff --git a/lib/html_sigs.mli b/lib/html_sigs.mli index a3932ceab..c0f51dcb1 100644 --- a/lib/html_sigs.mli +++ b/lib/html_sigs.mli @@ -198,6 +198,7 @@ module type T = sig val a_onformchange : Xml.event_handler -> [> | `OnFormChange] attrib val a_onforminput : Xml.event_handler -> [> | `OnFormInput] attrib val a_onhashchange : Xml.event_handler -> [> | `OnHashChange] attrib + val a_onlanguagechange : Xml.event_handler -> [> | `OnLanguageChange] attrib val a_oninput : Xml.event_handler -> [> | `OnInput] attrib val a_oninvalid : Xml.event_handler -> [> | `OnInvalid] attrib val a_onmousewheel : Xml.event_handler -> [> | `OnMouseWheel] attrib @@ -214,6 +215,10 @@ module type T = sig val a_onratechange : Xml.event_handler -> [> | `OnRateChange] attrib val a_onreadystatechange : Xml.event_handler -> [> | `OnReadyStateChange] attrib val a_onredo : Xml.event_handler -> [> | `OnRedo] attrib + val a_onrejectionhandled : + Xml.event_handler -> [> | `OnRejectionHandled] attrib + val a_onunhandledrejection : + Xml.event_handler -> [> | `OnUnhandledRejection] attrib val a_onresize : Xml.event_handler -> [> | `OnResize] attrib val a_onscroll : Xml.event_handler -> [> | `OnScroll] attrib val a_onscrollend : Xml.event_handler -> [> | `OnScrollEnd] attrib diff --git a/lib/html_types.mli b/lib/html_types.mli index 480120f1c..4d1955c37 100644 --- a/lib/html_types.mli +++ b/lib/html_types.mli @@ -1292,6 +1292,7 @@ type body_attrib = | `OnBeforePrint | `OnBeforeUnload | `OnHashChange + | `OnLanguageChange | `OnMessage | `OnOffLine | `OnOnLine @@ -1299,9 +1300,11 @@ type body_attrib = | `OnPageShow | `OnPopState | `OnRedo + | `OnRejectionHandled | `OnResize | `OnStorage | `OnUndo + | `OnUnhandledRejection | `OnUnload ] diff --git a/test/test_ppx.ml b/test/test_ppx.ml index 46f1ac50b..119c6aaa6 100644 --- a/test/test_ppx.ml +++ b/test/test_ppx.ml @@ -209,6 +209,11 @@ let basics = "ppx basics", HtmlTests.make Html.[ [[%html {|
fallback
|}]], [div [slot ~a:[a_name "s1"] [txt "fallback"]] ]; + "body window handlers", + [[%html {||}]], + [body ~a:[a_onlanguagechange "l()"; a_onrejectionhandled "r()"; + a_onunhandledrejection "u()"] [] ]; + "global event handlers", [[%html {|x|}]], [dialog ~a:[a_oncancel "c()"; a_ontoggle "t()"; a_oncuechange "q()"] From 2cb5b3e27e15fd2c19139e096040ceba0ad4d265 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Thu, 16 Jul 2026 10:11:09 +0200 Subject: [PATCH 22/24] Add JSX tests for the new attribute value parsers Exercise the popover, command, ol type and blocking parsers through the JSX front-end, following the autocomplete precedent. --- test/test_jsx.re | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/test/test_jsx.re b/test/test_jsx.re index 18a5d4a7c..481c5ba68 100644 --- a/test/test_jsx.re +++ b/test/test_jsx.re @@ -186,6 +186,34 @@ let attribs = ( [