Mercurial > urweb
changeset 940:e2be476673f2
Selection working, but switching it on isn't
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 15 Sep 2009 11:18:20 -0400 |
| parents | 38a376dc7401 |
| children | b8d7a47b8e0c |
| files | demo/more/dbgrid.urs demo/more/grid.ur demo/more/grid.urs demo/more/grid1.ur |
| diffstat | 4 files changed, 44 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- a/demo/more/dbgrid.urs Tue Sep 15 10:50:49 2009 -0400 +++ b/demo/more/dbgrid.urs Tue Sep 15 11:18:20 2009 -0400 @@ -110,4 +110,7 @@ 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
--- a/demo/more/grid.ur Tue Sep 15 10:50:49 2009 -0400 +++ b/demo/more/grid.ur Tue Sep 15 11:18:20 2009 -0400 @@ -48,18 +48,24 @@ [_] 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 @@ 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 @@ [_] 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 @@ 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 @@ 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
--- a/demo/more/grid.urs Tue Sep 15 10:50:49 2009 -0400 +++ b/demo/more/grid.urs Tue Sep 15 11:18:20 2009 -0400 @@ -39,7 +39,10 @@ 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
--- a/demo/more/grid1.ur Tue Sep 15 10:50:49 2009 -0400 +++ b/demo/more/grid1.ur Tue Sep 15 11:18:20 2009 -0400 @@ -53,7 +53,7 @@ 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 @@ 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>