From 59598f42c16cf12e544e5bf2ce9c873fba94238e Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Wed, 6 Sep 2023 22:45:45 -0500
Subject: A newerer beginning

---
 boudin.page.write.scm | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 114 insertions(+)
 create mode 100644 boudin.page.write.scm

(limited to 'boudin.page.write.scm')

diff --git a/boudin.page.write.scm b/boudin.page.write.scm
new file mode 100644
index 0000000..eb719b7
--- /dev/null
+++ b/boudin.page.write.scm
@@ -0,0 +1,114 @@
+(declare (module (boudin page write))
+         (export feed-template
+                 feed-writer
+                 html-head
+                 index-template
+                 index-writer
+                 post-template
+                 post-writer
+                 write-page))
+
+(import (atom)
+        (boudin page)
+        (boudin site)
+        (chicken file)
+        (chicken pathname)
+        (html-parser)
+        (sxml-serializer))
+
+(define (write-page pg)
+  (let ((outfile (page-output pg)))
+    (create-directory (pathname-directory outfile)
+                      'parents)
+    (with-output-to-file outfile
+      (lambda ()
+        ((page-writer pg)
+         ((page-template pg)
+          pg))))))
+
+(define html-head
+  (make-parameter
+   `((meta (@ (charset "utf-8")))
+     (meta (@ (name "viewport")
+              (content "initial-scale=1.0")))
+     (link (@ (href "/style.css")
+              (rel "stylesheet"))))))
+
+(define post-writer
+  (make-parameter
+   sxml-display-as-html))
+
+(define post-template
+  (make-parameter
+   (lambda (pg)
+     (let ((title (page-ref pg "title")))
+       `(html (@ (lang "en-us"))
+              (head ,@(html-head)
+                    (title ,(or title "[untitled]")))
+              (body ,(if title `(h1 ,title) "")
+                    ,@(cdr (page-content pg))))))))
+
+(define index-writer
+  (make-parameter
+   sxml-display-as-html))
+
+(define index-template
+  (make-parameter
+   (lambda (pgs)
+     `(html (@ (lang "en-us"))
+            (head ,@(html-head)
+                  (title ,(site-name)))
+            (body (h1 ,(site-name))
+                  (ul ,@(map (lambda (pg)
+                               `(li (a (@ (href ,(page-slug pg)))
+                                       ,(or (page-ref pg "title")
+                                            (page-slug pg)))))
+                             ((site-sort) pgs))))))))
+
+(define feed-writer
+  (make-parameter
+   (lambda (sxml)
+     (serialize-sxml sxml
+                     output: (current-output-port)
+                     cdata-section-elements: '(atom:content)
+                     ns-prefixes:
+                     `((*default* . "http://www.w3.org/2005/Atom")
+                       (*default* . "http://www.w3.org/1999/xhtml")
+                       ,@(atom-ns-prefixes))
+                     allow-prefix-redeclarations: #t))))
+
+(define feed-template
+  (make-parameter
+   (lambda (pgs)
+     (make-atom-doc
+      (make-feed
+       title: (make-title (site-name))
+       id: (site-host)
+       updated: (site-build-time)
+       authors: (list (make-author name: (site-author)
+                                   uri: (site-host)))
+       links: (list (make-link type: 'html
+                               uri-language: "en"
+                               uri: (site-host))
+                    (make-link relation: "self"
+                               type: "application/atom+xml"
+                               uri: (make-pathname
+                                     (site-host) "feed" "xml")))
+       rights: (make-rights (force (site-rights)))
+       generator: (make-generator "Boudin"
+                                  uri: "https://git.acdw.net/boudin"
+                                  version: "rice")
+       entries: (map (lambda (pg)
+                       (make-entry
+                        title: (make-title
+                                (or (page-ref pg "title") "[untitled]"))
+                        links: (list (make-link type: 'html
+                                                uri: (page-url pg)))
+                        id: (page-url pg)
+                        updated: (page-updated pg)
+                        ;;published:
+                        content: (make-content
+                                  (sxml->html
+                                   (page-content pg))
+                                  type: 'html)))
+                     ((site-sort) pgs)))))))
-- 
cgit 1.4.1-21-gabe81