# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1297199191 18000
# Node ID 8cab48efaff250823ec008064ba3b8a586ca636b
# Parent  33c83ae7c9af6462fa3e49bd709246da69d8148c
Seeking through months with Datebox

diff -r 33c83ae7c9af -r 8cab48efaff2 datebox.ur
--- 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}>&lt;&lt; {[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}>&lt;&lt; {[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}
diff -r 33c83ae7c9af -r 8cab48efaff2 datebox.urs
--- a/datebox.urs	Tue Feb 08 15:51:42 2011 -0500
+++ b/datebox.urs	Tue Feb 08 16:06:31 2011 -0500
@@ -2,7 +2,7 @@
 
 val create : transaction t
 val render : t -> xbody
-val value : t -> signal time
+val value : t -> signal {Year : int, Month : int, Day : int}
 
 style calendar
 style prev