summaryrefslogtreecommitdiff
path: root/src/monoize.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2012-05-06 15:15:46 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2012-05-06 15:15:46 -0400
commit85341a176564ac3ce4e0a4ec4612262e2945660a (patch)
tree0b91d6fdd507e47f191183d49a4d5207ae515be7 /src/monoize.sml
parent9e25c1ce13add31807463c913129c24643944e38 (diff)
'dynStyle' pseudo-attribute
Diffstat (limited to 'src/monoize.sml')
-rw-r--r--src/monoize.sml72
1 files changed, 52 insertions, 20 deletions
diff --git a/src/monoize.sml b/src/monoize.sml
index fe2d67bd..564be889 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3033,19 +3033,21 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L.EApp (
(L.EApp (
(L.EApp (
- (L.ECApp (
- (L.ECApp (
+ (L.EApp (
+ (L.ECApp (
(L.ECApp (
(L.ECApp (
(L.ECApp (
(L.ECApp (
(L.ECApp (
(L.ECApp (
- (L.EFfi ("Basis", "tag"),
- _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
- class), _),
- dynClass), _),
- style), _),
+ (L.ECApp (
+ (L.EFfi ("Basis", "tag"),
+ _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
+ class), _),
+ dynClass), _),
+ style), _),
+ dynStyle), _),
attrs), _),
tag), _),
xml) =>
@@ -3104,15 +3106,22 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
val (class, fm) = monoExp (env, st, fm) class
val (dynClass, fm) = monoExp (env, st, fm) dynClass
val (style, fm) = monoExp (env, st, fm) style
+ val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
val dynamics = ["dyn", "ctextbox", "ccheckbox", "cselect", "coption", "ctextarea"]
- val () = case #1 dynClass of
- L'.ENone _ => ()
- | _ => if List.exists (fn x => x = tag) dynamics then
- E.errorAt loc ("Dynamic tag <" ^ tag ^ "> cannot be combined with 'dynClass' attribute; an additional <span> may be useful")
- else
- ()
+ fun isSome (e, _) =
+ case e of
+ L'.ESome _ => true
+ | _ => false
+
+ val () = if isSome dynClass orelse isSome dynStyle then
+ if List.exists (fn x => x = tag) dynamics then
+ E.errorAt loc ("Dynamic tag <" ^ tag ^ "> cannot be combined with 'dynClass' or 'dynStyle' attribute; an additional <span> may be useful")
+ else
+ ()
+ else
+ ()
fun tagStart tag' =
let
@@ -3587,13 +3596,36 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| _ => normal (tag, NONE)
in
case #1 dynClass of
- L'.ENone _ => baseAll
- | L'.ESome (_, dc) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(",
- (L'.EJavaScript (L'.Script, base), loc),
- str "),execD(",
- (L'.EJavaScript (L'.Script, dc), loc),
- str "))</script>"],
- fm)
+ L'.ENone _ =>
+ (case #1 dynStyle of
+ L'.ENone _ => baseAll
+ | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(",
+ (L'.EJavaScript (L'.Script, base), loc),
+ str "),null,execD(",
+ (L'.EJavaScript (L'.Script, ds), loc),
+ str "))</script>"],
+ fm)
+ | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
+ baseAll))
+ | L'.ESome (_, dc) =>
+ let
+ val e = case #1 dynStyle of
+ L'.ENone _ => str "null"
+ | L'.ESome (_, ds) => strcat [str "execD(",
+ (L'.EJavaScript (L'.Script, ds), loc),
+ str ")"]
+ | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
+ str "null")
+ in
+ (strcat [str "<script type=\"text/javascript\">dynClass(execD(",
+ (L'.EJavaScript (L'.Script, base), loc),
+ str "),execD(",
+ (L'.EJavaScript (L'.Script, dc), loc),
+ str "),",
+ e,
+ str ")</script>"],
+ fm)
+ end
| _ => (E.errorAt loc "Absence/presence of 'dynClass' unknown";
baseAll)
end