Mercurial > urweb

comparison src/monoize.sml @ 2121:f89be9cd2087

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Support 'dynClass' and 'dynStyle' for <body>
author Adam Chlipala <adam@chlipala.net>
date Tue, 03 Mar 2015 15:55:00 -0500
parents 809bceab15a3
children e722bcc42eab e10881cd92da
comparison
equal deleted inserted replaced
2120:e3a79066380d 2121:f89be9cd2087
3265 if tag = "body" then 3265 if tag = "body" then
3266 findOnload (attrs, NONE, NONE, []) 3266 findOnload (attrs, NONE, NONE, [])
3267 else 3267 else
3268 (NONE, NONE, attrs) 3268 (NONE, NONE, attrs)
3269 3269
3270 val (class, fm) = monoExp (env, st, fm) class
3271 val (dynClass, fm) = monoExp (env, st, fm) dynClass
3272 val (style, fm) = monoExp (env, st, fm) style
3273 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
3274
3270 (* Special case for <button value=""> *) 3275 (* Special case for <button value=""> *)
3271 val (attrs, extraString) = case tag of 3276 val (attrs, extraString) = case tag of
3272 "button" => 3277 "button" =>
3273 (case List.partition (fn (x, _, _) => x = "Value") attrs of 3278 (case List.partition (fn (x, _, _) => x = "Value") attrs of
3274 ([(_, value, _)], rest) => 3279 ([(_, value, _)], rest) =>
3275 (rest, SOME value) 3280 (rest, SOME value)
3276 | _ => (attrs, NONE)) 3281 | _ => (attrs, NONE))
3282 | "body" =>
3283 (attrs,
3284 if (case (#1 dynClass, #1 dynStyle) of
3285 (L'.ESome _, _) => true
3286 | (_, L'.ESome _) => true
3287 | _ => false) then
3288 let
3289 fun jsify (e : L'.exp) =
3290 case #1 e of
3291 L'.ESome (_, ds) => strcat [str "execD(",
3292 (L'.EJavaScript (L'.Script, ds), loc),
3293 str ")"]
3294 | _ => str "null"
3295 in
3296 SOME (strcat [str "<script type=\"text/javascript\">bodyDynClass(",
3297 jsify dynClass,
3298 str ",",
3299 jsify dynStyle,
3300 str ")</script>"])
3301 end
3302 else
3303 NONE)
3277 | _ => (attrs, NONE) 3304 | _ => (attrs, NONE)
3278 3305
3279
3280 val (class, fm) = monoExp (env, st, fm) class
3281 val (dynClass, fm) = monoExp (env, st, fm) dynClass
3282 val (style, fm) = monoExp (env, st, fm) style
3283 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
3284 3306
3285 val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"] 3307 val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"]
3286 3308
3287 fun isSome (e, _) = 3309 fun isSome (e, _) =
3288 case e of 3310 case e of
3823 fm) 3845 fm)
3824 end) 3846 end)
3825 3847
3826 | "tabl" => normal ("table", NONE) 3848 | "tabl" => normal ("table", NONE)
3827 | _ => normal (tag, NONE) 3849 | _ => normal (tag, NONE)
3850
3851 val (dynClass', dynStyle') =
3852 case tag of
3853 "body" => ((L'.ENone dummyTyp, ErrorMsg.dummySpan),
3854 (L'.ENone dummyTyp, ErrorMsg.dummySpan))
3855 | _ => (dynClass, dynStyle)
3828 in 3856 in
3829 case #1 dynClass of 3857 case #1 dynClass' of
3830 L'.ENone _ => 3858 L'.ENone _ =>
3831 (case #1 dynStyle of 3859 (case #1 dynStyle' of
3832 L'.ENone _ => baseAll 3860 L'.ENone _ => baseAll
3833 | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(\"", 3861 | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(\"",
3834 str (pnode ()), 3862 str (pnode ()),
3835 str "\",execD(", 3863 str "\",execD(",
3836 (L'.EJavaScript (L'.Script, base), loc), 3864 (L'.EJavaScript (L'.Script, base), loc),
3840 fm) 3868 fm)
3841 | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown"; 3869 | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
3842 baseAll)) 3870 baseAll))
3843 | L'.ESome (_, dc) => 3871 | L'.ESome (_, dc) =>
3844 let 3872 let
3845 val e = case #1 dynStyle of 3873 val e = case #1 dynStyle' of
3846 L'.ENone _ => str "null" 3874 L'.ENone _ => str "null"
3847 | L'.ESome (_, ds) => strcat [str "execD(", 3875 | L'.ESome (_, ds) => strcat [str "execD(",
3848 (L'.EJavaScript (L'.Script, ds), loc), 3876 (L'.EJavaScript (L'.Script, ds), loc),
3849 str ")"] 3877 str ")"]
3850 | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown"; 3878 | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";