1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;;; Copyright © 2019 - 2020 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This program 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.
;;;
;;; This program 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 this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (jakob theme)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (jakob utils sxml)
#:export (theme))
;;;
;;; SHTML generation in the site's theme.
;;;
(define %stylesheets '("normalize.css" "fonts.css" "highlight.css" "style.css"))
(define %link-rel '(("alternate" "/feed.xml" "application/atom+xml")
("icon" "/static/image/favicon.ico" "image/vnd.microsoft.icon")
("me" "https://social.jakob.space/jakob")
("webmention" "https://webmention.io/jakob.space/webmention")
("pingback" "https://webmention.io/jakob.space/xmlrpc")
("pgpkey authn" "/static/gpg.txt")))
(define %nav-bar-tabs '(("About" "/pages/about.html")
("Tags" "/tag.html")
("More ▼" "#"
("Blogroll" "/blogroll/")
("Bookmarks" "/bookmark/")
("Changelog" "/pages/changelog.html"))))
(define %title "Jakob's Personal Webpage")
(define (format-nav-item item-content)
(let* ((anchor-element (apply hyperlink (reverse (take item-content 2))))
(children (drop item-content 2)))
(if (null? children)
`(li ,anchor-element)
`(li (@ (class "drop-parent"))
,anchor-element
(ul (@ (class "drop-menu"))
,@(map format-nav-item children))))))
(define %header
`(header
,(hyperlink "/" (image "trident.svg" "home"))
(nav (ul
,@(map format-nav-item %nav-bar-tabs)))))
(define %footer
`(footer
(div
(p "© 2015 - 2025 Jakob L. Kreuze")
,(image "cc-by-sa-4.0.png"
"Creative Commons Attribution-ShareAlike 4.0 International (CC
BY-SA 4.0) Logo"))
(p "Unless otherwise specified, the text and images on this site are free
culture works available under the "
,(hyperlink "https://creativecommons.org/licenses/by-sa/4.0/"
"Creative Commons Attribution Share-Alike 4.0
International")
" license.")
(p "This website is built with "
,(hyperlink "http://haunt.dthompson.us/" "Haunt")
", a static site generator written in "
,(hyperlink "https://gnu.org/software/guile" "Guile Scheme")
". The source code is available "
,(hyperlink "https://git.sr.ht/~jakob/blog" "here")
".")
(p (a (@ (href "/pages/weblabels.html") (rel "jslicense"))
"JavaScript license information"))))
(define* (theme #:key
(title '())
(description "")
(keywords '())
(meta '())
(scripts '())
(content '(div "")))
"Return an SHTML document using the website's theme."
`((doctype "html")
(html
(@ (lang "en"))
(head
,(if (null? title)
`(title %title)
`(title ,(string-join (list title %title) " — ")))
(meta (@ (charset "utf-8")))
(meta (@ (name "keywords") (content ,(string-join keywords ", "))))
(meta (@ (name "description") (content ,description)))
(meta (@ (name "language") (content "EN")))
(meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0")))
(meta (@ (name "HandheldFriendly") (content "True")))
(meta (@ (name "author") (content "Jakob L. Kreuze")))
(meta (@ (name "subject") (content "Personal website of Jakob L. Kreuze")))
(meta (@ (name "medium") (content "blog")))
(meta (@ (name "og:title") (content ,title)))
,@(map (match-lambda
((name . content)
`(meta (@ (name ,name) (content ,content)))))
meta)
,@(map (lambda (file-name) (stylesheet file-name)) %stylesheets)
,@(map (match-lambda
((rel href) `(link (@ (rel ,rel) (href ,href))))
((rel href type) `(link (@ (rel ,rel) (href ,href) (type ,type)))))
%link-rel))
(body
,%header
,content
,@scripts
,%footer))))
|
