diff options
Diffstat (limited to '')
-rw-r--r-- | module/calp/entry-points/html.scm | 19 | ||||
-rw-r--r-- | module/html/view/small-calendar.scm | 19 |
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)) |