Mercurial > gui
changeset 3:8cab48efaff2
Seeking through months with Datebox
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Tue, 08 Feb 2011 16:06:31 -0500 |
parents | 33c83ae7c9af |
children | 377c11586999 |
files | datebox.ur datebox.urs |
diffstat | 2 files changed, 21 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/datebox.ur Tue Feb 08 15:51:42 2011 -0500 +++ b/datebox.ur Tue Feb 08 16:06:31 2011 -0500 @@ -57,7 +57,7 @@ fun timeOfMonth my = readError (show my.Year ^ "-" ^ pad 2 my.Month ^ "-01 00:00:00") -fun monthInfo this = +fun monthInfo' this = let val prev = if this.Month = 1 then {Month = 12, Year = this.Year - 1} @@ -82,11 +82,13 @@ NextMonthName = timef "%b" (timeOfMonth next)} end +fun monthInfo this = return (monthInfo' this) + val create = tm <- now; year <- return (readError (timef "%Y" tm)); month <- return (readError (timef "%m" tm)); - month <- source (monthInfo {Month = month, Year = year}); + month <- source (monthInfo' {Month = month, Year = year}); day <- return (readError (timef "%d" tm)); day <- source day; return {Month = month, Day = day} @@ -147,9 +149,21 @@ return <xml> <table class={calendar}> <tr> - <th class={prev} colspan={2}><< {[minf.PrevMonthName]}</th> - <th class={this} colspan={3}>{[minf.ThisMonthName]}</th> - <th class={next} colspan={2}>{[minf.NextMonthName]} >></th> + <th class={prev} colspan={2} + onclick={minf <- rpc (monthInfo (if minf.ThisMonth = 1 then + {Month = 12, Year = minf.Year - 1} + else + {Month = minf.ThisMonth - 1, Year = minf.Year})); + set t.Day 1; + set t.Month minf}><< {[minf.PrevMonthName]}</th> + <th class={this} colspan={3}>{[minf.ThisMonthName]} {[minf.Year]}</th> + <th class={next} colspan={2} + onclick={minf <- rpc (monthInfo (if minf.ThisMonth = 12 then + {Month = 1, Year = minf.Year + 1} + else + {Month = minf.ThisMonth + 1, Year = minf.Year})); + set t.Day 1; + set t.Month minf}>{[minf.NextMonthName]} >></th> </tr> <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> {rows minf.MondayMonth minf.MondayDay} @@ -161,4 +175,4 @@ fun value t = month <- signal t.Month; day <- signal t.Day; - return (readError (show month.Year ^ "-" ^ pad 2 month.ThisMonth ^ "-" ^ pad 2 day ^ " 00:00:00")) + return {Year = month.Year, Month = month.ThisMonth, Day = day}