aboutsummaryrefslogtreecommitdiffstats
path: root/website/builders/replicant-blog.scm
diff options
context:
space:
mode:
authorDenis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>2025-06-12 16:43:34 +0200
committerDenis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>2025-06-15 01:30:32 +0200
commite614e7a8d8976f5f06d5dd8187c9f25baa1c2212 (patch)
treefaae02facdff52170387e64db800dd44fc2e2398 /website/builders/replicant-blog.scm
parent038b435769ed8c527ecfb7948f589d7d0b8022c7 (diff)
downloadhaunt-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.scm214
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))))