Mercurial > gui

changeset 29:93140c5cc972

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Clean up dependencies and examples; add Style module
author Adam Chlipala <adam@chlipala.net>
date Sat, 12 May 2012 10:03:44 -0400
parents 7d0014542199
children c1f06342c81f
files calendar.ur examples/countdown.urp examples/css.ur examples/css.urp examples/datebox.ur examples/datebox.urp examples/datebox.urs examples/dateboxMain.ur examples/dateboxMain.urs examples/navtest.urp examples/popup.urp examples/remotePager.ur examples/remotePager.urp examples/remotePager.urs examples/remotePagerMain.ur examples/remotePagerMain.urs examples/togglepanel.ur examples/togglepanel.urp lib.urp style.ur style.urs
diffstat 21 files changed, 90 insertions(+), 60 deletions(-) [+]
line wrap: on
line diff
--- a/calendar.ur	Sun Feb 12 10:27:02 2012 -0500
+++ b/calendar.ur	Sat May 12 10:03:44 2012 -0400
@@ -130,7 +130,7 @@
                                                            Day = day}
                                        in
                                            cday <- SourceL.value t.Day;
-                                           return (if Record.equal thisDate cday then
+                                           return (if thisDate = cday then
                                                        <xml><td class={selday}>{[day]}</td></xml>
                                                    else case month of
                                                             This => <xml><td class={curday}
--- a/examples/countdown.urp	Sun Feb 12 10:27:02 2012 -0500
+++ b/examples/countdown.urp	Sat May 12 10:03:44 2012 -0400
@@ -1,4 +1,3 @@
-path META=../../meta
 library ..
 rewrite url Countdown/*
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/css.ur	Sat May 12 10:03:44 2012 -0400
@@ -0,0 +1,7 @@
+fun main () : transaction page = return <xml><body>
+  <div style={Style.prop1 "font-weight" "bold"}>Bold</div>
+  <div style={Style.prop "background" (Style.valu (bless "http://adam.chlipala.net/web.png") :: Style.valu "no-repeat" :: [])}>Image</div>
+  <div style={Style.props (("font-weight", Style.valu "bold" :: [])
+                               :: ("background", Style.valu (bless "http://adam.chlipala.net/web.png") :: Style.valu "no-repeat" :: [])
+                               :: [])}>Both</div>
+</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/css.urp	Sat May 12 10:03:44 2012 -0400
@@ -0,0 +1,5 @@
+library ..
+rewrite all Css/*
+allow url http://adam.chlipala.net/web.png
+
+css
--- a/examples/datebox.ur	Sun Feb 12 10:27:02 2012 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,14 +0,0 @@
-fun main () =
-    tm <- now;
-
-    dayCtl <- Datebox.create tm;
-
-    load <- return (Datebox.onChange dayCtl (fn d => alert (show d.Day)));
-
-    return
-        <xml>
-          <head><title>Datebox Example</title></head>
-          <body onload={load}>
-            {Gui.toXml dayCtl}
-          </body>
-        </xml>
--- a/examples/datebox.urp	Sun Feb 12 10:27:02 2012 -0500
+++ b/examples/datebox.urp	Sat May 12 10:03:44 2012 -0400
@@ -1,7 +1,6 @@
-path META=../../meta
 library ../
-rewrite url Datebox/*
+rewrite url DateboxMain/*
 allow url http://*
 prefix http://localhost:8080/
 
-datebox
+dateboxMain
--- a/examples/datebox.urs	Sun Feb 12 10:27:02 2012 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1 +0,0 @@
-val main : unit -> transaction page
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/dateboxMain.ur	Sat May 12 10:03:44 2012 -0400
@@ -0,0 +1,14 @@
+fun main () =
+    tm <- now;
+
+    dayCtl <- Datebox.create tm;
+
+    load <- return (Datebox.onChange dayCtl (fn d => alert (show d.Day)));
+
+    return
+        <xml>
+          <head><title>Datebox Example</title></head>
+          <body onload={load}>
+            {Gui.toXml dayCtl}
+          </body>
+        </xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/dateboxMain.urs	Sat May 12 10:03:44 2012 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page
--- a/examples/navtest.urp	Sun Feb 12 10:27:02 2012 -0500
+++ b/examples/navtest.urp	Sat May 12 10:03:44 2012 -0400
@@ -1,4 +1,3 @@
-path META=../../meta
 library ../
 rewrite url Navtest/*
 allow url http://*
--- a/examples/popup.urp	Sun Feb 12 10:27:02 2012 -0500
+++ b/examples/popup.urp	Sat May 12 10:03:44 2012 -0400
@@ -1,4 +1,3 @@
-path META=../../meta
 library ../
 rewrite url Popup/*
 allow url http://*
--- a/examples/remotePager.ur	Sun Feb 12 10:27:02 2012 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,30 +0,0 @@
-fun getPage pg =
-    return {Content = <xml><h2>This is page {[pg]}.</h2></xml>,
-            Available = 44}
-
-structure Pager = RemotePager.Make(struct
-                                       type errorMarker = {}
-                                       type pageGroup = {}
-                                       val initPage = fn _ => getPage 0
-                                       val getPage = fn _ pg =>
-                                                        tm <- now;
-                                                        if mod (toSeconds tm) 5 = 0 then
-                                                            return (RemotePager.Bad ())
-                                                        else
-                                                            p <- getPage pg;
-                                                            return (RemotePager.Good p)
-                                   end)
-
-fun main () =
-
-    pager <- Pager.create ();
-
-    return
-    <xml>
-      <head><title>RemotePager Example</title></head>
-      <body onload={Pager.onError pager (fn _ => alert "bad found")}>
-        <h1>RemotePager Example</h1>
-        <div>{Pager.panelXml pager}</div>
-        <div>{Pager.ctlXml pager}</div>
-      </body>
-    </xml>
--- a/examples/remotePager.urp	Sun Feb 12 10:27:02 2012 -0500
+++ b/examples/remotePager.urp	Sat May 12 10:03:44 2012 -0400
@@ -1,7 +1,6 @@
-path META=../../meta
 library ../
-rewrite url RemotePager/*
+rewrite url RemotePagerMain/*
 allow url http://*
 prefix http://localhost:8080/
 
-remotePager
+remotePagerMain
--- a/examples/remotePager.urs	Sun Feb 12 10:27:02 2012 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1 +0,0 @@
-val main : {} -> transaction page
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/remotePagerMain.ur	Sat May 12 10:03:44 2012 -0400
@@ -0,0 +1,30 @@
+fun getPage pg =
+    return {Content = <xml><h2>This is page {[pg]}.</h2></xml>,
+            Available = 44}
+
+structure Pager = RemotePager.Make(struct
+                                       type errorMarker = {}
+                                       type pageGroup = {}
+                                       val initPage = fn _ => getPage 0
+                                       val getPage = fn _ pg =>
+                                                        tm <- now;
+                                                        if mod (toSeconds tm) 5 = 0 then
+                                                            return (RemotePager.Bad ())
+                                                        else
+                                                            p <- getPage pg;
+                                                            return (RemotePager.Good p)
+                                   end)
+
+fun main () =
+
+    pager <- Pager.create ();
+
+    return
+    <xml>
+      <head><title>RemotePager Example</title></head>
+      <body onload={Pager.onError pager (fn _ => alert "bad found")}>
+        <h1>RemotePager Example</h1>
+        <div>{Pager.panelXml pager}</div>
+        <div>{Pager.ctlXml pager}</div>
+      </body>
+    </xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/remotePagerMain.urs	Sat May 12 10:03:44 2012 -0400
@@ -0,0 +1,1 @@
+val main : {} -> transaction page
--- a/examples/togglepanel.ur	Sun Feb 12 10:27:02 2012 -0500
+++ b/examples/togglepanel.ur	Sat May 12 10:03:44 2012 -0400
@@ -4,7 +4,7 @@
 val defaultContent : xbody = <xml><p>Here I am inside the panel.<br/><b>Default format</b></p></xml>
 val otherContent : xbody = <xml><p>Here I am inside the panel.<br/><b>Other format</b></p></xml>
 
-val otherFormat = fn [body ~ []] =>
+val otherFormat = fn [[Dyn] ~ body'] =>
                      {FormatPanel = fn ctl panel => <xml><span>A Custom {ctl} Format</span>{panel}</xml>,
                       OpenCtl = fn behaviour => <xml><a href={bless "http://#"} onclick={behaviour}>View</a></xml>,
                       CloseCtl = fn behaviour => <xml><a href={bless "http://#"} onclick={behaviour}>Hide</a></xml>}
--- a/examples/togglepanel.urp	Sun Feb 12 10:27:02 2012 -0500
+++ b/examples/togglepanel.urp	Sat May 12 10:03:44 2012 -0400
@@ -1,4 +1,3 @@
-path META=../../meta
 library ../
 rewrite url Togglepanel/*
 allow url http://*
--- a/lib.urp	Sun Feb 12 10:27:02 2012 -0500
+++ b/lib.urp	Sat May 12 10:03:44 2012 -0400
@@ -1,5 +1,3 @@
-library $META
-
 $/string
 $/list
 gui
@@ -16,3 +14,4 @@
 navigation
 clock
 remotePager
+style
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/style.ur	Sat May 12 10:03:44 2012 -0400
@@ -0,0 +1,16 @@
+class attr t = t -> css_value
+val attr_string = atom
+fun attr_int n = atom (show n)
+val attr_url = css_url
+fun valu [t] (f : attr t) (x : t) = f x
+
+fun prop1 [t] (f : attr t) (s : string) (x : t) =
+    oneProperty noStyle (value (property s) (f x))
+
+fun prop (s : string) (xs : list css_value) =
+    oneProperty noStyle (List.foldl (fn x p => value p x) (property s) xs)
+
+fun props (ls : list (string * list css_value)) =
+    List.foldl (fn (s, xs) acc =>
+                   oneProperty acc (List.foldl (fn x p => value p x) (property s) xs))
+               noStyle ls
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/style.urs	Sat May 12 10:03:44 2012 -0400
@@ -0,0 +1,9 @@
+class attr
+val attr_string : attr string
+val attr_int : attr int
+val attr_url : attr url
+val valu : t ::: Type -> attr t -> t -> css_value
+
+val prop1 : t ::: Type -> attr t -> string -> t -> css_style
+val prop : string -> list css_value -> css_style
+val props : list (string * list css_value) -> css_style