Better blog format

1 files changed, 78 insertions, 0 deletions

diff --git a/org/blog/generate-xhtml.scm b/org/blog/generate-xhtml.scm
new file mode 100755
index 0000000..182db4c
--- /dev/null
+++ b/org/blog/generate-xhtml.scm
@@ -0,0 +1,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))