Mercurial > urweb

comparison src/monoize.sml @ 2220:794017f378de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Ziv Scully <ziv@mit.edu>
date Mon, 24 Nov 2014 20:47:38 -0500
parents 365727ff68f4 f05fcb206571
children 278e10629ba1
comparison
equal deleted inserted replaced
2219:ff38b3e0cdfd 2220:794017f378de
3287 val (class, fm) = monoExp (env, st, fm) class 3287 val (class, fm) = monoExp (env, st, fm) class
3288 val (dynClass, fm) = monoExp (env, st, fm) dynClass 3288 val (dynClass, fm) = monoExp (env, st, fm) dynClass
3289 val (style, fm) = monoExp (env, st, fm) style 3289 val (style, fm) = monoExp (env, st, fm) style
3290 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle 3290 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
3291 3291
3292 val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script"] 3292 val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"]
3293 3293
3294 fun isSome (e, _) = 3294 fun isSome (e, _) =
3295 case e of 3295 case e of
3296 L'.ESome _ => true 3296 L'.ESome _ => true
3297 | _ => false 3297 | _ => false
3587 else if inTag "Table" then 3587 else if inTag "Table" then
3588 "table" 3588 "table"
3589 else 3589 else
3590 "span" 3590 "span"
3591 3591
3592 fun cinput (fallback, dynamic) =
3593 case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3594 NONE =>
3595 let
3596 val (ts, fm) = tagStart "input"
3597 in
3598 ((L'.EStrcat (ts,
3599 strH (" type=\"" ^ fallback ^ "\" />")),
3600 loc), fm)
3601 end
3602 | SOME (_, src, _) =>
3603 let
3604 val sc = strcat [str (dynamic ^ "(exec("),
3605 (L'.EJavaScript (L'.Script, src), loc),
3606 str "))"]
3607 val sc = setAttrs sc
3608 in
3609 (strcat [str "<script type=\"text/javascript\">",
3610 sc,
3611 str "</script>"],
3612 fm)
3613 end
3614
3592 val baseAll as (base, fm) = 3615 val baseAll as (base, fm) =
3593 case tag of 3616 case tag of
3594 "body" => let 3617 "body" => let
3595 val onload = execify onload 3618 val onload = execify onload
3596 val onunload = execify onunload 3619 val onunload = execify onunload
3667 str "\")</script>"], 3690 str "\")</script>"],
3668 fm)) 3691 fm))
3669 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 3692 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
3670 raise Fail "No name passed to textbox tag")) 3693 raise Fail "No name passed to textbox tag"))
3671 | "password" => input "password" 3694 | "password" => input "password"
3695 | "email" => input "email"
3696 | "search" => input "search"
3697 | "url_" => input "url"
3698 | "tel" => input "tel"
3699 | "color" => input "color"
3700 | "number" => input "number"
3701 | "range" => input "range"
3702 | "date" => input "date"
3703 | "datetime" => input "datetime"
3704 | "datetime_local" => input "datetime-local"
3705 | "month" => input "month"
3706 | "week" => input "week"
3707 | "timeInput" => input "time"
3672 | "textarea" => 3708 | "textarea" =>
3673 (case targs of 3709 (case targs of
3674 [_, (L.CName name, _)] => 3710 [_, (L.CName name, _)] =>
3675 let 3711 let
3676 val (ts, fm) = tagStart "textarea" 3712 val (ts, fm) = tagStart "textarea"
3717 fm) 3753 fm)
3718 end 3754 end
3719 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 3755 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
3720 raise Fail "No name passed to lselect tag")) 3756 raise Fail "No name passed to lselect tag"))
3721 3757
3722 | "ctextbox" => 3758 | "ctextbox" => cinput ("text", "inp")
3723 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of 3759 | "cpassword" => cinput ("password", "password")
3724 NONE => 3760 | "cemail" => cinput ("email", "email")
3725 let 3761 | "csearch" => cinput ("search", "search")
3726 val (ts, fm) = tagStart "input" 3762 | "curl" => cinput ("url", "url")
3727 in 3763 | "ctel" => cinput ("tel", "tel")
3728 ((L'.EStrcat (ts, 3764 | "ccolor" => cinput ("color", "color")
3729 strH " type=\"text\" />"), 3765
3730 loc), fm) 3766 | "cnumber" => cinput ("number", "number")
3731 end 3767 | "crange" => cinput ("range", "range")
3732 | SOME (_, src, _) => 3768 | "cdate" => cinput ("date", "date")
3733 let 3769 | "cdatetime" => cinput ("datetime", "datetime")
3734 val sc = strcat [str "inp(exec(", 3770 | "cdatetime_local" => cinput ("datetime-local", "datetime_local")
3735 (L'.EJavaScript (L'.Script, src), loc), 3771 | "cmonth" => cinput ("month", "month")
3736 str "))"] 3772 | "cweek" => cinput ("week", "week")
3737 val sc = setAttrs sc 3773 | "ctime" => cinput ("time", "time")
3738 in 3774
3739 (strcat [str "<script type=\"text/javascript\">", 3775 | "ccheckbox" => cinput ("checkbox", "chk")
3740 sc,
3741 str "</script>"],
3742 fm)
3743 end)
3744
3745 | "cpassword" =>
3746 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3747 NONE =>
3748 let
3749 val (ts, fm) = tagStart "input"
3750 in
3751 ((L'.EStrcat (ts,
3752 strH " type=\"password\" />"),
3753 loc), fm)
3754 end
3755 | SOME (_, src, _) =>
3756 let
3757 val sc = strcat [str "password(exec(",
3758 (L'.EJavaScript (L'.Script, src), loc),
3759 str "))"]
3760 val sc = setAttrs sc
3761 in
3762 (strcat [str "<script type=\"text/javascript\">",
3763 sc,
3764 str "</script>"],
3765 fm)
3766 end)
3767
3768 | "ccheckbox" =>
3769 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3770 NONE =>
3771 let
3772 val (ts, fm) = tagStart "input type=\"checkbox\""
3773 in
3774 ((L'.EStrcat (ts,
3775 strH " />"),
3776 loc), fm)
3777 end
3778 | SOME (_, src, _) =>
3779 let
3780 val sc = strcat [str "chk(exec(",
3781 (L'.EJavaScript (L'.Script, src), loc),
3782 str "))"]
3783 val sc = setAttrs sc
3784 in
3785 (strcat [str "<script type=\"text/javascript\">",
3786 sc,
3787 str "</script>"],
3788 fm)
3789 end)
3790
3791 | "cselect" => 3776 | "cselect" =>
3792 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of 3777 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3793 NONE => 3778 NONE =>
3794 let 3779 let
3795 val (xml, fm) = monoExp (env, st, fm) xml 3780 val (xml, fm) = monoExp (env, st, fm) xml