summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Ziv Scully <ziv@mit.edu>2014-08-10 13:40:53 -0400
committerGravatar Ziv Scully <ziv@mit.edu>2014-08-10 13:40:53 -0400
commit4e6800f06759329f892ca8f40fcf50186b3785e1 (patch)
tree1d26e2a12c44d959919716f43d9de6940dc62729
parent60fbd47e8c5695e3c418f96bab81cb0321359f30 (diff)
Adds AJAX-oriented widget cpassword.
-rw-r--r--lib/js/urweb.js12
-rw-r--r--lib/ur/basis.urs2
-rw-r--r--src/css.sml3
-rw-r--r--src/monoize.sml29
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 (