From 82e437898d40a215d41ab368ad8c7f4a405e2cf9 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Sun, 11 Apr 2021 11:05:45 +0200
Subject: website: Disable menu item for current location.

---
 website/haunt.scm | 43 +++++++++++++++++++++++++------------------
 1 file changed, 25 insertions(+), 18 deletions(-)

(limited to 'website/haunt.scm')

diff --git a/website/haunt.scm b/website/haunt.scm
index 5d00630..54090b7 100644
--- a/website/haunt.scm
+++ b/website/haunt.scm
@@ -22,7 +22,8 @@
              (haunt builder assets)
              (haunt reader)
              (haunt reader commonmark)
-             (srfi srfi-71))
+             (srfi srfi-71)
+             (ice-9 match))
 
 (define %cwd
   (and=> (assq-ref (current-source-location) 'filename)
@@ -39,19 +40,25 @@
 
 (define* (base-layout body #:key (title "") (meta '())
                       (posts '()) site)
-  (define menubar
-    `(div (@ (id "menubar")
-             (class "width-control"))
-          (ul
-           (li (a (@ (href ,(base-url "/")))
-                  "About"))
-           (li (a (@ (href ,(base-url "/software")))
-                  "Software"))
-           (li (a (@ (href ,(base-url "/blog")))
-                  "Blog"))
-           (li (a (@ (href ,(base-url "/blog/feed.xml")))
-                  (img (@ (alt "Atom feed")
-                          (src ,(image-url "/feed.png")))))))))
+  (define (menubar where)
+    (let ((locations
+           '(("about"    "About"    "/")
+             ("software" "Software" "/software")
+             ("blog"     "Blog"     "/blog"))))
+      `(div (@ (id "menubar")
+               (class "width-control"))
+            (ul
+             ,@(map (match-lambda
+                      ((key text path)
+                       (if (and where (string=? where key))
+                           `(li (@ (class "selected"))
+                                (span ,text))
+                           `(li (a (@ (href ,(base-url path)))
+                                   ,text)))))
+                    locations)
+             (li (a (@ (href ,(base-url "/blog/feed.xml")))
+                    (img (@ (alt "Atom feed")
+                            (src ,(image-url "/feed.png"))))))))))
   (define front-page?
     (assoc-ref meta 'frontpage))
 
@@ -85,7 +92,7 @@
 
                      ;; Add the large-font welcoming message on the
                      ;; front page.
-                     ,@(if (assoc-ref meta 'frontpage)
+                     ,@(if front-page?
                            `((p (@ (id "heading")
                                    (class "front-page-heading"))
                                 "Welcome to the GNU Assembly!  We write "
@@ -95,9 +102,9 @@
                                 "giving them individual and collective control "
                                 "over their computing, from the operating "
                                 "system to applications."))
-                           `(,menubar))))
-           ,@(if (assoc-ref meta 'frontpage)
-                 `(,menubar)
+                           `(,(menubar (assoc-ref meta 'menu))))))
+           ,@(if front-page?
+                 `(,(menubar "about"))
                  '())
 
            (div (@ (id "content")
-- 
cgit v1.2.1