--- /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 => <xml><li onclick={a} class={c}><a class={c} onclick={return ()}>{[txt]}</a></li></xml>
+    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 => <xml><li onclick={a}><a onclick={return ()}>{[n + 1]}</a></li></xml>,
+                    Sel = fn n a => <xml><li onclick={a} class={curPage}><a class={curPage} onclick={return ()}>{[n + 1]}</a></li></xml>},
+         WrapPageCtl = fn x => x,
+         Wrap = fn {First = f, Back = b, Pages = p, Next = n, Last = l} => <xml><ul class={rangeCtl}>{f}{b}{p}{n}{l}</ul></xml>}
+    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 =
+            <xml>
+              <dyn signal={signal t.Content}/>
+            </xml>
+
+    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)
+                                        <xml>{acc}{(if n = cur then
+                                                        fmt.PageCtl.Sel
+                                                    else
+                                                        fmt.PageCtl.Unsel) n (loadPage t n)}</xml>
+                in
+                    printLinks' start <xml/>
+                end
+        in
+            fmt.Wrap {First = fmt.RangeCtl.First (setRange 0),
+                      Back = fmt.RangeCtl.Back (pg <- get t.RangeStart; setRange (pg - 1)),
+                      Pages = fmt.WrapPageCtl
+                                  <xml>
+                                    <dyn signal={start <- signal t.RangeStart;
+                                                 av <- signal t.Available;
+                                                 cur <- signal t.CurrentPage;
+                                                 return (printLinks start cur av)}/>
+                                  </xml>,
+                      Next = fmt.RangeCtl.Next (pg <- get t.RangeStart; setRange (pg + 1)),
+                      Last = fmt.RangeCtl.Last (pg <- rightRange (); setRange pg)}
+        end
+end