Mercurial > gui
changeset 29:93140c5cc972
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