Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[feature] parser, compiler, xhtml: boolean attributes ("checked", "se…

…lected"...) now accept boolean values:

*   <input type="checkbox" checked={true}>
    produces:
    <input type="checkbox" checked="checked">

*   <input type="checkbox" checked={false}>
    produces
    <input type="checkbox">
  • Loading branch information...
commit acf1c6a467d97091885a53bc97092290519c98b4 1 parent 91df471
@cedricss cedricss authored
View
5 CHANGELOG
@@ -1,6 +1,11 @@
Feature:
+ * Xhtml boolean attributes ("checked", "selected"...) now accept boolean values:
+ <input type="checkbox" checked={true}> produces <input type="checkbox" checked="checked">
+ <input type="checkbox" checked={false}> produces <input type="checkbox">
+
* New Dropbox database backend (experimental)
+
* Added is_module and opacapi info in the doc API JSON file (generated with --api)
Updated APIs:
View
2  compiler/opacapi/opacapi.ml
@@ -434,6 +434,8 @@ struct
let void = !! "void"
let xhtml = !! "xhtml"
+ let xhtml_bool_attribute_value = !! "xhtml_bool_attribute_value"
+ let xhtml_bool_attribute = !! "xhtml_bool_attribute"
let xhtml_event = !! "xhtml_event"
let xhtml_href = !! "xhtml_href"
let xml = !! "xml"
View
30 compiler/opalang/classic_syntax/parser_utils.ml
@@ -1187,6 +1187,9 @@ type 'b dom_tag_args = {
(* CSS styles -- special probably because we want to preprocess them *)
style : (string, 'b) expr option;
+ (* Boolean attributes like "checked", "selected" *)
+ bool_attributes : ((string, 'b) expr) list;
+
(* Namespace bindings of the form [xmlns:bar = "foo"] or [xmlns = "foo"] *)
xmlns_declaration: (string(*prefix, possibly empty*) * (string, 'b) expr(*unique uri*)) list;
@@ -1216,7 +1219,13 @@ let css_build1' s e = css_build (s,nlabel e) []
let hyphen_to_underscore s = String.replace s "-" "_"
let map_tuple4 f (a,b,c,d) = (f a, f b, f c, f d)
-
+let xhtml_bool_attribute name value =
+ let value = match value with
+ | Some v -> v
+ | None -> simple_record_expr "none" (nlabel name)
+ in
+ let value = coerce_name_expr value Opacapi.Types.xhtml_bool_attribute_value in
+ coerce_name_expr (record [("name", string2 name); ("value", value)]) Opacapi.Types.xhtml_bool_attribute
let to_handle (name : string * QmlLoc.annot) : (_,_) expr =
coerce_name_expr (record [(undecorate name, void (label name))]) Opacapi.Types.Dom.Event.kind
@@ -1230,6 +1239,7 @@ let hassoc_event name value =
let empty_args _label = { args = [];
class_ = None;
style = None;
+ bool_attributes = [];
events = [];
events_options = [];
events_expr = None;
@@ -1237,8 +1247,8 @@ let empty_args _label = { args = [];
href = None
}
-let is_empty_args {args=_; class_; style; events; events_options; events_expr; xmlns_declaration=_; href} =
- events = [] && events_options = [] && events_expr = None && href = None &&
+let is_empty_args {args=_; class_; style; bool_attributes; events; events_options; events_expr; xmlns_declaration=_; href} =
+ events = [] && events_options = [] && bool_attributes = [] && events_expr = None && href = None &&
class_ = None && style = None
let arg_default (o,label) =
@@ -1302,7 +1312,8 @@ let create_element (ns,tag) args children =
let record =
if xhtml_mode () && not (is_empty_args args) then (
let events = list_expr_of_expr_list args.events (nlabel tag)
- and events_options = list_expr_of_expr_list args.events_options (nlabel tag) in
+ and events_options = list_expr_of_expr_list args.events_options (nlabel tag)
+ and bool_attributes = list_expr_of_expr_list args.bool_attributes (nlabel tag) in
let class_ =
match args.class_ with
| None -> list_nil (label ns)
@@ -1314,11 +1325,12 @@ let create_element (ns,tag) args children =
let specific_attributes =
record [("class",class_);
("style",style);
+ ("bool_attributes", bool_attributes);
("events",appendlo events args.events_expr);
("events_options", events_options);
("href", match args.href with
| None -> coerce_name_expr (simple_record_expr "none" (nlabel tag)) Opacapi.Types.xhtml_href
- | Some s -> s)
+ | Some s -> s);
] in
record [("namespace",tag_ns);
("tag",unc2 string tag);
@@ -1381,8 +1393,14 @@ let add_arg src ((prefix,_),name) value =
let old = arg_default src in
{ old with args = (prefix, fst name, Option.default (unc2 string name) value) :: old.args }
+let add_bool_attribute src name value =
+ let name = match name with (s,pos) -> (String.lowercase s, pos) in
+ let old = arg_default src in
+ { old with bool_attributes = (xhtml_bool_attribute name value ) :: old.bool_attributes }
-
+let bool_record e =
+ let e = coerce_name_expr e Opacapi.Types.bool in
+ record [("bool", e)]
let add_event src name value =
let name = match name with (s,pos) -> (String.lowercase s, pos) in
View
6 compiler/opalang/classic_syntax/parser_utils.mli
@@ -411,6 +411,7 @@ type 'b dom_tag_args = {
args : (string * string * (string, 'b) expr) list;
class_ : (string, 'b) expr option;
style : (string, 'b) expr option;
+ bool_attributes : ((string, 'b) expr) list;
xmlns_declaration: (string * (string, 'b) expr) list;
events : ((string, 'b) expr) list;
events_expr : (string, 'b) expr option;
@@ -453,6 +454,11 @@ val add_arg :
'a dom_tag_args option * annot ->
(string * annot) * (string * annot) ->
(string, 'a) expr option -> 'a dom_tag_args
+val add_bool_attribute :
+ 'a dom_tag_args option * annot ->
+ string * annot ->
+ ((string, 'a) expr) option -> 'a dom_tag_args
+val bool_record : (string, [> `coerce ] as 'a) expr -> (string, 'a) expr
val to_handle : string * annot -> (string, [> `coerce ]) expr
val add_event :
'a dom_tag_args option * annot ->
View
19 compiler/opalang/classic_syntax/xml.trx
@@ -210,6 +210,7 @@ just_args <-
}}
/ xhtml_specific style_insensitive spacing "=" spacing style_value:v spacing args_option:tl {{ {(arg_default tl) with style = Some v} }}
/ xhtml_specific class_insensitive spacing "=" spacing class_value:v spacing args_option:tl {{ {(arg_default tl) with class_ = Some v} }}
+ / xhtml_specific boolean_attribute_incensitive:s spacing boolean_attribute_value?:v spacing args_option:tl {{ add_bool_attribute tl s v }}
/ xhtml_specific event_insensitive deco_sname:s spacing "=" spacing event_value:ev spacing args_option:tl {{ add_event tl s ev }}
/ xhtml_specific options_on_event_insensitive deco_sname:s spacing "=" spacing options_on_event_value:ev spacing args_option:tl {{ add_event_option tl s ev }}
/ xhtml_specific "events_unsafe" spacing "=" spacing opa_expr:e spacing args_option:tl {{ add_events tl e }}
@@ -535,6 +536,24 @@ class_value <-
/ opa_expr:e {{ e }}
#####################################################################################
+## BOOLEAN ATTRIBUTE ################################################################
+#####################################################################################
+
+boolean_attribute_incensitive = deco boolean_attribute_incensitive_aux
+boolean_attribute_incensitive_aux <-
+ / "checked"~ / "compact"~ / "declare"~ / "defer"~ / "disabled"~
+ / "ismap"~ / "multiple"~ / "nohref"~ / "noresize"~ / "noshade"~
+ / "nowrap"~ / "readonly"~ / "selected"~
+
+boolean_attribute_value <- "=" spacing boolean_attribute_value_aux:v {{ v }}
+
+boolean_attribute_value_aux <-
+ / squot deco_svalue:s squot {{ record ["string", string2 s] }}
+ / String_expr.string_with_opa:e spacing {{ record ["string", e] }}
+ / opa_expr:e {{ bool_record e }}
+ / deco_ename:s {{ record ["string", string2 s] }}
+
+#####################################################################################
## HANDLERS ASSIGNATION #############################################################
#####################################################################################
View
10 lib/stdlib/core/xhtml/dom.opa
@@ -2008,7 +2008,7 @@ Dom = {{
),
(_nsenv, tag, args, element, attribute ->
match attribute with
- | ~{class style events events_options href} ->
+ | ~{class style bool_attributes events events_options href} ->
//Handle classes
do List.iter(
class -> add_class_name(element, class),
@@ -2018,6 +2018,14 @@ Dom = {{
(| ~{name value} ->
add_style_application(cons, element, name, value)),
Css_printer.to_xhtml_style(style))
+ //Handle boolean attributes like "checked" or "selected"
+ do List.iter(~{name value} ->
+ match value with
+ | {string=value} -> set_attribute(element, name, value)
+ | {bool=b} -> if b then set_attribute(element, name, name) else void
+ | {none} -> set_attribute(element, name, name)
+ end,
+ bool_attributes)
//Handle events
do List.iter(
(|~{name value} ->
View
26 lib/stdlib/core/xhtml/xhtml.opa
@@ -82,10 +82,20 @@ type xhtml_href =
/ {typed:Uri.uri} /**Typed structure, we assume that it has already been checked, so no additional check.*/
/ {none} /**No URI*/
+@opacapi
+type xhtml_bool_attribute_value =
+ {string:string}
+/ {bool:bool}
+/ {none}
+
+@opacapi
+type xhtml_bool_attribute = { name:string value:xhtml_bool_attribute_value }
+
type xhtml_specific_attributes =
{
class:list(string)/**The classes of this element.*/
style:Css.properties /**The style properties of this element*/
+ bool_attributes:list(xhtml_bool_attribute)
events:list(handle_assoc(xhtml_event)) /**The event handlers associated with this element, as a list of pairs event name (_not_ attribute name) * event handler */
events_options:list(handle_assoc(list(Dom.event_option)))
href: xhtml_href/**Possibly a hyperlink.*/
@@ -180,7 +190,7 @@ Xmlns =
| {xml_dialect = {none}} as v -> {some = v}
| {xml_dialect = {some=_}} -> {none}
| ~{namespace tag args content xmlns specific_attributes={none}}
- | ~{namespace tag args content xmlns specific_attributes={some = {style=[] class=[] events=[] events_options=[] href={none}}}} ->
+ | ~{namespace tag args content xmlns specific_attributes={some = {style=[] class=[] bool_attributes=[] events=[] events_options=[] href={none}}}} ->
match List.map_while_opt(of_xhtml,content) with
| {none} -> {none}
| {some=content} ->
@@ -717,7 +727,7 @@ Xhtml =
(c -> "&#{c};")
)
- default_attributes = {style=[] class=[] events=[] events_options=[] href={none}} : xhtml_specific_attributes
+ default_attributes = {style=[] class=[] bool_attributes=[] events=[] events_options=[] href={none}} : xhtml_specific_attributes
createFragment : list(xhtml) -> xhtml = Xml.create_fragment
@@ -941,7 +951,7 @@ Xhtml =
do match specific_attributes with
| {none} -> void
- | {some=~{class style events events_options href}} ->
+ | {some=~{class style bool_attributes events events_options href}} ->
//Normalize tags
do (
match tag with
@@ -967,6 +977,14 @@ Xhtml =
| _ -> void
)
+ do List.iter(~{name value} ->
+ match value with
+ | {string=value} -> print_arg(sassoc(name,value))
+ | {bool=b} -> if b then print_arg(sassoc(name,name)) else void
+ | {none} -> print_arg(sassoc(name,name))
+ end,
+ bool_attributes)
+
(load_events, other_events) = List.partition((a -> match a.name:Dom.event.kind {ready} -> true | _ -> false), events)
(_, other_events_options) = List.partition((a -> match a.name:Dom.event.kind {ready} -> true | _ -> false), events_options)
@@ -1463,7 +1481,7 @@ Replaced by a default value.")
{a with value="/*unsafe attribute from a client*/"}
| _ -> a
, _)
- check_sargs({class=_ style=_ ~events events_options=_ href=_} as a) =
+ check_sargs({class=_ style=_ bool_attributes=_ ~events events_options=_ href=_} as a) =
{ a with events = List.map(
| ~{name value=~{value}} ->
do Log.warning("Xhtml",
Please sign in to comment.
Something went wrong with that request. Please try again.