changeset 917:321a2d6feb40

dragList demo working, save for Gecko load delay and highlighting
author Adam Chlipala <adamc@hcoop.net>
date Tue, 08 Sep 2009 10:55:49 -0400
parents b873feb3eb52
children 6a77c3e33908
files demo/more/dragList.ur demo/more/dragList.urp demo/more/out/dragList.css demo/more/prose lib/ur/monad.ur lib/ur/monad.urs src/c/urweb.c
diffstat 7 files changed, 49 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/demo/more/dragList.ur	Tue Sep 08 10:18:19 2009 -0400
+++ b/demo/more/dragList.ur	Tue Sep 08 10:55:49 2009 -0400
@@ -10,11 +10,12 @@
               onmouseover={di <- get draggingItem;
                            case di of
                                None => return ()
-                             | Some di => item1 <- get di;
-                               item2 <- get itemSource;
-                               set di item2;
-                               set itemSource item1}>
-              <dyn signal={s <- signal itemSource; return <xml>{[s]}</xml>}/>
+                             | Some di => original <- get di;
+                               movedOver <- get itemSource;
+                               set di movedOver;
+                               set itemSource original;
+                               set draggingItem (Some itemSource)}>
+              <dyn signal={Monad.mp (fn s => <xml>{[s]}</xml>) (signal itemSource)}/>
          </li></xml>) itemSources}
       </ul>
     </xml>
@@ -26,8 +27,13 @@
                                         :: "Sus scrofa ussuricus"
                                         :: "Sus scrofa cristatus"
                                         :: "Sus scrofa taiwanus" :: []);
-    return <xml><body>
-      {bears}
-      {beers}
-      {boars}
-    </body></xml>
+    return <xml>
+      <head>
+        <link rel="stylesheet" type="text/css" href="../../dragList.css"/>
+      </head>
+      <body>
+        {bears}
+        {beers}
+        {boars}
+      </body>
+    </xml>
--- a/demo/more/dragList.urp	Tue Sep 08 10:18:19 2009 -0400
+++ b/demo/more/dragList.urp	Tue Sep 08 10:55:49 2009 -0400
@@ -1,4 +1,5 @@
-debug
+allow url ../../dragList.css
 
 $/list
+$/monad
 dragList
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/more/out/dragList.css	Tue Sep 08 10:55:49 2009 -0400
@@ -0,0 +1,18 @@
+ul {
+  width: 200px; 
+  list-style-image: url(http://script.aculo.us/images/bullet.gif);
+}
+
+li {
+  color: #7E9E50;
+  font: 20px Georgia;
+  background-color: #ECF3E1; 
+  border:1px solid #C5DEA1;
+  cursor: move;
+  margin: 0px;
+}
+
+h2 {
+  font: 42px/30px Georgia, serif;
+  color: #7E9E50;
+}
--- a/demo/more/prose	Tue Sep 08 10:18:19 2009 -0400
+++ b/demo/more/prose	Tue Sep 08 10:55:49 2009 -0400
@@ -1,3 +1,7 @@
 <p>These are some extra demo applications written in <a href="http://www.impredicative.com/ur/">Ur/Web</a>.  See <a href="http://www.impredicative.com/ur/demo/">the main demo</a> for a more tutorial-like progression through language and library features.</p>
 
+dragList.urp
+
+This is an Ur/Web version of the "draggable lists" <a href="http://groups.inf.ed.ac.uk/links/examples/">demo program from Links</a>.
+
 grid1.urp
--- a/lib/ur/monad.ur	Tue Sep 08 10:18:19 2009 -0400
+++ b/lib/ur/monad.ur	Tue Sep 08 10:55:49 2009 -0400
@@ -8,6 +8,10 @@
 
 fun ignore [m ::: Type -> Type] (_ : monad m) [t] (v : m t) = x <- v; return ()
 
+fun mp [m] (_ : monad m) [a] [b] f m =
+    v <- m;
+    return (f v)
+
 fun foldR [K] [m] (_ : monad m) [tf :: K -> Type] [tr :: {K} -> Type]
           (f : nm :: Name -> t :: K -> rest :: {K}
                -> [[nm] ~ rest] =>
--- a/lib/ur/monad.urs	Tue Sep 08 10:18:19 2009 -0400
+++ b/lib/ur/monad.urs	Tue Sep 08 10:55:49 2009 -0400
@@ -4,6 +4,9 @@
 val ignore : m ::: (Type -> Type) -> monad m -> t ::: Type
              -> m t -> m unit
 
+val mp : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type
+         -> (a -> b) -> m a -> m b
+
 val foldR : K --> m ::: (Type -> Type) -> monad m
             -> tf :: (K -> Type)
             -> tr :: ({K} -> Type)
--- a/src/c/urweb.c	Tue Sep 08 10:18:19 2009 -0400
+++ b/src/c/urweb.c	Tue Sep 08 10:55:49 2009 -0400
@@ -2556,6 +2556,7 @@
     char *start = strstr(ctx->page.start, "<sc>");
     if (start) {
       buf_check(&ctx->page, buf_used(&ctx->page) - 4 + len);
+      start = strstr(ctx->page.start, "<sc>");
       memmove(start + len, start + 4, buf_used(&ctx->page) - (start - ctx->page.start) - 3);
       ctx->page.front += len - 4;
       memcpy(start, ctx->script_header, len);
@@ -2566,13 +2567,13 @@
     char *start = strstr(ctx->page.start, "<sc>");
     if (start) {
       buf_check(&ctx->page, buf_used(&ctx->page) - 4 + lenP);
+      start = strstr(ctx->page.start, "<sc>");
       memmove(start + lenP, start + 4, buf_used(&ctx->page) - (start - ctx->page.start) - 3);
       ctx->page.front += lenP - 4;
       memcpy(start, ctx->script_header, lenH);
       memcpy(start + lenH, "<script type=\"text/javascript\">", 31);
       memcpy(start + lenH + 31, ctx->script.start, len);
       memcpy(start + lenH + 31 + len, "</script>", 9);
-      printf("start=%s\n", start);
     }
   }
 }