From ca8b8817c503209c554b0d473b188c7591fb44ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 11 Apr 2021 22:11:21 +0200 Subject: website: Add support for a blog. * website/haunt.scm (post-url, post->sxml, page->sxml) (post->page): New procedures. (%theme): New variable. : Add blog post pages. * website/static/css/main.css (.post-about): Tweak margin. --- website/haunt.scm | 97 +++++++++++++++++++++++++++++++++++++++++++-- website/static/css/main.css | 2 +- 2 files changed, 95 insertions(+), 4 deletions(-) (limited to 'website') diff --git a/website/haunt.scm b/website/haunt.scm index f4c95aa..b67b668 100644 --- a/website/haunt.scm +++ b/website/haunt.scm @@ -19,10 +19,15 @@ (haunt site) (haunt page) (haunt html) + (haunt post) (haunt builder assets) + (haunt builder blog) + (haunt builder atom) (haunt reader) (haunt reader commonmark) - (srfi srfi-71) + (srfi srfi-19) ;dates + (srfi srfi-26) ;cut + (srfi srfi-71) ;multiple-value let (ice-9 match)) (define %cwd @@ -152,11 +157,97 @@ representation." "social-contract.md"))) +;;; +;;; Blog. +;;; + +(define (post-url post site) + "Return the URL of POST, a Haunt blog post, for SITE." + (let ((date (post-date post))) + (base-url "/en/blog/" + (number->string (date-year date)) + "/" + (string-pad (number->string (date-month date)) + 2 #\0) + + ;; There's an implicit "/index.html" here. + "/" (site-post-slug site post)))) + +(define* (post->sxml post #:key post-uri summarize?) + "Return the SXML for POST." + (define post-body* + ;; (if summarize? + ;; (cut summarize-post <> post-uri) + ;; post-sxml*) + post-sxml + ) + + `(div (@ (class "post")) + (h1 (@ (class "title")) + ,(if post-uri + `(a (@ (href ,post-uri)) + ,(post-ref post 'title)) + (post-ref post 'title))) + (div (@ (class "post-about")) + ,(post-ref post 'author) + " — " ,(date->string (post-date post) "~B ~e, ~Y")) + (hr) + (div (@ (class "post-body")) + ,(post-body* post)))) + +(define (page->sxml site title posts prefix) + "Return the SXML for the news page of SITE, containing POSTS." + `((div (@ (class "header")) + (div (@ (class "post-list")) + ,@(map (lambda (post) + (post->sxml post #:post-uri (post-url post site) + #:summarize? #t)) + posts))))) + +(define (post->page post site) + (make-page (string-append (post-url post site) "/index.html") + (render-post %theme site post) + sxml->html)) + +(define %theme + ;; Theme for the rendering of the news pages. + (theme #:name "The GNU Assembly" + #:layout (lambda (site title body) + (base-layout body + #:title + (string-append "The GNU Assembly — " + title))) + #:post-template post->sxml + #:collection-template page->sxml)) + + (site #:title "The GNU Assembly" #:domain "gnu.tools" #:default-metadata '((author . "The GNU Assembly") (email . "assembly@lists.gnu.tools")) #:readers (list commonmark-reader) - #:builders (cons (static-directory "static") - (static-pages))) + #:builders (append (list (static-directory "static")) + (static-pages) + + ;; Blog posts. + (list (lambda (site posts) + ;; Pages for each post. + (map (cut post->page <> site) posts)) + + (lambda (site posts) + ;; The main collection. + (make-page + "/en/blog/index.html" + (render-collection + %theme site + "The GNU Assembly — Blog" ;title + (posts/reverse-chronological posts) + "/en/blog") + sxml->html)) + + ;; Apparently the tags of Atom entries + ;; must be absolute URLs, hence this + ;; #:blog-prefix. + (atom-feed #:file-name "en/blog/feed.xml" + #:blog-prefix "https://gnu.tools/en/blog")))) diff --git a/website/static/css/main.css b/website/static/css/main.css index 8e2d1a0..6f2eeaa 100644 --- a/website/static/css/main.css +++ b/website/static/css/main.css @@ -209,7 +209,7 @@ hr { .post-about { color: #4D4D4D; font-size: 0.9em; - margin-top: -3em; + margin-top: -2em; } #menubar ul { display: inline-block; padding: 0px; margin: 0px; } -- cgit v1.2.1