diff options
Diffstat (limited to 'boudin.page.write.scm')
-rw-r--r-- | boudin.page.write.scm | 114 |
1 files changed, 114 insertions, 0 deletions
diff --git a/boudin.page.write.scm b/boudin.page.write.scm new file mode 100644 index 0000000..eb719b7 --- /dev/null +++ b/boudin.page.write.scm | |||
@@ -0,0 +1,114 @@ | |||
1 | (declare (module (boudin page write)) | ||
2 | (export feed-template | ||
3 | feed-writer | ||
4 | html-head | ||
5 | index-template | ||
6 | index-writer | ||
7 | post-template | ||
8 | post-writer | ||
9 | write-page)) | ||
10 | |||
11 | (import (atom) | ||
12 | (boudin page) | ||
13 | (boudin site) | ||
14 | (chicken file) | ||
15 | (chicken pathname) | ||
16 | (html-parser) | ||
17 | (sxml-serializer)) | ||
18 | |||
19 | (define (write-page pg) | ||
20 | (let ((outfile (page-output pg))) | ||
21 | (create-directory (pathname-directory outfile) | ||
22 | 'parents) | ||
23 | (with-output-to-file outfile | ||
24 | (lambda () | ||
25 | ((page-writer pg) | ||
26 | ((page-template pg) | ||
27 | pg)))))) | ||
28 | |||
29 | (define html-head | ||
30 | (make-parameter | ||
31 | `((meta (@ (charset "utf-8"))) | ||
32 | (meta (@ (name "viewport") | ||
33 | (content "initial-scale=1.0"))) | ||
34 | (link (@ (href "/style.css") | ||
35 | (rel "stylesheet")))))) | ||
36 | |||
37 | (define post-writer | ||
38 | (make-parameter | ||
39 | sxml-display-as-html)) | ||
40 | |||
41 | (define post-template | ||
42 | (make-parameter | ||
43 | (lambda (pg) | ||
44 | (let ((title (page-ref pg "title"))) | ||
45 | `(html (@ (lang "en-us")) | ||
46 | (head ,@(html-head) | ||
47 | (title ,(or title "[untitled]"))) | ||
48 | (body ,(if title `(h1 ,title) "") | ||
49 | ,@(cdr (page-content pg)))))))) | ||
50 | |||
51 | (define index-writer | ||
52 | (make-parameter | ||
53 | sxml-display-as-html)) | ||
54 | |||
55 | (define index-template | ||
56 | (make-parameter | ||
57 | (lambda (pgs) | ||
58 | `(html (@ (lang "en-us")) | ||
59 | (head ,@(html-head) | ||
60 | (title ,(site-name))) | ||
61 | (body (h1 ,(site-name)) | ||
62 | (ul ,@(map (lambda (pg) | ||
63 | `(li (a (@ (href ,(page-slug pg))) | ||
64 | ,(or (page-ref pg "title") | ||
65 | (page-slug pg))))) | ||
66 | ((site-sort) pgs)))))))) | ||
67 | |||
68 | (define feed-writer | ||
69 | (make-parameter | ||
70 | (lambda (sxml) | ||
71 | (serialize-sxml sxml | ||
72 | output: (current-output-port) | ||
73 | cdata-section-elements: '(atom:content) | ||
74 | ns-prefixes: | ||
75 | `((*default* . "http://www.w3.org/2005/Atom") | ||
76 | (*default* . "http://www.w3.org/1999/xhtml") | ||
77 | ,@(atom-ns-prefixes)) | ||
78 | allow-prefix-redeclarations: #t)))) | ||
79 | |||
80 | (define feed-template | ||
81 | (make-parameter | ||
82 | (lambda (pgs) | ||
83 | (make-atom-doc | ||
84 | (make-feed | ||
85 | title: (make-title (site-name)) | ||
86 | id: (site-host) | ||
87 | updated: (site-build-time) | ||
88 | authors: (list (make-author name: (site-author) | ||
89 | uri: (site-host))) | ||
90 | links: (list (make-link type: 'html | ||
91 | uri-language: "en" | ||
92 | uri: (site-host)) | ||
93 | (make-link relation: "self" | ||
94 | type: "application/atom+xml" | ||
95 | uri: (make-pathname | ||
96 | (site-host) "feed" "xml"))) | ||
97 | rights: (make-rights (force (site-rights))) | ||
98 | generator: (make-generator "Boudin" | ||
99 | uri: "https://git.acdw.net/boudin" | ||
100 | version: "rice") | ||
101 | entries: (map (lambda (pg) | ||
102 | (make-entry | ||
103 | title: (make-title | ||
104 | (or (page-ref pg "title") "[untitled]")) | ||
105 | links: (list (make-link type: 'html | ||
106 | uri: (page-url pg))) | ||
107 | id: (page-url pg) | ||
108 | updated: (page-updated pg) | ||
109 | ;;published: | ||
110 | content: (make-content | ||
111 | (sxml->html | ||
112 | (page-content pg)) | ||
113 | type: 'html))) | ||
114 | ((site-sort) pgs))))))) | ||