diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-09-15 11:18:20 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-09-15 11:18:20 -0400 |
commit | cbf9a437d79ca88f901d97c4d8881f7d4e711d2d (patch) | |
tree | 0ac2b69d65bddef052bbc62443b262cb5a230b4b | |
parent | af108dfe039a25905becdd58e6bd609e6e8cc6be (diff) |
Selection working, but switching it on isn't
-rw-r--r-- | demo/more/dbgrid.urs | 3 | ||||
-rw-r--r-- | demo/more/grid.ur | 39 | ||||
-rw-r--r-- | demo/more/grid.urs | 5 | ||||
-rw-r--r-- | demo/more/grid1.ur | 6 |
4 files changed, 44 insertions, 9 deletions
diff --git a/demo/more/dbgrid.urs b/demo/more/dbgrid.urs index e715542b..404d0f62 100644 --- a/demo/more/dbgrid.urs +++ b/demo/more/dbgrid.urs @@ -110,4 +110,7 @@ functor Make(M : sig val grid : transaction grid val sync : grid -> transaction unit val render : grid -> xbody + + val showSelection : grid -> source bool + val selection : grid -> signal (list ($(M.key ++ M.row))) end diff --git a/demo/more/grid.ur b/demo/more/grid.ur index 7e593791..56230c8e 100644 --- a/demo/more/grid.ur +++ b/demo/more/grid.ur @@ -48,18 +48,24 @@ functor Make(M : sig [_] M.folder cols M.cols) (@@Folder.mp [_] [_] M.folder) + type grid = {Cols : $(map fst M.cols), + Rows : Dlist.dlist {Row : source M.row, + Cols : source ($(map snd M.cols)), + Updating : source bool, + Selected : source bool}, + Selection : source bool} + fun addRow cols rows row = rowS <- source row; cols <- makeAll cols row; colsS <- source cols; ud <- source False; + sd <- source False; Monad.ignore (Dlist.append rows {Row = rowS, Cols = colsS, - Updating = ud}) + Updating = ud, + Selected = sd}) - type grid = {Cols : $(map fst M.cols), - Rows : Dlist.dlist {Row : source M.row, Cols : source ($(map snd M.cols)), Updating : source bool}} - val createMetas = Monad.mapR [colMeta M.row] [fst] (fn [nm :: Name] [p :: (Type * Type)] meta => meta.Initialize) [_] M.folder M.cols @@ -67,9 +73,10 @@ functor Make(M : sig val grid = cols <- createMetas; rows <- Dlist.create; - return {Cols = cols, Rows = rows} + sel <- source False; + return {Cols = cols, Rows = rows, Selection = sel} - fun sync {Cols = cols, Rows = rows} = + fun sync {Cols = cols, Rows = rows, ...} = Dlist.clear rows; init <- rpc M.list; List.app (addRow cols rows) init @@ -85,7 +92,7 @@ functor Make(M : sig [_] M.folder grid.Cols M.cols} </tr> - {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud} pos => + {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud, Selected = sd} pos => let val delete = Dlist.delete pos; @@ -135,6 +142,14 @@ functor Make(M : sig in <xml><tr class={tr}> <td> + <dyn signal={b <- signal grid.Selection; + return (if not b then + <xml><ccheckbox source={sd}/></xml> + else + <xml>No</xml>)}/> + </td> + + <td> <dyn signal={b <- signal ud; return (if b then <xml><button value="Save" onclick={save}/></xml> @@ -197,4 +212,14 @@ functor Make(M : sig addRow grid.Cols grid.Rows row}/> <button value="Refresh" onclick={sync grid}/> </xml> + + fun showSelection grid = grid.Selection + + fun selection grid = Dlist.foldl (fn {Row = rowS, Selected = sd, ...} ls => + sd <- signal sd; + if sd then + row <- signal rowS; + return (row :: ls) + else + return ls) [] grid.Rows end diff --git a/demo/more/grid.urs b/demo/more/grid.urs index a3fd76cc..51ec79c2 100644 --- a/demo/more/grid.urs +++ b/demo/more/grid.urs @@ -39,7 +39,10 @@ functor Make(M : sig val grid : transaction grid val sync : grid -> transaction unit val render : grid -> xbody - + + val showSelection : grid -> source bool + val selection : grid -> signal (list M.row) + style tabl style tr style th diff --git a/demo/more/grid1.ur b/demo/more/grid1.ur index edd5858d..bad193bb 100644 --- a/demo/more/grid1.ur +++ b/demo/more/grid1.ur @@ -53,7 +53,7 @@ open Make(struct Display = txt}, Dummy2 = {Initial = (), Step = fn _ _ => (), - Display = fn _ => <xml>-</xml>}, + Display = fn _ => <xml/>}, And = {Initial = True, Step = fn r b => r.C && b, Display = txt}} @@ -61,11 +61,15 @@ open Make(struct fun main () = grid <- grid; + set (showSelection grid) True; return <xml> <head> <link rel="stylesheet" type="text/css" href="../../grid.css"/> </head> <body onload={sync grid}> {render grid} + <hr/> + Selection: <dyn signal={ls <- selection grid; + return (List.mapX (fn r => <xml>{[r.Id]}; </xml>) ls)}/> </body> </xml> |