Mercurial > gui

comparison datebox.ur @ 3:8cab48efaff2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Seeking through months with Datebox
author Adam Chlipala <adam@chlipala.net>
date Tue, 08 Feb 2011 16:06:31 -0500
parents 33c83ae7c9af
children 377c11586999
comparison
equal deleted inserted replaced
2:33c83ae7c9af 3:8cab48efaff2
55 | _ => error <xml>Datebox: Bad weekday name</xml> 55 | _ => error <xml>Datebox: Bad weekday name</xml>
56 56
57 fun timeOfMonth my = 57 fun timeOfMonth my =
58 readError (show my.Year ^ "-" ^ pad 2 my.Month ^ "-01 00:00:00") 58 readError (show my.Year ^ "-" ^ pad 2 my.Month ^ "-01 00:00:00")
59 59
60 fun monthInfo this = 60 fun monthInfo' this =
61 let 61 let
62 val prev = if this.Month = 1 then 62 val prev = if this.Month = 1 then
63 {Month = 12, Year = this.Year - 1} 63 {Month = 12, Year = this.Year - 1}
64 else 64 else
65 {Month = this.Month-1, Year = this.Year} 65 {Month = this.Month-1, Year = this.Year}
80 PrevMonthName = timef "%b" (timeOfMonth prev), 80 PrevMonthName = timef "%b" (timeOfMonth prev),
81 ThisMonthName = timef "%b" (timeOfMonth this), 81 ThisMonthName = timef "%b" (timeOfMonth this),
82 NextMonthName = timef "%b" (timeOfMonth next)} 82 NextMonthName = timef "%b" (timeOfMonth next)}
83 end 83 end
84 84
85 fun monthInfo this = return (monthInfo' this)
86
85 val create = 87 val create =
86 tm <- now; 88 tm <- now;
87 year <- return (readError (timef "%Y" tm)); 89 year <- return (readError (timef "%Y" tm));
88 month <- return (readError (timef "%m" tm)); 90 month <- return (readError (timef "%m" tm));
89 month <- source (monthInfo {Month = month, Year = year}); 91 month <- source (monthInfo' {Month = month, Year = year});
90 day <- return (readError (timef "%d" tm)); 92 day <- return (readError (timef "%d" tm));
91 day <- source day; 93 day <- source day;
92 return {Month = month, Day = day} 94 return {Month = month, Day = day}
93 95
94 fun render (t : t) = <xml> 96 fun render (t : t) = <xml>
145 end 147 end
146 in 148 in
147 return <xml> 149 return <xml>
148 <table class={calendar}> 150 <table class={calendar}>
149 <tr> 151 <tr>
150 <th class={prev} colspan={2}>&lt;&lt; {[minf.PrevMonthName]}</th> 152 <th class={prev} colspan={2}
151 <th class={this} colspan={3}>{[minf.ThisMonthName]}</th> 153 onclick={minf <- rpc (monthInfo (if minf.ThisMonth = 1 then
152 <th class={next} colspan={2}>{[minf.NextMonthName]} >></th> 154 {Month = 12, Year = minf.Year - 1}
155 else
156 {Month = minf.ThisMonth - 1, Year = minf.Year}));
157 set t.Day 1;
158 set t.Month minf}>&lt;&lt; {[minf.PrevMonthName]}</th>
159 <th class={this} colspan={3}>{[minf.ThisMonthName]} {[minf.Year]}</th>
160 <th class={next} colspan={2}
161 onclick={minf <- rpc (monthInfo (if minf.ThisMonth = 12 then
162 {Month = 1, Year = minf.Year + 1}
163 else
164 {Month = minf.ThisMonth + 1, Year = minf.Year}));
165 set t.Day 1;
166 set t.Month minf}>{[minf.NextMonthName]} >></th>
153 </tr> 167 </tr>
154 <tr class={weekday}> <th>M</th> <th>Tu</th> <th>W</th> <th>Th</th> <th>F</th> <th>Sa</th> <th>Su</th> </tr> 168 <tr class={weekday}> <th>M</th> <th>Tu</th> <th>W</th> <th>Th</th> <th>F</th> <th>Sa</th> <th>Su</th> </tr>
155 {rows minf.MondayMonth minf.MondayDay} 169 {rows minf.MondayMonth minf.MondayDay}
156 </table> 170 </table>
157 </xml> 171 </xml>
159 </xml> 173 </xml>
160 174
161 fun value t = 175 fun value t =
162 month <- signal t.Month; 176 month <- signal t.Month;
163 day <- signal t.Day; 177 day <- signal t.Day;
164 return (readError (show month.Year ^ "-" ^ pad 2 month.ThisMonth ^ "-" ^ pad 2 day ^ " 00:00:00")) 178 return {Year = month.Year, Month = month.ThisMonth, Day = day}