diff options
| author | Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org> | 2025-06-12 16:43:34 +0200 |
|---|---|---|
| committer | Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org> | 2025-06-15 01:30:32 +0200 |
| commit | e614e7a8d8976f5f06d5dd8187c9f25baa1c2212 (patch) | |
| tree | faae02facdff52170387e64db800dd44fc2e2398 /website/builders/replicant-blog.scm | |
| parent | 038b435769ed8c527ecfb7948f589d7d0b8022c7 (diff) | |
| download | haunt-blog-e614e7a8d8976f5f06d5dd8187c9f25baa1c2212.tar.gz haunt-blog-e614e7a8d8976f5f06d5dd8187c9f25baa1c2212.tar.bz2 haunt-blog-e614e7a8d8976f5f06d5dd8187c9f25baa1c2212.zip | |
Move scheme modules inside modules/.
Signed-off-by: Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
Diffstat (limited to 'website/builders/replicant-blog.scm')
| -rw-r--r-- | website/builders/replicant-blog.scm | 214 |
1 files changed, 0 insertions, 214 deletions
diff --git a/website/builders/replicant-blog.scm b/website/builders/replicant-blog.scm deleted file mode 100644 index 1c7c525..0000000 --- a/website/builders/replicant-blog.scm +++ /dev/null @@ -1,214 +0,0 @@ -;;; Copyright © 2015 David Thompson <davet@gnu.org> -;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> -;;; Copyright © 2023-2024 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org> -;;; -;;; This file is based on haunt/builder/blog.scm, -;;; haunt/reader/commonmark.scm and tests/post.scm and from Haunt -;;; 2.6.0. -;;; -;;; This file is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation; either version 3 of the License, -;;; or (at your option) any later version. -;;; -;;; Haunt is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Haunt. If not, see <http://www.gnu.org/licenses/>. - -(define-module (website builders replicant-blog) - #:use-module (commonmark) - #:use-module (haunt artifact) - #:use-module (haunt builder assets) - #:use-module (haunt html) - #:use-module (haunt post) - #:use-module (haunt site) - #:use-module (haunt utils) - #:use-module (ice-9 match) - #:use-module (ice-9 rdelim) - #:use-module (rnrs base) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-19) - #:export (theme-collection-template) - #:export (make-theme) - #:export (render-collection) - #:export (render-post) - #:export (replicant-blog-website) - #:export (replicant-default-post-template) - #:export (replicant-layout) - #:export (replicant-theme) - #:export (theme) - #:export (theme-layout) - #:export (theme-name) - #:export (theme-post-template) - #:export (theme?)) - -(fluid-set! %default-port-encoding "UTF-8") - -(define-record-type <theme> - (make-theme name layout post-template collection-template) - theme? - (name theme-name) - (layout theme-layout) - (post-template theme-post-template) - (collection-template theme-collection-template)) - -(define (replicant-layout site title body) - `((doctype "html") - (head - (meta (@ (charset "utf-8"))) - (link - (@ (rel "stylesheet") - (href "static/twentyeleven-style-20231107.css"))) - (title ,(string-append title " - " (site-title site)))) - (body - (header - (img (@ (id "banner") - (src "static/replicant_banner_white.png") - (alt "Replicant banner"))) - (nav - (@ (id "access")) - (ul - (li (a (@ (href "https://www.replicant.us")) - "Home")) - (li (a (@ (href "/") - (id "blog-link") - ) - "Blog")) - (li (a (@ (href "https://redmine.replicant.us/projects/replicant/wiki")) - "Wiki")) - (li (a (@ (href "https://redmine.replicant.us/projects/replicant/issues")) - "Tracker")) - (li (a (@ (href "https://redmine.replicant.us/projects/replicant/boards")) - "Forums")) - (li (a (@ (href "/search.html")) - "Blog: Search"))))) - ,body))) - -(define (replicant-default-post-template post) - `((h1 (@ (id "title")) ,(post-ref post 'title)) - ;; Metadata - (p (string-append - "Posted" - ,(if - (post-ref post 'authors) - (string-append " by " (post-ref post 'authors)) - "") - ,(if - (post-ref post 'date) - (string-append - " on the " - (date->string (post-ref post 'date) "~d ~B ~Y at ~kh~M")) - "") - ,(if (post-ref post 'licenses) - (string-append - " under the " - (post-ref post 'licenses) " license(s)") - "") - ".")) - (div (@ (id "post-content")) ,(post-sxml post)) - - ,(if - (and (post-ref post 'thread-link) - (post-ref post 'thread-name)) - `(div - (h1 "Comments") - (p "You can view replies on the Replicant mailing list, in the " - (a (@ (href ,(post-ref post 'thread-link))) - ,(post-ref post 'thread-name)) " thread.") - (p "If you also want to comment on this blog post, you can simply -reply to the " - (a (@ (href ,(post-ref post 'thread-link))) - ,(post-ref post 'thread-name)) " thread.") - - (p "If for some reasons you can't reply to this thread or you don't -know how to do it, simply write a mail to the mailing list instead.") - - (p "It is easier for everybody if you subscribe to the mailing list -to do that: if you don't your mail will probably still reach the mailing list -but it will require a moderator to approve it so it can take time. See " - (a (@ (href "https://redmine.replicant.us/projects/replicant/wiki/CommunityAndContact#Mailing-list")) - "the CommunityAndContact page") - " on the Replicant wiki for how to subscribe")) - ;; Empty div to avoid #<unspecified> showing up on the page when we have - ;; no comments. - `(div)))) - - -(define (sort-posts-by-most-recent-first a b) - (time>? - (date->time-utc (post-ref a 'date)) - (date->time-utc (post-ref b 'date)))) - -(define (replicant-default-collection-template site title posts prefix) - (define (post-uri post) - (string-append (or prefix "") "/" - (site-post-slug site post) ".html")) - - `((h3 ,title) - (ul - ,@(map (lambda (post) - `(li - (a (@ (href ,(post-uri post))) - ,(post-ref post 'title)))) - (sort posts sort-posts-by-most-recent-first))))) - -(define* (theme #:key - (name "Replicant") - (layout replicant-layout) - (post-template replicant-default-post-template) - (collection-template replicant-default-collection-template)) - (make-theme name layout post-template collection-template)) - -(define (with-layout theme site title body) - ((theme-layout theme) site title body)) - -(define (render-post theme site post) - (let ((title (post-ref post 'title)) - (body ((theme-post-template theme) post))) - (with-layout theme site title body))) - -(define (render-collection theme site title posts prefix) - (let ((body ((theme-collection-template theme) site title posts prefix))) - (with-layout theme site title body))) - -(define (date->string* date) - "Convert DATE to human readable string." - (date->string date "~a ~d ~B ~Y")) - -(define replicant-theme - (theme #:name "Replicant" - #:layout replicant-layout - #:post-template replicant-default-post-template - #:collection-template replicant-default-collection-template)) - -(define* (replicant-blog-website #:key (theme replicant-theme) prefix - (collections - `(("" "index.html" ,posts/reverse-chronological)))) - "Return a procedure that transforms a list of posts into pages -decorated by THEME, whose URLs start with PREFIX." - (define (make-file-name base-name) - (if prefix - (string-append prefix "/" base-name) - base-name)) - - (lambda (site posts) - (define (post->page post) - (let ((base-name (string-append (site-post-slug site post) - ".html"))) - (serialized-artifact (make-file-name base-name) - (render-post theme site post) - sxml->html))) - - (define collection->page - (match-lambda - ((title file-name filter) - (serialized-artifact (make-file-name file-name) - (render-collection theme site title (filter posts) prefix) - sxml->html)))) - - (append (map post->page posts) - (map collection->page collections)))) |
