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