Mercurial > urweb

comparison src/monoize.sml @ 2079:e1879ded8095

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Textual HTML5 AJAX widgets
author Adam Chlipala <adam@chlipala.net>
date Sun, 16 Nov 2014 15:03:29 -0500
parents 6d126af2e1cb
children f05fcb206571
comparison
equal deleted inserted replaced
2078:6d126af2e1cb 2079:e1879ded8095
3281 val (class, fm) = monoExp (env, st, fm) class 3281 val (class, fm) = monoExp (env, st, fm) class
3282 val (dynClass, fm) = monoExp (env, st, fm) dynClass 3282 val (dynClass, fm) = monoExp (env, st, fm) dynClass
3283 val (style, fm) = monoExp (env, st, fm) style 3283 val (style, fm) = monoExp (env, st, fm) style
3284 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle 3284 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
3285 3285
3286 val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script"] 3286 val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"]
3287 3287
3288 fun isSome (e, _) = 3288 fun isSome (e, _) =
3289 case e of 3289 case e of
3290 L'.ESome _ => true 3290 L'.ESome _ => true
3291 | _ => false 3291 | _ => false
3580 "tr" 3580 "tr"
3581 else if inTag "Table" then 3581 else if inTag "Table" then
3582 "table" 3582 "table"
3583 else 3583 else
3584 "span" 3584 "span"
3585
3586 fun cinput (fallback, dynamic) =
3587 case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3588 NONE =>
3589 let
3590 val (ts, fm) = tagStart "input"
3591 in
3592 ((L'.EStrcat (ts,
3593 strH (" type=\"" ^ fallback ^ "\" />")),
3594 loc), fm)
3595 end
3596 | SOME (_, src, _) =>
3597 let
3598 val sc = strcat [str (dynamic ^ "(exec("),
3599 (L'.EJavaScript (L'.Script, src), loc),
3600 str "))"]
3601 val sc = setAttrs sc
3602 in
3603 (strcat [str "<script type=\"text/javascript\">",
3604 sc,
3605 str "</script>"],
3606 fm)
3607 end
3585 3608
3586 val baseAll as (base, fm) = 3609 val baseAll as (base, fm) =
3587 case tag of 3610 case tag of
3588 "body" => let 3611 "body" => let
3589 val onload = execify onload 3612 val onload = execify onload
3724 fm) 3747 fm)
3725 end 3748 end
3726 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 3749 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
3727 raise Fail "No name passed to lselect tag")) 3750 raise Fail "No name passed to lselect tag"))
3728 3751
3729 | "ctextbox" => 3752 | "ctextbox" => cinput ("text", "inp")
3730 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of 3753 | "cpassword" => cinput ("password", "password")
3731 NONE => 3754 | "cemail" => cinput ("email", "email")
3732 let 3755 | "csearch" => cinput ("search", "search")
3733 val (ts, fm) = tagStart "input" 3756 | "curl" => cinput ("url", "url")
3734 in 3757 | "ctel" => cinput ("tel", "tel")
3735 ((L'.EStrcat (ts, 3758 | "ccolor" => cinput ("color", "color")
3736 strH " type=\"text\" />"), 3759
3737 loc), fm) 3760 | "ccheckbox" => cinput ("checkbox", "chk")
3738 end
3739 | SOME (_, src, _) =>
3740 let
3741 val sc = strcat [str "inp(exec(",
3742 (L'.EJavaScript (L'.Script, src), loc),
3743 str "))"]
3744 val sc = setAttrs sc
3745 in
3746 (strcat [str "<script type=\"text/javascript\">",
3747 sc,
3748 str "</script>"],
3749 fm)
3750 end)
3751
3752 | "cpassword" =>
3753 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3754 NONE =>
3755 let
3756 val (ts, fm) = tagStart "input"
3757 in
3758 ((L'.EStrcat (ts,
3759 strH " type=\"password\" />"),
3760 loc), fm)
3761 end
3762 | SOME (_, src, _) =>
3763 let
3764 val sc = strcat [str "password(exec(",
3765 (L'.EJavaScript (L'.Script, src), loc),
3766 str "))"]
3767 val sc = setAttrs sc
3768 in
3769 (strcat [str "<script type=\"text/javascript\">",
3770 sc,
3771 str "</script>"],
3772 fm)
3773 end)
3774
3775 | "ccheckbox" =>
3776 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3777 NONE =>
3778 let
3779 val (ts, fm) = tagStart "input type=\"checkbox\""
3780 in
3781 ((L'.EStrcat (ts,
3782 strH " />"),
3783 loc), fm)
3784 end
3785 | SOME (_, src, _) =>
3786 let
3787 val sc = strcat [str "chk(exec(",
3788 (L'.EJavaScript (L'.Script, src), loc),
3789 str "))"]
3790 val sc = setAttrs sc
3791 in
3792 (strcat [str "<script type=\"text/javascript\">",
3793 sc,
3794 str "</script>"],
3795 fm)
3796 end)
3797
3798 | "cselect" => 3761 | "cselect" =>
3799 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of 3762 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3800 NONE => 3763 NONE =>
3801 let 3764 let
3802 val (xml, fm) = monoExp (env, st, fm) xml 3765 val (xml, fm) = monoExp (env, st, fm) xml