diff options
| -rw-r--r-- | haunt/builder/blog.scm | 47 |
1 files changed, 31 insertions, 16 deletions
diff --git a/haunt/builder/blog.scm b/haunt/builder/blog.scm index 5087885..eb49efa 100644 --- a/haunt/builder/blog.scm +++ b/haunt/builder/blog.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. @@ -45,6 +45,8 @@ render-collection date->string* + slug->file-name/default + make-compat-slug->file-name blog)) @@ -123,6 +125,19 @@ "Convert DATE to human readable string." (date->string date "~a ~d ~B ~Y")) +(define* (slug->file-name/default slug) + (string-append slug ".html")) + +(define (make-compat-slug->file-name prefix) + ;; Strip leading/trailing slashes from prefix, if present. + (define (strip-leading-slash s) + (if (string-prefix? "/" s) (string-drop s 1) s)) + (define (strip-trailing-slash s) + (if (string-suffix? "/" s) (string-drop-right s 1) s)) + (let ((prefix* (strip-leading-slash (strip-trailing-slash prefix)))) + (lambda* (slug) + (string-append prefix* "/" slug ".html")))) + (define ugly-theme (theme #:name "Ugly" #:layout ugly-default-layout @@ -131,6 +146,7 @@ #:pagination-template ugly-default-pagination-template)) (define* (blog #:key (theme ugly-theme) prefix + (slug->file-name slug->file-name/default) (collections `(("Recent Posts" "index.html" ,posts/reverse-chronological))) posts-per-page) @@ -138,31 +154,30 @@ decorated by THEME, whose URLs start with PREFIX. If POSTS-PER-PAGE is specified, collections will be broken up into several pages with up to POSTS-PER-PAGE posts on each page." - (define (make-file-name base-name) - (if prefix - (string-append prefix "/" base-name) - base-name)) + ;; Preserve compatibility with older versions, for now. + (define slug->file-name* + (if (string? prefix) + (begin + (display "warning: #:prefix keyword of 'blog' procedure is deprecated, switch to #:slug->file-name\n") + (make-compat-slug->file-name prefix)) + slug->file-name)) (lambda (site posts) (define (post->page post) - (let ((base-name (string-append (site-post-slug site post) - ".html")) - (title (post-ref post 'title)) + (let ((title (post-ref post 'title)) (body ((theme-post-template theme) post))) - (serialized-artifact (make-file-name base-name) + (serialized-artifact (slug->file-name* (site-post-slug site post)) (with-layout theme site title body) sxml->html))) (define (paginate base-name items) (define (make-page-file-name i) - (make-file-name - ;; First page does not get a page number added to the file - ;; name. + ;; First page does not get a page number added to the file + ;; name. + (slug->file-name* (if (= 0 i) - (string-append base-name ".html") - (string-append base-name "-" - (number->string i) - ".html")))) + base-name + (string-append base-name "-" (number->string i))))) (define (make-page i items) (list (make-page-file-name i) (reverse items))) (let loop ((items items) |