Mercurial > urweb

changeset 2047:6be31671911b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
'aria-*' attributes
author Adam Chlipala <adam@chlipala.net>
date Fri, 01 Aug 2014 11:43:44 -0400
parents ced78ef1c82f
children 4d64af730e35
files doc/manual.tex lib/ur/basis.urs src/monoize.sml src/urweb.grm tests/data_attr.ur
diffstat 5 files changed, 24 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/doc/manual.tex	Thu Jul 31 09:56:41 2014 -0400
+++ b/doc/manual.tex	Fri Aug 01 11:43:44 2014 -0400
@@ -2065,7 +2065,7 @@
 
 We will not list here the different HTML tags and related functions from the standard library.  They should be easy enough to understand from the code in \texttt{basis.urs}.  The set of tags in the library is not yet claimed to be complete for HTML standards.  Also note that there is currently no way for the programmer to add his own tags, without using the foreign function interface (Section \ref{ffi}).
 
-Some tags support HTML5 \texttt{data-*} attributes, which in Ur/Web are encoded as a single attribute $\mt{Data}$ with type $\mt{data\_attrs}$ encoding one or more attributes of this kind.  See \texttt{basis.urs} for details.  The usual HTML5 syntax for these attributes is supported by the Ur/Web parser as syntactic sugar.
+Some tags support HTML5 \texttt{data-*} attributes, which in Ur/Web are encoded as a single attribute $\mt{Data}$ with type $\mt{data\_attrs}$ encoding one or more attributes of this kind.  See \texttt{basis.urs} for details.  The usual HTML5 syntax for these attributes is supported by the Ur/Web parser as syntactic sugar, and the same mechanism is reused to support \texttt{aria-*} attributes.
 
 One last useful function is for aborting any page generation, returning some XML as an error message.  This function takes the place of some uses of a general exception mechanism.
 $$\begin{array}{l}
--- a/lib/ur/basis.urs	Thu Jul 31 09:56:41 2014 -0400
+++ b/lib/ur/basis.urs	Fri Aug 01 11:43:44 2014 -0400
@@ -797,9 +797,13 @@
 val script : unit
              -> tag [Code = transaction unit] head [] [] []
 
-(* Type for HTML5 "data-*" attributes. *)
+(* Type for HTML5 "data-*" and "aria-*" attributes. *)
+type data_attr_kind
+val data_kind : data_attr_kind
+val aria_kind : data_attr_kind
+
 type data_attr
-val data_attr : string (* Key *) -> string (* Value *) -> data_attr
+val data_attr : data_attr_kind -> string (* Key *) -> string (* Value *) -> data_attr
 (* This function will fail if the key doesn't meet HTML's lexical rules! *)
 val data_attrs : data_attr -> data_attr -> data_attr
 
--- a/src/monoize.sml	Thu Jul 31 09:56:41 2014 -0400
+++ b/src/monoize.sml	Fri Aug 01 11:43:44 2014 -0400
@@ -235,6 +235,7 @@
                   | L.CFfi ("Basis", "requestHeader") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "responseHeader") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "envVar") => (L'.TFfi ("Basis", "string"), loc)
+                  | L.CFfi ("Basis", "data_attr_kind") => (L'.TFfi ("Basis", "string"), loc)
                   | L.CFfi ("Basis", "data_attr") => (L'.TFfi ("Basis", "string"), loc)
 
                   | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) =>
@@ -3122,12 +3123,16 @@
                  fm)
             end
 
-          | L.EFfiApp ("Basis", "data_attr", [(s1, _), (s2, _)]) =>
+          | L.EFfi ("Basis", "data_kind") => ((L'.EPrim (Prim.String "data-"), loc), fm)
+          | L.EFfi ("Basis", "aria_kind") => ((L'.EPrim (Prim.String "aria-"), loc), fm)
+
+          | L.EFfiApp ("Basis", "data_attr", [(sk, _), (s1, _), (s2, _)]) =>
             let
+                val (sk, fm) = monoExp (env, st, fm) sk
                 val (s1, fm) = monoExp (env, st, fm) s1
                 val (s2, fm) = monoExp (env, st, fm) s2
             in
-                ((L'.EStrcat ((L'.EPrim (Prim.String "data-"), loc),
+                ((L'.EStrcat (sk,
                               (L'.EStrcat ((L'.EFfiApp ("Basis", "blessData", [(s1, (L'.TFfi ("Basis", "string"), loc))]), loc),
                                            (L'.EStrcat ((L'.EPrim (Prim.String "=\""), loc),
                                                         (L'.EStrcat ((L'.EFfiApp ("Basis", "attrifyString", [(s2, (L'.TFfi ("Basis", "string"), loc))]), loc),
--- a/src/urweb.grm	Thu Jul 31 09:56:41 2014 -0400
+++ b/src/urweb.grm	Fri Aug 01 11:43:44 2014 -0400
@@ -225,7 +225,7 @@
 
 datatype prop_kind = Delete | Update
 
-datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * exp
+datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * string * exp
 
 fun patType loc (p : pat) =
     case #1 p of
@@ -486,7 +486,7 @@
  | rpat of (string * pat) list * bool
  | ptuple of pat list
 
- | attrs of exp option * exp option * exp option * exp option * (string * exp) list * (con * exp) list
+ | attrs of exp option * exp option * exp option * exp option * (string * string * exp) list * (con * exp) list
  | attr of attr
  | attrv of exp
 
@@ -1652,9 +1652,10 @@
                                                             [] => #6 attrs
                                                           | data :: datas =>
                                                             let
-                                                                fun doOne (name, value) =
+                                                                fun doOne (kind, name, value) =
                                                                     let
                                                                         val e = (EVar (["Basis"], "data_attr", Infer), pos)
+                                                                        val e = (EApp (e, (EVar (["Basis"], kind ^ "_kind", Infer), pos)), pos)
                                                                         val e = (EApp (e, (EPrim (Prim.String name), pos)), pos)
                                                                     in
                                                                         (EApp (e, value), pos)
@@ -1725,7 +1726,9 @@
 					   | "dynStyle" => DynStyle attrv
 					   | _ =>
                                              if String.isPrefix "data-" SYMBOL then
-                                                 Data (String.extract (SYMBOL, 5, NONE), attrv)
+                                                 Data ("data", String.extract (SYMBOL, 5, NONE), attrv)
+                                             else if String.isPrefix "aria-" SYMBOL then
+                                                 Data ("aria", String.extract (SYMBOL, 5, NONE), attrv)
                                              else
                                                  let
                                                      val sym = makeAttr SYMBOL
--- a/tests/data_attr.ur	Thu Jul 31 09:56:41 2014 -0400
+++ b/tests/data_attr.ur	Fri Aug 01 11:43:44 2014 -0400
@@ -1,5 +1,5 @@
 fun dynd r = return <xml><body>
-  <div data={data_attr r.Attr r.Value}>How about that?</div>
+  <div data={data_attr data_kind r.Attr r.Value}>How about that?</div>
 </body></xml>
 
 fun main () : transaction page =
@@ -7,7 +7,7 @@
   a <- source "";
   v <- source "";
   return <xml><body>
-    <div data-foo="hi" data-bar="bye" data-baz="why">Whoa there, cowboy!</div>
+    <div data-foo="hi" aria-something="wow" data-bar="bye" data-baz="why">Whoa there, cowboy!</div>
 
     <hr/>
 
@@ -20,7 +20,7 @@
 
     <ctextbox source={a}/> = <ctextbox source={v}/>
     <button onclick={fn _ =>
-      a <- get a; v <- get v; set s <xml><div data={data_attr a v}>OHO!</div></xml>}/>
+      a <- get a; v <- get v; set s <xml><div data={data_attr data_kind a v}>OHO!</div></xml>}/>
     <hr/>
     <dyn signal={signal s}/>
   </body></xml>