Mercurial > gui

annotate remotePager.ur @ 18:16447dc6a68c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Introduction of multi-parameter type class for gui components
author Ron de Bruijn <rmbruijn@gmail.com>
date Thu, 22 Sep 2011 19:24:01 +0200
parents 2e397d373289
children b5432d74841a
rev   line source
kkallio@16 1 type formatCtl = {Width : int,
kkallio@16 2 RangeCtl : $(mapU (transaction {} -> xbody) [First, Back, Next, Last]),
kkallio@16 3 PageCtl : $(mapU (int -> transaction {} -> xbody) [Unsel, Sel]),
kkallio@16 4 WrapPageCtl : xbody -> xbody,
kkallio@16 5 Wrap : $(mapU xbody [First, Back, Pages, Next, Last]) -> xbody}
kkallio@16 6
kkallio@16 7 style firstCtl
kkallio@16 8 style backCtl
kkallio@16 9 style nextCtl
kkallio@16 10 style lastCtl
kkallio@16 11 style curPage
kkallio@16 12 style rangeCtl
kkallio@16 13
kkallio@16 14 fun defaultFormatLbl {First = fLbl, Back = bLbl, Next = nLbl, Last = lLbl} =
kkallio@16 15 let
kkallio@16 16 fun mkLink c txt = fn a => <xml><li onclick={a} class={c}><a class={c} onclick={return ()}>{[txt]}</a></li></xml>
kkallio@16 17 in
kkallio@16 18 {Width = 5,
kkallio@16 19 RangeCtl = {First = mkLink firstCtl fLbl,
kkallio@16 20 Back = mkLink backCtl bLbl,
kkallio@16 21 Next = mkLink nextCtl nLbl,
kkallio@16 22 Last = mkLink lastCtl lLbl},
kkallio@16 23 PageCtl = {Unsel = fn n a => <xml><li onclick={a}><a onclick={return ()}>{[n + 1]}</a></li></xml>,
kkallio@16 24 Sel = fn n a => <xml><li onclick={a} class={curPage}><a class={curPage} onclick={return ()}>{[n + 1]}</a></li></xml>},
kkallio@16 25 WrapPageCtl = fn x => x,
kkallio@16 26 Wrap = fn {First = f, Back = b, Pages = p, Next = n, Last = l} => <xml><ul class={rangeCtl}>{f}{b}{p}{n}{l}</ul></xml>}
kkallio@16 27 end
kkallio@16 28
kkallio@16 29 val defaultFormat = defaultFormatLbl {First = "<<", Back = "<", Next = ">", Last = ">>"}
kkallio@16 30
kkallio@16 31 type pageData = {Content : xbody, Available : int}
kkallio@16 32 datatype response err = Good of pageData | Bad of err
kkallio@16 33
kkallio@16 34 functor Make(M : sig
kkallio@16 35 type errorMarker
kkallio@16 36 type pageGroup
kkallio@16 37 val initPage : pageGroup -> transaction pageData
kkallio@16 38 val getPage : pageGroup -> int -> transaction (response errorMarker)
kkallio@16 39 end) : sig
kkallio@16 40 type t
kkallio@16 41 val createFmt : formatCtl -> M.pageGroup -> transaction t
kkallio@16 42 val create : M.pageGroup -> transaction t
kkallio@16 43 val onError : t -> (M.errorMarker -> transaction {}) -> transaction {}
kkallio@16 44 val panelXml : t -> xbody
kkallio@16 45 val ctlXml : t -> xbody
kkallio@16 46 end = struct
kkallio@16 47 open M
kkallio@16 48
kkallio@16 49 type t = {FormatCtl : formatCtl,
kkallio@16 50 PageGroup : pageGroup,
kkallio@16 51 OnError : source (errorMarker -> transaction {}),
kkallio@16 52 CurrentPage : source int,
kkallio@16 53 RangeStart : source int,
kkallio@16 54 Available : source int,
kkallio@16 55 Content : source xbody}
kkallio@16 56
kkallio@16 57 fun max x y = if x > y then x else y
kkallio@16 58 fun min x y = if x < y then x else y
kkallio@16 59
kkallio@16 60 fun loadPage t pg =
kkallio@16 61 ret <- rpc (getPage t.PageGroup pg);
kkallio@16 62
kkallio@16 63 case ret of
kkallio@16 64 Good pageData =>
kkallio@16 65 let
kkallio@16 66 val lst = max 0 (pageData.Available - 1)
kkallio@16 67 val rgtRange = max 0 (pageData.Available - t.FormatCtl.Width)
kkallio@16 68 in
kkallio@16 69 if pg > lst then
kkallio@16 70 loadPage t lst
kkallio@16 71 else
kkallio@16 72 rg <- get t.RangeStart;
kkallio@16 73 (if rg > rgtRange then
kkallio@16 74 set t.RangeStart rgtRange
kkallio@16 75 else
kkallio@16 76 return ());
kkallio@16 77 set t.CurrentPage pg;
kkallio@16 78 set t.Content pageData.Content;
kkallio@16 79 set t.Available pageData.Available
kkallio@16 80 end
kkallio@16 81 | Bad e =>
kkallio@16 82 handler <- get t.OnError;
kkallio@16 83 handler e
kkallio@16 84
kkallio@16 85 fun createFmt fmt grp =
kkallio@16 86 pg <- source 0;
kkallio@16 87 rg <- source 0;
kkallio@16 88
kkallio@16 89 pageData <- initPage grp;
kkallio@16 90
kkallio@16 91 av <- source (pageData.Available);
kkallio@16 92 c <- source (pageData.Content);
kkallio@16 93
kkallio@16 94 e <- source (fn _ => return {});
kkallio@16 95
kkallio@16 96 return {FormatCtl = fmt,
kkallio@16 97 PageGroup = grp,
kkallio@16 98 OnError = e,
kkallio@16 99 CurrentPage = pg,
kkallio@16 100 RangeStart = rg,
kkallio@16 101 Available = av,
kkallio@16 102 Content = c}
kkallio@16 103
kkallio@16 104 val create = createFmt defaultFormat
kkallio@16 105
kkallio@16 106 fun onError t f =
kkallio@16 107 set t.OnError f
kkallio@16 108
kkallio@16 109 fun panelXml t =
kkallio@16 110 <xml>
kkallio@16 111 <dyn signal={signal t.Content}/>
kkallio@16 112 </xml>
kkallio@16 113
kkallio@16 114 fun ctlXml t =
kkallio@16 115 let
kkallio@16 116 val fmt = t.FormatCtl
kkallio@16 117 val width = fmt.Width
kkallio@16 118
kkallio@16 119 fun floor pg =
kkallio@16 120 return (max 0 pg)
kkallio@16 121
kkallio@16 122 fun lastPage () =
kkallio@16 123 av <- get t.Available;
kkallio@16 124 floor (av - 1)
kkallio@16 125
kkallio@16 126 fun rightRange () =
kkallio@16 127 lst <- lastPage ();
kkallio@16 128 floor (lst - width + 1)
kkallio@16 129
kkallio@16 130 fun ceil pg =
kkallio@16 131 rgt <- rightRange ();
kkallio@16 132 return (min rgt pg)
kkallio@16 133
kkallio@16 134 fun setRange startPage =
kkallio@16 135 startPage <- ceil startPage;
kkallio@16 136 startPage <- floor startPage;
kkallio@16 137 set t.RangeStart startPage
kkallio@16 138
kkallio@16 139 fun printLinks start cur available =
kkallio@16 140 let
kkallio@16 141 val wanted = start + width - 1
kkallio@16 142 val have = max 0 (available - 1)
kkallio@16 143 val lst = min wanted have
kkallio@16 144
kkallio@16 145 fun printLinks' n (acc : xbody) =
kkallio@16 146 if n > lst then
kkallio@16 147 acc
kkallio@16 148 else
kkallio@16 149 printLinks' (n + 1)
kkallio@16 150 <xml>{acc}{(if n = cur then
kkallio@16 151 fmt.PageCtl.Sel
kkallio@16 152 else
kkallio@16 153 fmt.PageCtl.Unsel) n (loadPage t n)}</xml>
kkallio@16 154 in
kkallio@16 155 printLinks' start <xml/>
kkallio@16 156 end
kkallio@16 157 in
kkallio@16 158 fmt.Wrap {First = fmt.RangeCtl.First (setRange 0),
kkallio@16 159 Back = fmt.RangeCtl.Back (pg <- get t.RangeStart; setRange (pg - 1)),
kkallio@16 160 Pages = fmt.WrapPageCtl
kkallio@16 161 <xml>
kkallio@16 162 <dyn signal={start <- signal t.RangeStart;
kkallio@16 163 av <- signal t.Available;
kkallio@16 164 cur <- signal t.CurrentPage;
kkallio@16 165 return (printLinks start cur av)}/>
kkallio@16 166 </xml>,
kkallio@16 167 Next = fmt.RangeCtl.Next (pg <- get t.RangeStart; setRange (pg + 1)),
kkallio@16 168 Last = fmt.RangeCtl.Last (pg <- rightRange (); setRange pg)}
kkallio@16 169 end
kkallio@16 170 end