Mercurial > gui

comparison remotePager.ur @ 16:2e397d373289

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