diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-11 23:43:19 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-12 00:09:58 +0200 |
| commit | d03d248b4e3ee2fc868508dcf0cb673ce51ef66c (patch) | |
| tree | 2927b171785ff72b8e243347cb6b9c73c8c377cf | |
| parent | Follow all instances of tagName with toLowerCase. (diff) | |
| download | calp-d03d248b4e3ee2fc868508dcf0cb673ce51ef66c.tar.gz calp-d03d248b4e3ee2fc868508dcf0cb673ce51ef66c.tar.xz | |
Add html parameter to routes.
Finally making the few previous commits worth something.
| -rw-r--r-- | module/calp/server/routes.scm | 32 |
1 files changed, 18 insertions, 14 deletions
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index 0876aed4..dfe0c238 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -13,7 +13,8 @@ :use-module ((web uri) :select (build-relative-ref)) :use-module ((web uri-query) :select (encode-query-parameters)) - :use-module (sxml simple) + :use-module ((sxml simple) :select (sxml->xml xml->sxml)) + :use-module ((sxml html) :select (sxml->html)) :use-module (sxml xpath) :use-module (sxml namespace) @@ -45,6 +46,12 @@ (with-output-to-string (lambda () (display "<!doctype html>\n") (sxml->xml sxml)))) +(define (content-type html?) + (if html? 'text/html 'application/xhtml+xml)) + +(define (sxml->output html?) + (if html? sxml->html sxml->xml)) + ;; @var{prefix} directory tree which should be exported @@ -141,14 +148,12 @@ ;; TODO any exception in this causes the whole page to fail ;; It would be much better if most of the page could still make it. - (GET "/week/:start-date.html" (start-date) - (let* ((start-date - (start-of-week (parse-iso-date start-date)))) - - (return `((content-type application/xhtml+xml)) + (GET "/week/:start-date.html" (start-date html) + (let* ((start-date (start-of-week (parse-iso-date start-date)))) + (return `((content-type ,(content-type html))) (with-output-to-string (lambda () - (sxml->xml + ((sxml->output html) (html-generate calendars: (get-calendars global-event-object) events: (get-event-set global-event-object) start-date: start-date @@ -159,13 +164,12 @@ intervaltype: 'week ))))))) - (GET "/month/:start-date.html" (start-date) + (GET "/month/:start-date.html" (start-date html) (let* ((start-date (start-of-month (parse-iso-date start-date)))) - - (return '((content-type application/xhtml+xml)) + (return `((content-type ,(content-type html))) (with-output-to-string (lambda () - (sxml->xml + ((sxml->output html) (html-generate calendars: (get-calendars global-event-object) events: (get-event-set global-event-object) start-date: start-date @@ -355,7 +359,7 @@ (prop event 'SUMMARY))))) )))))) - (GET "/search" (q p onlyfuture) + (GET "/search" (q p onlyfuture html) (define search-term (if (and q (not (string-null? q))) (if onlyfuture @@ -397,10 +401,10 @@ (set! error (format #f "~?~%" fmt arg)))))) - (return '((content-type application/xhtml+xml)) + (return `((content-type (content-type html))) (with-output-to-string (lambda () - (sxml->xml + ((sxml->output html) (search-result-page error (and=> q (negate string-null?)) |