blob: 182db4c586bf08e5620cd7c607e2b850565beedc (
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
|
#! /usr/bin/guile \
-e main -s
!#
(use-modules (sxml simple))
;; Loads an entire text file into a string.
(define (read-entire-file file)
(call-with-input-file file
(lambda (fp)
(letrec ((read-characters
(lambda (fp)
(let ((character (read-char fp)))
(if (eof-object? character)
""
(string-append (string character)
(read-characters fp)))))))
(read-characters fp)))))
(define (format-article-filename file)
(let ((file-length (string-length file)))
(string-append (substring file
0
(- file-length 4))
".xhtml")))
;; Make a link for the article.
(define (make-article-list-link article)
(let ((title (cadr (list-ref article 0)))
(file (format-article-filename (cadr (list-ref article 6)))))
(string-append " <li><a href=\"" file "\">" title "</a></li>\n")))
;; Reads the article file and formats some stuff out.
(define (get-raw-article file)
(letrec ((article (read-entire-file file))
(article-open (string-contains article "<article>"))
(article-close (string-contains article "</article>")))
(substring article (+ article-open 9) article-close)))
(define (generate-article-xhtml article template)
(letrec ((title (cadr (list-ref article 0)))
(name (cadr (list-ref article 2)))
(pub-date (cadr (list-ref article 4)))
(file (cadr (list-ref article 6)))
(article-file (format-article-filename file))
(article-xhtml (get-raw-article file)))
(call-with-output-file article-file
(lambda (fp)
(format fp template title title pub-date article-xhtml)))))
;; Generates a xhtml blog index and articles from xml.
(define (generate-xhtml)
(let ((index-template (read-entire-file "blog-index-template.xhtml"))
(article-template (read-entire-file "article-template.xhtml"))
(article-list "<ul>\n")
(articles (call-with-input-file "articles.xml"
(lambda (fp)
(xml->sxml fp)))))
(for-each (lambda (article)
(when (list? article)
;; Create article file.
(generate-article-xhtml (cddr article) article-template)
;; Add a article link.
(set! article-list
(string-append article-list
(make-article-list-link
(cddr article))))))
(cdr (cadr articles)))
(set! article-list (string-append article-list " </ul>"))
;; Create blog index.
(call-with-output-file "index.xhtml"
(lambda (fp)
(format fp index-template article-list)))))
(define (main args)
(generate-xhtml))
|
