diff options
| -rw-r--r-- | haunt/builder/atom.scm | 38 |
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)))) |