From bb4091acb58f0724dca262bc137715f6ed882e5f Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 8 Sep 2023 08:55:10 -0500 Subject: 1.0, why not --- boudin.page.index.scm | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 boudin.page.index.scm (limited to 'boudin.page.index.scm') diff --git a/boudin.page.index.scm b/boudin.page.index.scm new file mode 100644 index 0000000..4ff3fd9 --- /dev/null +++ b/boudin.page.index.scm @@ -0,0 +1,95 @@ +(declare (module (boudin page index)) + (export make-index + index-template + index-writer + make-feed + feed-template + feed-writer)) + +(import (boudin page) + (boudin page write) + (boudin site) + (chicken pathname) + (html-parser) + (sxml-serializer) + (rename (atom) + (make-feed atom/make-feed))) + +(define (make-index pgs) + (make-page ((index-template) pgs) + (make-pathname (site-output) "index.html") + page-content + (index-writer) + `())) + +(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 (make-feed pgs) + (make-page ((feed-template) pgs) + (make-pathname (site-output) "feed.xml") + page-content + (feed-writer) + `())) + +(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 + (atom/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