Add rendering of standalone small-cal.

2 files changed, 37 insertions, 1 deletions

diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm
index 4f672109..abaa5f13 100644
--- a/module/calp/entry-points/html.scm
+++ b/module/calp/entry-points/html.scm
@@ -41,7 +41,7 @@
             (description "Directory where html files should end up. Default to " (b "./html")))
 
     (style (value #t) (predicate ,(lambda (v) (memv (string->symbol v)
-                                            '(wide week table))))
+                                            '(small wide week table))))
            (description "How the body of the HTML page should be layed out. "
                         (br) (b "week")
                         " gives a horizontally scrolling page with 7 elements, "
@@ -54,6 +54,11 @@
                         " is the same as week, but gives a full month.")
            )
 
+    (standalone
+     (description "Creates a standalone document instead of an HTML fragment "
+                  "for embedding in a larger page. Currently only applies to the "
+                  (i "small") "style"))
+
     (help (single-char #\h) (description "Print this help."))))
 
 
@@ -121,6 +126,8 @@
 
   (define target-directory (option-ref opts 'target "./html"))
 
+  (define standalone (option-ref opts 'standalone #f))
+
   (when (option-ref opts 'help #f)
     (print-arg-help opt-spec)
     (throw 'return)
@@ -130,6 +137,16 @@
   ;; while we save the documents as .xml.
 
   (case style
+
+    [(small)
+     (let ((fname (path-append target-directory (date->string start "small-~1.xml"))))
+       (with-output-to-file fname
+         (lambda ()
+           (sxml->xml
+            (re-root-static
+             ((@ (html view small-calendar) render-small-calendar)
+              start standalone))))))]
+
     [(wide)
      (common target-directory count start (date month: 1) render-calendar-wide)]
 
diff --git a/module/html/view/small-calendar.scm b/module/html/view/small-calendar.scm
new file mode 100644
index 00000000..e6378176
--- /dev/null
+++ b/module/html/view/small-calendar.scm
@@ -0,0 +1,19 @@
+(define-module (html view small-calendar)
+  :use-module ((html components) :select (xhtml-doc include-css))
+  :use-module ((html caltable) :select (cal-table))
+  :use-module ((datetime) :select (month- month+ remove-day date->string))
+  )
+
+(define-public (render-small-calendar month standalone)
+  (define table (cal-table
+                 start-date: month
+                 end-date: (remove-day (month+ month))
+                 next-start: month+
+                 prev-start: month-
+                 ))
+  (if standalone
+      (xhtml-doc
+       (head (title ,(date->string month "~1"))
+             ,(include-css "/static/smallcal.css"))
+       (body ,table))
+      table))