diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-14 00:43:24 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-14 00:43:24 +0200 |
commit | ee058251b6be2c736b14e79217ff0c100708998c (patch) | |
tree | 3a1115cd9a667f3a2199b1fe9b2df1844c3c1ac9 /module | |
parent | Move ->string. (diff) | |
download | calp-ee058251b6be2c736b14e79217ff0c100708998c.tar.gz calp-ee058251b6be2c736b14e79217ff0c100708998c.tar.xz |
Fix /static/ links in generated html + extra.
Diffstat (limited to 'module')
-rw-r--r-- | module/output/html.scm | 25 | ||||
-rw-r--r-- | module/sxml/transformations.scm | 2 |
2 files changed, 16 insertions, 11 deletions
diff --git a/module/output/html.scm b/module/output/html.scm index f3ed6dc8..ca4bf83d 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -21,7 +21,11 @@ #:use-module ((vcomponent instance methods) :select (get-calendars get-event-set)) + + #:use-module ((ice-9 regex) :select (string-match regexp-substitute)) + #:use-module ((sxml simple) :select (sxml->xml)) + #:use-module ((sxml transformations) :select (href-transformer)) #:autoload (vcomponent instance) (global-event-object) ) @@ -40,7 +44,7 @@ (define (get-filename start-date) - (format #f "~a/html/~a.html" + (format #f "~a/html/~a.xml" (dirname (or (@ (global) basedir) ".")) (date->string start-date "~1"))) @@ -58,7 +62,14 @@ (lambda (start-date) (define fname (get-filename start-date)) (format (current-error-port) "Writing to [~a]~%" fname) - (with-output-to-file fname (lambda () (sxml->xml (proc calendars events))) )) + (with-output-to-file fname + (lambda () (sxml->xml + (href-transformer + (proc calendars events) + (lambda (str) + (aif (string-match "^/static" str) + (regexp-substitute #f it 'pre "static" 'post) + str))))))) (stream-take count (date-stream chunk-length start-date)) )) @@ -77,20 +88,13 @@ prev-start: (lambda (d) (date- d chunk-length)) )))) - - (define-public (html-table-main count start-date) (common count start-date (date month: 1) - (let* ((before current after - (month-days start-date))) - - ;; TODO this produces incorrect next and prev links - ;; TODO It actually produces almost all date links wrong + (let* ((before current after (month-days start-date))) (lambda (calendars events) (html-generate calendars: calendars events: events - ;; Appends for case where before or after is empty start-date: (car current) end-date: (date- (if (null? after) (last current) @@ -99,6 +103,7 @@ render-calendar: render-calendar-table next-start: month+ prev-start: month- + ;; Appends for case where before or after is empty pre-start: (car (append before current)) post-end: (last (append current after)) ))))) diff --git a/module/sxml/transformations.scm b/module/sxml/transformations.scm index e57c0433..037dc00f 100644 --- a/module/sxml/transformations.scm +++ b/module/sxml/transformations.scm @@ -28,7 +28,7 @@ (attribute-transformer tree `((href . ,(lambda (_ . content) - `(href ,@(transformer (string-concatenate content))) + `(href ,@(transformer (string-concatenate (map ->str content)))) ))))) (define-public (href-prefixer tree prefix) |