blob: c214ff13e9a360f1bc96ff464f471def7bdadf7a (
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
|
#! /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)))
(cond
((eof-object? character) "")
(else (string-append (string character)
(read-characters fp))))))))
(read-characters fp)))))
;; Make a link for the article
(define (make-article-list-link article)
(let ((title (cadr (list-ref article 0)))
(name (cadr (list-ref article 2))))
(string-append " <li><a href=\"#" name "\">" 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)))
;; Makes a card for the article
(define (make-article-card article)
(let ((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))))
(string-append
"\n<table border=\"1\" width=\"60%\" bgcolor=\"#bebebe\">\n"
" <tr><td><h2 id=\"" name "\">" title "</h2>--- " pub-date
"</td></tr>\n"
" <tr><td>" (get-raw-article file) " </td></tr>\n"
"</table>\n")))
;; Generates a html blog from xml data
(define (generate-html)
(let ((template (read-entire-file "template.xhtml"))
(article-list "<ul>\n")
(article-cards "")
(articles (call-with-input-file "articles.xml"
(lambda (fp)
(xml->sxml fp)))))
(for-each (lambda (article)
(when (list? article)
;; Add a article link
(set! article-list
(string-append article-list
(make-article-list-link
(cddr article))))
;; Add article card
(set! article-cards
(string-append article-cards
(make-article-card
(cddr article))))))
(cdr (cadr articles)))
(set! article-list (string-append article-list "</ul>\n"))
(format #t template article-list article-cards)))
(define (main args)
(generate-html))
|
