Modernize hidden and contenteditable attributes, undeprecate scope (breaking)

CHANGES.md

@@ -1,5 +1,15 @@
 # NEXT
 
+* Fix the development-profile build with recent compilers: anonymize
+  unused functor parameters in printer and functor signatures
+  (warning 67)
+* Breaking: the `hidden` attribute now takes an enumerated argument
+  ([`Hidden | `Until_found]) instead of no argument, and
+  `contenteditable` takes an enumerated argument
+  ([`True | `False | `Plaintext_only]) instead of a boolean, to
+  support the until-found and plaintext-only states
+* Undeprecate the `scope` attribute: it is valid in the HTML living
+  standard on table header cells
 * Fix typo `whitout` in type definition
 	(#324 by Martin @MBodin Bodin)
 * Add support for the clip-path presentation attribute

lib/html_f.ml

@@ -307,8 +307,8 @@ struct
 
   let a_challenge = string_attrib "challenge"
 
-  let a_contenteditable ce =
-    bool_attrib "contenteditable" ce
+  let a_contenteditable x =
+    user_attrib C.string_of_big_variant "contenteditable" x
 
   let a_contextmenu = string_attrib "contextmenu"
 
@@ -332,8 +332,8 @@ struct
 
   let a_formtarget = string_attrib "formtarget"
 
-  let a_hidden =
-    constant_attrib "hidden"
+  let a_hidden x =
+    user_attrib C.string_of_big_variant "hidden" x
 
   let a_high = float_attrib "high"
 
@@ -1001,6 +1001,10 @@ struct
     | `One -> "1"
     | `Yes -> "yes"
     | `No -> "no"
+    | `True -> "true"
+    | `False -> "false"
+    | `Plaintext_only -> "plaintext-only"
+    | `Until_found -> "until-found"
     | `Auto -> "auto"
     | `Circle -> "circle"
     | `Poly -> "poly"

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

lib/html_sigs.mli

@@ -282,7 +282,12 @@ module type T = sig
 
   val a_challenge : text wrap -> [> | `Challenge] attrib
 
-  val a_contenteditable : bool wrap -> [> | `Contenteditable] attrib
+  val a_contenteditable :
+    contenteditable_value wrap -> [> | `Contenteditable] attrib
+  (** A bare [contenteditable] attribute is equivalent to
+      [contenteditable="true"].
+      @see <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/contenteditable>
+      contenteditable attribute documentation on MDN *)
 
   val a_contextmenu : idref wrap -> [> | `Contextmenu] attrib
 
@@ -302,7 +307,11 @@ module type T = sig
 
   val a_formtarget : text wrap -> [> | `Formtarget] attrib
 
-  val a_hidden : unit -> [> | `Hidden] attrib
+  val a_hidden : hidden_value wrap -> [> | `Hidden] attrib
+  (** A bare [hidden] attribute is equivalent to [hidden="hidden"];
+      use [`Until_found] for the hidden-until-found state.
+      @see <https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/hidden>
+      hidden attribute documentation on MDN *)
 
   val a_high : float_number wrap -> [> | `High] attrib
 
@@ -602,8 +611,9 @@ module type T = sig
 
   val a_scope :
     [< | `Row | `Col | `Rowgroup | `Colgroup] wrap -> [> | `Scope] attrib
-  [@@ocaml.deprecated "Not supported in HTML5"]
-  (** @deprecated Not supported in HTML5 *)
+  (** Specifies the cells that a header cell applies to.
+      @see <https://developer.mozilla.org/en-US/docs/Web/HTML/Element/th#scope>
+      scope attribute documentation on MDN *)
 
   val a_summary : text wrap -> [> | `Summary] attrib
   [@@ocaml.deprecated "Move content elsewhere or to a <caption> child"]

lib/html_types.mli

@@ -2403,6 +2403,10 @@ type big_variant =
   | `Auto
   | `No
   | `Yes
+  | `True
+  | `False
+  | `Plaintext_only
+  | `Until_found
   | `Defer
   | `Verbatim
   | `Latin
@@ -2457,3 +2461,7 @@ type input_type =
 type script_type = [ `Javascript | `Module | `Mime of string ]
 
 type autocomplete_option = [ `On | `Off | `Tokens of string list]
+
+type contenteditable_value = [ `True | `False | `Plaintext_only ]
+
+type hidden_value = [ `Hidden | `Until_found ]

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

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."]
 

syntax/reflect/reflect.ml

@@ -193,6 +193,12 @@ let rec to_attribute_parser lang name ~loc = function
   | [[%type: referrerpolicy]] ->
     [%expr variant_or_empty "Empty"]
 
+  | [[%type: hidden_value]] ->
+    [%expr variant_or_empty "Hidden"]
+
+  | [[%type: contenteditable_value]] ->
+    [%expr variant_or_empty "True"]
+
   | [[%type: mediadesc]] ->
     [%expr commas (total_variant Html_types_reflected.mediadesc_token)]
 

test/test_jsx.re

@@ -91,8 +91,20 @@ let attribs = (
   HtmlTests.make(
     Html.[
       ( "unit",
+        [<input disabled="" />],
+        [input(~a=[a_disabled()], ())]
+      ),
+      ( "hidden bare",
         [<div hidden="" />],
-        [div(~a=[a_hidden()], [])]
+        [div(~a=[a_hidden(`Hidden)], [])]
+      ),
+      ( "hidden until-found",
+        [<div hidden="until-found" />],
+        [div(~a=[a_hidden(`Until_found)], [])]
+      ),
+      ( "contenteditable plaintext-only",
+        [<div contenteditable="plaintext-only" />],
+        [div(~a=[a_contenteditable(`Plaintext_only)], [])]
       ),
       ( "bool default",
         [<div draggable="true" />],

test/test_ppx.ml

@@ -224,12 +224,28 @@ let basics = "ppx basics", HtmlTests.make Html.[
 let attribs = "ppx attribs", HtmlTests.make Html.[
 
   "unit absent",
-  [[%html "<div hidden></div>"]],
-  [div ~a:[a_hidden ()] []] ;
+  [[%html "<input disabled/>"]],
+  [input ~a:[a_disabled ()] ()] ;
 
   "unit present",
-  [[%html "<div hidden=hidden></div>"]],
-  [div ~a:[a_hidden ()] []] ;
+  [[%html {|<input disabled="disabled"/>|}]],
+  [input ~a:[a_disabled ()] ()] ;
+
+  "hidden bare",
+  [[%html "<div hidden></div>"]],
+  [div ~a:[a_hidden `Hidden] []] ;
+
+  "hidden until-found",
+  [[%html "<div hidden=until-found></div>"]],
+  [div ~a:[a_hidden `Until_found] []] ;
+
+  "contenteditable bare",
+  [[%html "<div contenteditable></div>"]],
+  [div ~a:[a_contenteditable `True] []] ;
+
+  "contenteditable plaintext-only",
+  [[%html "<div contenteditable=plaintext-only></div>"]],
+  [div ~a:[a_contenteditable `Plaintext_only] []] ;
 
   "bool default",
   [[%html "<div draggable></div>"]],