diff options
author | Ziv Scully <ziv@mit.edu> | 2014-08-10 13:40:53 -0400 |
---|---|---|
committer | Ziv Scully <ziv@mit.edu> | 2014-08-10 13:40:53 -0400 |
commit | 4e6800f06759329f892ca8f40fcf50186b3785e1 (patch) | |
tree | 1d26e2a12c44d959919716f43d9de6940dc62729 | |
parent | 60fbd47e8c5695e3c418f96bab81cb0321359f30 (diff) |
Adds AJAX-oriented widget cpassword.
-rw-r--r-- | lib/js/urweb.js | 12 | ||||
-rw-r--r-- | lib/ur/basis.urs | 2 | ||||
-rw-r--r-- | src/css.sml | 3 | ||||
-rw-r--r-- | src/monoize.sml | 29 |
4 files changed, 42 insertions, 4 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 76a900f7..5cc49fec 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1050,6 +1050,18 @@ function inp(s, name) { return x; } +function password(s, name) { + if (suspendScripts) + return; + + var x = input(document.createElement("input"), s, + function(x) { return function(v) { if (x.value != v) x.value = v; }; }, "password", name); + x.value = s.data; + x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) }; + + return x; +} + function selectValue(x) { if (x.options.length == 0) return ""; diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 8efed25b..39487aef 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -1013,6 +1013,8 @@ con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) => val ctextbox : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs) [] +val cpassword : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit, + Ontext = transaction unit] ++ boxAttrs) [] val button : cformTag ([Value = string] ++ boxAttrs) [] val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs) [] diff --git a/src/css.sml b/src/css.sml index 5db0c502..9e50686f 100644 --- a/src/css.sml +++ b/src/css.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -101,6 +101,7 @@ val tags = [("span", inline), ("submit", replaced), ("label", inline), ("ctextbox", replaced), + ("cpassword", replaced), ("button", replaced), ("ccheckbox", replaced), ("cselect", replaced), diff --git a/src/monoize.sml b/src/monoize.sml index a1f97184..6073a21f 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3276,14 +3276,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (rest, SOME value) | _ => (attrs, NONE)) | _ => (attrs, NONE) - + 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", "active", "script"] + val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script"] fun isSome (e, _) = case e of @@ -3736,6 +3736,29 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end) + | "cpassword" => + (case List.find (fn ("Source", _, _) => true | _ => false) attrs of + NONE => + let + val (ts, fm) = tagStart "input" + in + ((L'.EStrcat (ts, + strH " type=\"password\" />"), + loc), fm) + end + | SOME (_, src, _) => + let + val sc = strcat [str "password(exec(", + (L'.EJavaScript (L'.Script, src), loc), + str "))"] + val sc = setAttrs sc + in + (strcat [str "<script type=\"text/javascript\">", + sc, + str "</script>"], + fm) + end) + | "ccheckbox" => (case List.find (fn ("Source", _, _) => true | _ => false) attrs of NONE => @@ -4477,7 +4500,7 @@ fun monoDecl (env, fm) (all as (d, loc)) = (L'.TFfi ("Basis", "int"), loc) else un - + val e2 = (L'.EAbs ("$x", t, (L'.TFun (un, un), loc), (L'.EAbs ("$y", un, un, (L'.EApp ( |