# HG changeset patch # User Karn Kallio # Date 1313688197 16200 # Node ID 2e397d373289afcc9534a01bf743362885bec6f0 # Parent 8300d5f0dc19acc99c83ded61705418767844c2c Add RemotePager. diff -r 8300d5f0dc19 -r 2e397d373289 examples/remotePager.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/remotePager.ur Thu Aug 18 12:53:17 2011 -0430 @@ -0,0 +1,30 @@ +fun getPage pg = + return {Content =

This is page {[pg]}.

, + 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 + + RemotePager Example + alert "bad found")}> +

RemotePager Example

{Pager.panelXml pager}

{Pager.ctlXml pager}

+ + diff -r 8300d5f0dc19 -r 2e397d373289 examples/remotePager.urp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/remotePager.urp Thu Aug 18 12:53:17 2011 -0430 @@ -0,0 +1,7 @@ +path META=../../meta +library ../ +rewrite url RemotePager/* +allow url http://* +prefix http://localhost:8080/ + +remotePager diff -r 8300d5f0dc19 -r 2e397d373289 examples/remotePager.urs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/remotePager.urs Thu Aug 18 12:53:17 2011 -0430 @@ -0,0 +1,1 @@ +val main : {} -> transaction page diff -r 8300d5f0dc19 -r 2e397d373289 lib.urp --- a/lib.urp Sun Aug 07 14:38:52 2011 -0400 +++ b/lib.urp Thu Aug 18 12:53:17 2011 -0430 @@ -15,3 +15,4 @@ popupNav navigation clock +remotePager diff -r 8300d5f0dc19 -r 2e397d373289 remotePager.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/remotePager.ur Thu Aug 18 12:53:17 2011 -0430 @@ -0,0 +1,170 @@ +type formatCtl = {Width : int, + RangeCtl : $(mapU (transaction {} -> xbody) [First, Back, Next, Last]), + PageCtl : $(mapU (int -> transaction {} -> xbody) [Unsel, Sel]), + WrapPageCtl : xbody -> xbody, + Wrap : $(mapU xbody [First, Back, Pages, Next, Last]) -> xbody} + +style firstCtl +style backCtl +style nextCtl +style lastCtl +style curPage +style rangeCtl + +fun defaultFormatLbl {First = fLbl, Back = bLbl, Next = nLbl, Last = lLbl} = + let + fun mkLink c txt = fn a =>

{[txt]}

+ in + {Width = 5, + RangeCtl = {First = mkLink firstCtl fLbl, + Back = mkLink backCtl bLbl, + Next = mkLink nextCtl nLbl, + Last = mkLink lastCtl lLbl}, + PageCtl = {Unsel = fn n a =>

{[n + 1]}

, + Sel = fn n a =>

{[n + 1]}

}, + WrapPageCtl = fn x => x, + Wrap = fn {First = f, Back = b, Pages = p, Next = n, Last = l} =>

{f}{b}{p}{n}{l}} + end + +val defaultFormat = defaultFormatLbl {First = "<<", Back = "<", Next = ">", Last = ">>"} + +type pageData = {Content : xbody, Available : int} +datatype response err = Good of pageData | Bad of err + +functor Make(M : sig + type errorMarker + type pageGroup + val initPage : pageGroup -> transaction pageData + val getPage : pageGroup -> int -> transaction (response errorMarker) + end) : sig + type t + val createFmt : formatCtl -> M.pageGroup -> transaction t + val create : M.pageGroup -> transaction t + val onError : t -> (M.errorMarker -> transaction {}) -> transaction {} + val panelXml : t -> xbody + val ctlXml : t -> xbody +end = struct + open M + + type t = {FormatCtl : formatCtl, + PageGroup : pageGroup, + OnError : source (errorMarker -> transaction {}), + CurrentPage : source int, + RangeStart : source int, + Available : source int, + Content : source xbody} + + fun max x y = if x > y then x else y + fun min x y = if x < y then x else y + + fun loadPage t pg = + ret <- rpc (getPage t.PageGroup pg); + + case ret of + Good pageData => + let + val lst = max 0 (pageData.Available - 1) + val rgtRange = max 0 (pageData.Available - t.FormatCtl.Width) + in + if pg > lst then + loadPage t lst + else + rg <- get t.RangeStart; + (if rg > rgtRange then + set t.RangeStart rgtRange + else + return ()); + set t.CurrentPage pg; + set t.Content pageData.Content; + set t.Available pageData.Available + end + | Bad e => + handler <- get t.OnError; + handler e + + fun createFmt fmt grp = + pg <- source 0; + rg <- source 0; + + pageData <- initPage grp; + + av <- source (pageData.Available); + c <- source (pageData.Content); + + e <- source (fn _ => return {}); + + return {FormatCtl = fmt, + PageGroup = grp, + OnError = e, + CurrentPage = pg, + RangeStart = rg, + Available = av, + Content = c} + + val create = createFmt defaultFormat + + fun onError t f = + set t.OnError f + + fun panelXml t = + + + + + fun ctlXml t = + let + val fmt = t.FormatCtl + val width = fmt.Width + + fun floor pg = + return (max 0 pg) + + fun lastPage () = + av <- get t.Available; + floor (av - 1) + + fun rightRange () = + lst <- lastPage (); + floor (lst - width + 1) + + fun ceil pg = + rgt <- rightRange (); + return (min rgt pg) + + fun setRange startPage = + startPage <- ceil startPage; + startPage <- floor startPage; + set t.RangeStart startPage + + fun printLinks start cur available = + let + val wanted = start + width - 1 + val have = max 0 (available - 1) + val lst = min wanted have + + fun printLinks' n (acc : xbody) = + if n > lst then + acc + else + printLinks' (n + 1) + {acc}{(if n = cur then + fmt.PageCtl.Sel + else + fmt.PageCtl.Unsel) n (loadPage t n)} + in + printLinks' start + end + in + fmt.Wrap {First = fmt.RangeCtl.First (setRange 0), + Back = fmt.RangeCtl.Back (pg <- get t.RangeStart; setRange (pg - 1)), + Pages = fmt.WrapPageCtl + + + , + Next = fmt.RangeCtl.Next (pg <- get t.RangeStart; setRange (pg + 1)), + Last = fmt.RangeCtl.Last (pg <- rightRange (); setRange pg)} + end +end diff -r 8300d5f0dc19 -r 2e397d373289 remotePager.urs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/remotePager.urs Thu Aug 18 12:53:17 2011 -0430 @@ -0,0 +1,78 @@ +(* How to format the control section. *) +type formatCtl = {Width : int, + (* Maximum number of page options to show. *) + RangeCtl : $(mapU (transaction {} -> xbody) [First, Back, Next, Last]), + (* A group of four functions taking transactions which will be used to return + * an element having that transaction as onclick. Used to format the buttons + * controlling the selection of page options. First starts the options at the + * first page, Back starts the options one page lower, Next one page higher + * and Last has them finish at the final page. *) + PageCtl : $(mapU (int -> transaction {} -> xbody) [Unsel, Sel]), + (* Used to generate the xml bearing the page selection onclick action. Sel + * is used for the currently shown page and Unsel for the others. *) + WrapPageCtl : xbody -> xbody, + (* The sequence of page selection controls will be wrapped by this. *) + Wrap : $(mapU xbody [First, Back, Pages, Next, Last]) -> xbody + (* Draws the control by placing the individual controls in the holes. *)} + +style firstCtl +style backCtl +style nextCtl +style lastCtl +style curPage +style rangeCtl +(* Default styles. *) + +val defaultFormat : formatCtl +(* A reasonable default format. *) + +val defaultFormatLbl : $(mapU string [First, Back, Next, Last]) -> formatCtl +(* A default format with configurable labels on the page range controls. *) + +type pageData = {Content : xbody, Available : int} +(* Content and page count needed from the RPC. *) + +datatype response err = Good of pageData | Bad of err +(* The RPC gives us either page information or an error code. *) + +functor Make(M : sig + type errorMarker + (* Classifies the possible error conditions returned by the rpc call. *) + + type pageGroup + (* Classifies families of pages. *) + + val initPage : pageGroup -> transaction pageData + (* Used once to initialize the first page and page count. + * The RPC mechanism is not used and no error is possible. *) + + val getPage : pageGroup -> int -> transaction (response errorMarker) + (* RPC giving the content of a requested page as well as the count + * of how many pages are available. The first page should be given + * an index of 0. *) + end) : sig + + type t + (* The type of remote pagers. A remote pager is a + * widget which shows a list of available "pages" of + * information. The user can click on a page they want + * displayed, which is then fetched from the server via + * a RPC. *) + + val createFmt : formatCtl -> M.pageGroup -> transaction t + (* Get a remote pager widget with a custom format showing pages from the selected group. *) + + val create : M.pageGroup -> transaction t + (* Get a remote pager widget with the default format (partly customizable via CSS). *) + + val onError : t -> (M.errorMarker -> transaction {}) -> transaction {} + (* Allows setting an error handler. In case of an rpc error code return, this will + * be called with the received error marker. If not set, the default error handler + * does nothing. *) + + val panelXml : t -> xbody + (* Returns a piece of xml holding the contents of the current page. *) + + val ctlXml : t -> xbody + (* Returns a xml widget representing the clickable page selection controls. *) +end