summaryrefslogtreecommitdiffstats
path: root/haunt.scm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--haunt.scm43
1 files changed, 25 insertions, 18 deletions
diff --git a/haunt.scm b/haunt.scm
index 5d00630..54090b7 100644
--- a/haunt.scm
+++ b/haunt.scm
@@ -22,7 +22,8 @@
22 (haunt builder assets) 22 (haunt builder assets)
23 (haunt reader) 23 (haunt reader)
24 (haunt reader commonmark) 24 (haunt reader commonmark)
25 (srfi srfi-71)) 25 (srfi srfi-71)
26 (ice-9 match))
26 27
27(define %cwd 28(define %cwd
28 (and=> (assq-ref (current-source-location) 'filename) 29 (and=> (assq-ref (current-source-location) 'filename)
@@ -39,19 +40,25 @@
39 40
40(define* (base-layout body #:key (title "") (meta '()) 41(define* (base-layout body #:key (title "") (meta '())
41 (posts '()) site) 42 (posts '()) site)
42 (define menubar 43 (define (menubar where)
43 `(div (@ (id "menubar") 44 (let ((locations
44 (class "width-control")) 45 '(("about" "About" "/")
45 (ul 46 ("software" "Software" "/software")
46 (li (a (@ (href ,(base-url "/"))) 47 ("blog" "Blog" "/blog"))))
47 "About")) 48 `(div (@ (id "menubar")
48 (li (a (@ (href ,(base-url "/software"))) 49 (class "width-control"))
49 "Software")) 50 (ul
50 (li (a (@ (href ,(base-url "/blog"))) 51 ,@(map (match-lambda
51 "Blog")) 52 ((key text path)
52 (li (a (@ (href ,(base-url "/blog/feed.xml"))) 53 (if (and where (string=? where key))
53 (img (@ (alt "Atom feed") 54 `(li (@ (class "selected"))
54 (src ,(image-url "/feed.png"))))))))) 55 (span ,text))
56 `(li (a (@ (href ,(base-url path)))
57 ,text)))))
58 locations)
59 (li (a (@ (href ,(base-url "/blog/feed.xml")))
60 (img (@ (alt "Atom feed")
61 (src ,(image-url "/feed.png"))))))))))
55 (define front-page? 62 (define front-page?
56 (assoc-ref meta 'frontpage)) 63 (assoc-ref meta 'frontpage))
57 64
@@ -85,7 +92,7 @@
85 92
86 ;; Add the large-font welcoming message on the 93 ;; Add the large-font welcoming message on the
87 ;; front page. 94 ;; front page.
88 ,@(if (assoc-ref meta 'frontpage) 95 ,@(if front-page?
89 `((p (@ (id "heading") 96 `((p (@ (id "heading")
90 (class "front-page-heading")) 97 (class "front-page-heading"))
91 "Welcome to the GNU Assembly! We write " 98 "Welcome to the GNU Assembly! We write "
@@ -95,9 +102,9 @@
95 "giving them individual and collective control " 102 "giving them individual and collective control "
96 "over their computing, from the operating " 103 "over their computing, from the operating "
97 "system to applications.")) 104 "system to applications."))
98 `(,menubar)))) 105 `(,(menubar (assoc-ref meta 'menu))))))
99 ,@(if (assoc-ref meta 'frontpage) 106 ,@(if front-page?
100 `(,menubar) 107 `(,(menubar "about"))
101 '()) 108 '())
102 109
103 (div (@ (id "content") 110 (div (@ (id "content")