summaryrefslogtreecommitdiffstats
path: root/apps/blog/templates
diff options
context:
space:
mode:
Diffstat (limited to 'apps/blog/templates')
-rw-r--r--apps/blog/templates/components.scm78
-rw-r--r--apps/blog/templates/feed.scm55
-rw-r--r--apps/blog/templates/post-list.scm56
-rw-r--r--apps/blog/templates/post.scm69
-rw-r--r--apps/blog/templates/tag.scm61
5 files changed, 319 insertions, 0 deletions
diff --git a/apps/blog/templates/components.scm b/apps/blog/templates/components.scm
new file mode 100644
index 0000000..6c49f94
--- /dev/null
+++ b/apps/blog/templates/components.scm
@@ -0,0 +1,78 @@
+;;; Harmonic Flow web site
+
+(define-module (apps blog templates components)
+ #:use-module (apps aux strings)
+ #:use-module (apps aux sxml)
+ #:use-module (apps aux web)
+ #:use-module (apps base utils)
+ #:use-module (apps blog utils)
+ #:use-module (apps i18n)
+ #:use-module (haunt post)
+ #:use-module (srfi srfi-19)
+ #:export (post-preview
+ sidebar))
+
+
+;;;
+;;; Components.
+;;;
+
+(define (post-preview post)
+ "Return an SHTML representation of the given post object.
+
+ POST (<post>)
+ A post object (see Haunt's manual for more information)."
+ `(a
+ (@ (class "item-preview")
+ (href ,(hfweb-url (post-url-path post))))
+ (h3
+ (@ (lang "en"))
+ ,(post-ref post 'title))
+ (p
+ (@ (class "item-date"))
+ ,(date->string (post-date post) (C_ "SRFI-19 date->string format"
+ "~B ~e, ~Y")))
+ (p
+ (@ (class "item-summary") (lang "en"))
+ ,(string-summarize (sxml->string* (post-sxml post)) 30)
+ ,(C_ "blog post summary ellipsis" "…"))))
+
+
+(define* (sidebar tags #:optional (current-tag #false))
+ "Return an SHTML section element representing the sidebar of the blog.
+
+ TAGS (association list)
+ An association list of tags mapped to blog posts as returned by
+ Haunt's 'posts/group-by-tag' procedure in (haunt post) module."
+ `(section
+ (@ (class "side-bar"))
+ (h3 (@ (class "a11y-offset")) (G_ "Blog menu: "))
+
+ (h4
+ (@ (class "bar-title bar-title-top"))
+ ,(if current-tag
+ (G_ "Get topic updates")
+ (G_ "Get blog updates")))
+ (ul
+ (@ (class "bar-list"))
+ (li (@ (class "bar-item"))
+ (a (@ (class "bar-link feed-link")
+ ,(if current-tag
+ `(href ,(hfweb-url
+ (url-path-join "feeds" "blog"
+ (string-append
+ (slugify current-tag)
+ ".atom"))))
+ `(href ,(hfweb-url (url-path-join "feeds" "blog.atom")))))
+ ,(C_ "button" "Atom feed"))))
+
+ (h4 (@ (class "bar-title")) (G_ "Posts by topic"))
+ (ul
+ (@ (class "bar-list"))
+ ,@(map
+ (lambda (tag)
+ `(li (@ (class "bar-item"))
+ (a (@ (class "bar-link")
+ (href ,(hfweb-url (url-path-join (tag-url-path tag) ""))))
+ ,tag)))
+ (sort tags tag-first?)))))
diff --git a/apps/blog/templates/feed.scm b/apps/blog/templates/feed.scm
new file mode 100644
index 0000000..bfa1cc4
--- /dev/null
+++ b/apps/blog/templates/feed.scm
@@ -0,0 +1,55 @@
+;;; Harmonic Flow web site
+
+(define-module (apps blog templates feed)
+ #:use-module (apps aux strings)
+ #:use-module (apps aux sxml)
+ #:use-module (apps aux web)
+ #:use-module (apps base templates theme)
+ #:use-module (apps base types)
+ #:use-module (apps base utils)
+ #:use-module (apps blog utils)
+ #:use-module (apps i18n)
+ #:use-module (haunt html)
+ #:use-module (haunt post)
+ #:use-module (srfi srfi-19)
+ #:export (atom-feed-t))
+
+
+(define (atom-feed-t context)
+ "Return an SXML representation of a Blog's topic atom feed."
+ (let ((domain (context-datum context "domain"))
+ (title (context-datum context "title"))
+ (id (context-datum context "id"))
+ (alternate (context-datum context "alternate"))
+ (posts (context-datum context "posts")))
+ `(feed
+ ;; Feed info.
+ (@ (xmlns "http://www.w3.org/2005/Atom"))
+ (id ,id)
+ (title ,title)
+ (author (name (C_ "feed author name" "Harmonic Flow Blog")) (uri ,domain))
+ (icon ,(hfweb-url "static/base/img/icon.png"))
+ (updated ,(date->string (current-date) "~4"))
+ (link (@ (rel "alternate") (href ,alternate)))
+
+ ;; Feed entries.
+ ,@(map
+ (lambda (post)
+ `(entry
+ (id ,(url-path-join domain (post-url-path post) ""))
+ (title ,(post-ref post 'title))
+ (author (name ,(post-ref post 'author)))
+ (published ,(date->string (post-date post) "~4"))
+ (updated ,(date->string (post-date post) "~4"))
+ ;(rights (@ (type "text")) ,(post-copyright post))
+ (link (@ (rel "alternate")
+ (href ,(url-path-join domain
+ (post-url-path post)
+ ""))))
+ ,@(map
+ (lambda (tag)
+ `(category (@ (term ,tag))))
+ (post-ref post 'tags))
+ (summary ,(string-summarize (sxml->string* (post-sxml post)) 100) "…")
+ (content (@ (type "html")) ,(sxml->html-string (post-sxml post)))))
+ posts))))
diff --git a/apps/blog/templates/post-list.scm b/apps/blog/templates/post-list.scm
new file mode 100644
index 0000000..c63b01a
--- /dev/null
+++ b/apps/blog/templates/post-list.scm
@@ -0,0 +1,56 @@
+;;; Harmonic Flow web site
+
+(define-module (apps blog templates post-list)
+ #:use-module (apps aux web)
+ #:use-module (apps base templates components)
+ #:use-module (apps base templates theme)
+ #:use-module (apps base types)
+ #:use-module (apps base utils)
+ #:use-module ((apps blog templates components) #:prefix blog:)
+ #:use-module (apps i18n)
+ #:export (post-list-t))
+
+
+(define (post-list-t context)
+ "Return a list of blog posts in SHTML with the data in CONTEXT."
+ (let ((page-number
+ (number->string (context-datum context "page-number")))
+ (total-pages
+ (number->string (context-datum context "total-pages"))))
+ (theme
+ #:title (list (G_ (string-append "Page " page-number ""))
+ (C_ "webpage title" "Blog |"))
+ #:description
+ (G_ "Blog posts about programming and free software.")
+ #:keywords
+ (string-split ;TRANSLATORS: |-separated list of webpage keywords
+ (G_ "Harmonic Flow Blog|HFGE|Free Software|C++|Libre software|Graphics Programming|Vulkan") #\|)
+ #:index? #false
+ #:active-menu-item (C_ "website menu" "Blog")
+ #:css
+ (list (hfweb-url "static/base/css/page.css")
+ (hfweb-url "static/base/css/item-preview.css")
+ (hfweb-url "static/base/css/sidebar.css"))
+ #:crumbs
+ (list (crumb (C_ "website menu" "Blog") (hfweb-url "blog/"))
+ (crumb (G_ (string-append "Page " page-number ""))
+ (hfweb-url (url-path-join "blog"
+ "page"
+ page-number
+ ""))))
+ #:content
+ `(main
+ (section
+ (@ (class "page centered-text"))
+ (h2 (G_ "Blog")
+ ,(page-indicator (string->number page-number)
+ (string->number total-pages)))
+
+ (div
+ (@ (class "sheet"))
+ ,@(map blog:post-preview (context-datum context "items"))
+ ,(page-selector (string->number total-pages)
+ (string->number page-number)
+ (hfweb-url "blog")))
+
+ ,(blog:sidebar (context-datum context "tags")))))))
diff --git a/apps/blog/templates/post.scm b/apps/blog/templates/post.scm
new file mode 100644
index 0000000..8a4880d
--- /dev/null
+++ b/apps/blog/templates/post.scm
@@ -0,0 +1,69 @@
+;;; Harmonic Flow web site
+
+(define-module (apps blog templates post)
+ #:use-module (apps base templates components)
+ #:use-module (apps base templates theme)
+ #:use-module (apps base types)
+ #:use-module (apps base utils)
+ #:use-module (apps blog utils)
+ #:use-module ((apps blog templates components) #:prefix blog:)
+ #:use-module (apps i18n)
+ #:use-module (haunt post)
+ #:use-module (srfi srfi-19)
+ #:export (post-t))
+
+
+(define (post-t context)
+ "Return a page in SHTML for the post in the given CONTEXT."
+ (let* ((post (context-datum context "post"))
+ (tags (post-ref post 'tags)))
+ (theme
+ #:title (list (post-ref post 'title)
+ (C_ "webpage title" "|"))
+ #:description
+ (G_ (string-append "Blog post about "
+ (post-ref post 'title)
+ " on Harmonic Flow Blog."))
+ #:keywords tags
+ #:active-menu-item (C_ "website menu" "Blog")
+ #:css
+ (list (hfweb-url "static/base/css/page.css")
+ (hfweb-url "static/blog/css/post.css"))
+ #:crumbs
+ (list (crumb (C_ "website menu" "Blog") (hfweb-url "blog/"))
+ (crumb (post-ref post 'title)
+ (hfweb-url (post-url-path post))))
+ #:content
+ `(main
+ (article
+ (@ (class "page centered-block limit-width") (lang "en"))
+ (h2 ,(post-ref post 'title))
+ (p
+ (@ (class "post-metadata centered-text") (lang ,%current-ietf-tag))
+ ,(post-ref post 'author) " — "
+ ,(date->string (post-date post) (C_ "SRFI-19 date->string format"
+ "~B ~e, ~Y")))
+
+ ,(change-image-to-video
+ (syntax-highlight (post-sxml post)))
+
+ (div
+ (@ (class "tag-list") (lang ,%current-ietf-tag))
+ ,(G_ `(p "Related topics:"))
+
+ ,@(map
+ (lambda (tag)
+ (list
+ (button-little
+ #:label tag
+ #:url (hfweb-url (tag-url-path tag)))
+ " ")) ; NOTE: Force space for readability in non-CSS browsers.
+ (sort tags tag-first?)))
+
+ (div
+ (@ (class "license") (lang ,%current-ietf-tag))
+ ,(G_ `(p "Unless otherwise stated, blog posts on this site are
+ copyrighted by their respective authors and published under the terms of the "
+ ,(G_
+ `(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
+ "CC-BY-SA 4.0 license."))))))))))
diff --git a/apps/blog/templates/tag.scm b/apps/blog/templates/tag.scm
new file mode 100644
index 0000000..865f27a
--- /dev/null
+++ b/apps/blog/templates/tag.scm
@@ -0,0 +1,61 @@
+;;; Harmonic Flow web site
+
+(define-module (apps blog templates tag)
+ #:use-module (apps aux web)
+ #:use-module (apps base templates components)
+ #:use-module (apps base templates theme)
+ #:use-module (apps base types)
+ #:use-module (apps base utils)
+ #:use-module ((apps blog templates components) #:prefix blog:)
+ #:use-module (apps blog utils)
+ #:use-module (apps i18n)
+ #:export (tag-t))
+
+
+(define (tag-t context)
+ "Return a list of blog posts in SHTML with the data in CONTEXT."
+ (let ((tag (context-datum context "tag"))
+ (page-number
+ (number->string (context-datum context "page-number")))
+ (total-pages
+ (number->string (context-datum context "total-pages"))))
+ (theme
+ #:title (list (G_ (string-append "Page " page-number ""))
+ tag (C_ "webpage title" "Blog"))
+ #:description
+ (G_ (string-append "Blog posts about "
+ tag
+ " on Harmonic Flow Blog."))
+ #:keywords
+ (string-split ;TRANSLATORS: |-separated list of webpage keywords
+ (G_ "Harmonic Flow Blog|HFGE|Free Software|C++|Libre software|Graphics Programming|Vulkan") #\|)
+ #:index? #false
+ #:active-menu-item (C_ "website menu" "Blog")
+ #:css
+ (list (hfweb-url "static/base/css/page.css")
+ (hfweb-url "static/base/css/item-preview.css")
+ (hfweb-url "static/base/css/sidebar.css"))
+ #:crumbs
+ (list (crumb (C_ "website menu" "Blog") (hfweb-url "blog/"))
+ (crumb tag (hfweb-url (tag-url-path tag)))
+ (crumb (G_ (string-append "Page " page-number ""))
+ (hfweb-url (url-path-join (tag-url-path tag)
+ "page"
+ page-number
+ ""))))
+ #:content
+ `(main
+ (section
+ (@ (class "page centered-text"))
+ (h2 ,(G_ "Blog — ") ,tag
+ ,(page-indicator (string->number page-number)
+ (string->number total-pages)))
+
+ (div
+ (@ (class "sheet"))
+ ,@(map blog:post-preview (context-datum context "items"))
+ ,(page-selector (string->number total-pages)
+ (string->number page-number)
+ (hfweb-url "blog")))
+
+ ,(blog:sidebar (context-datum context "tags") tag))))))
generated by cgit v1.2.3-54-g00ecf (git 2.39.0) at 2024-09-19 16:52:32 +0000