blob: 1a3a12e7649eff43a162d4b0d062e7ed5ff8c815 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
(declare (module (boudin page instances))
(export make-feed
make-index
make-post
post-path-transformers
post-text-transformers))
(import (boudin page write)
(boudin page)
(boudin site)
(boudin util)
(chicken pathname)
(html-parser)
(except (schmaltz)
render-specials
render-unprintables)
(schmaltz chicken)
(srfi 152))
(define (make-post path)
(let ((sxml ((apply o (post-text-transformers))
(with-input-from-file path slurp))))
(make-page sxml
((apply o (post-path-transformers)) path)
(post-template)
(post-writer)
(cons (cons "source" path)
(*extract-metadata sxml)))))
(define (*extract-metadata sxml)
(let loop ((tree sxml)
(acc '()))
(cond
((not (pair? tree))
(reverse acc))
((and (list? (car tree))
(eq? (caar tree) '*COMMENT*))
(loop (cdr tree)
(map (lambda (ln)
(let ((kv (string-split ln ":" 'infix 1)))
(cons (string-trim-both (car kv))
(string-trim (cdr kv)))))
(string-split (cadar tree) "\n"))))
((list? (car tree))
(loop (cdr tree)
(let ((subtree (loop (car tree) '())))
(if (null? subtree)
acc
(cons subtree acc)))))
(else (loop (cdr tree) acc)))))
(define (make-index pgs)
(make-page ((index-template) pgs)
(make-pathname (site-output) "index.html")
page-content
(index-writer)
`()))
(define (make-feed pgs)
(make-page ((feed-template) pgs)
(make-pathname (site-output) "feed.xml")
page-content
(feed-writer)
`()))
;; Configurables
(define post-text-transformers
(make-parameter
(list html->sxml
wrap-paragraphs
render-string->string)))
(define post-path-transformers
(make-parameter
(list (lambda (path)
(make-pathname (list (site-output)
(pathname-strip-extension path))
"index.html")))))
|
