summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--haunt/builder/atom.scm38
1 files changed, 28 insertions, 10 deletions
diff --git a/haunt/builder/atom.scm b/haunt/builder/atom.scm
index acd74d4..1f90d24 100644
--- a/haunt/builder/atom.scm
+++ b/haunt/builder/atom.scm
@@ -1,5 +1,5 @@
;;; Haunt --- Static site generator for GNU Guile
-;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2015, 2022 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;;
;;; This file is part of Haunt.
@@ -30,6 +30,7 @@
#:use-module (ice-9 match)
#:use-module (sxml simple)
#:use-module (haunt artifact)
+ #:use-module (haunt builder blog)
#:use-module (haunt site)
#:use-module (haunt post)
#:use-module (haunt page)
@@ -137,14 +138,14 @@
"Convert date to RFC-3339 formatted string."
(date->string date "~Y-~m-~dT~H:~M:~SZ"))
-(define* (post->atom-entry site post #:key (blog-prefix ""))
+(define* (post->atom-entry site slug->file-name post)
"Convert POST into an Atom <entry> XML node."
(let ((uri (uri->string
(build-uri (site-scheme site)
#:host (site-domain site)
- #:path (string-append blog-prefix "/"
- (site-post-slug site post)
- ".html")))))
+ #:path (string-append "/"
+ (slug->file-name
+ (site-post-slug site post)))))))
`(entry
(title ,(post-ref post 'title))
(id ,uri)
@@ -172,7 +173,8 @@
(subtitle "Recent Posts")
(filter posts/reverse-chronological)
(max-entries 20)
- (blog-prefix ""))
+ (blog-prefix "")
+ (slug->file-name slug->file-name/default))
"Return a builder procedure that renders a list of posts as an Atom
feed. All arguments are optional:
@@ -180,6 +182,14 @@ FILE-NAME: The page file name
SUBTITLE: The feed subtitle
FILTER: The procedure called to manipulate the posts list before rendering
MAX-ENTRIES: The maximum number of posts to render in the feed"
+ ;; Preserve compatibility with older versions, for now.
+ (define slug->file-name*
+ (if (string=? blog-prefix "")
+ slug->file-name
+ (begin
+ (display "warning: #:blog-prefix keyword of 'atom-feed' procedure is deprecated, switch to #:slug->file-name\n")
+ (make-compat-slug->file-name blog-prefix))))
+
(lambda (site posts)
(let ((uri (uri->string
(build-uri (site-scheme site)
@@ -195,8 +205,7 @@ MAX-ENTRIES: The maximum number of posts to render in the feed"
"/" file-name))
(rel "self")))
(link (@ (href ,(site-domain site))))
- ,@(map (cut post->atom-entry site <>
- #:blog-prefix blog-prefix)
+ ,@(map (cut post->atom-entry site slug->file-name* <>)
(take-up-to max-entries (filter posts))))
sxml->xml*))))
@@ -204,13 +213,22 @@ MAX-ENTRIES: The maximum number of posts to render in the feed"
(prefix "feeds/tags")
(filter posts/reverse-chronological)
(max-entries 20)
- (blog-prefix ""))
+ (blog-prefix "")
+ (slug->file-name slug->file-name/default))
"Return a builder procedure that renders an atom feed for every tag
used in a post. All arguments are optional:
PREFIX: The directory in which to write the feeds
FILTER: The procedure called to manipulate the posts list before rendering
MAX-ENTRIES: The maximum number of posts to render in each feed"
+ ;; Preserve compatibility with older versions, for now.
+ (define slug->file-name*
+ (if (string=? blog-prefix "")
+ slug->file-name
+ (begin
+ (display "warning: #:blog-prefix keyword of 'atom-feeds-by-tag' procedure is deprecated, switch to #:slug->file-name\n")
+ (make-compat-slug->file-name blog-prefix))))
+
(lambda (site posts)
(let ((tag-groups (posts/group-by-tag posts)))
(map (match-lambda
@@ -219,6 +237,6 @@ MAX-ENTRIES: The maximum number of posts to render in each feed"
#:subtitle (string-append "Tag: " tag)
#:filter filter
#:max-entries max-entries
- #:blog-prefix blog-prefix)
+ #:slug->file-name slug->file-name*)
site posts)))
tag-groups))))