gnucode.me/theme/theme.scm

(define-module (theme theme)
  #:use-module (srfi srfi-19)
  #:use-module (haunt site)
  #:use-module (haunt post)
  #:use-module (utils utils)
  #:export (gnucode-layout
            date->string*
            %meta-sxml-elements
            %header-sxml-element
            %footer-sxml
            %sxml-css-links))

(define (date->string* date)
  "Convert DATE to human readable string."
  (date->string date "~B ~d, ~Y"))

(define (gnucode-layout site title body)
  `((doctype "html")
    (head
     ,%meta-sxml-elements
     ,%sxml-css-links
     (title ,(string-append title " — " (site-title site))))
    (body
     ,%header-sxml-element
     ,(if (string=? "Recent Posts" title)
          `(h1 ,(site-title site))
          `(h1 ,title))
     (main
      ,body)
     ,%footer-sxml
     )))

(define %header-sxml-element
  `((header
     (nav
      (ul
       (li (a (@ (href "index.html")) "GNUcode.me"))
       ,(let loop ([pages (files-in-dir "/home/joshua/prog/gnu/guile/gnucode.me/pages/")])
          (define current-page-name (if (null? pages)
                                        '()
                                        (string-drop-right (car pages) 5)))
          (if (null? pages)
              '()
              (cons
               `(li (a (@ (href
                           ,(string-append current-page-name ".html")))
                       ,(string-upcase current-page-name 0 1)
                       ))
               (loop (cdr pages)))))
       )))))

(define %sxml-css-links
  '(
    (link (@ (type "text/css") (href "css/footer.min.css") (rel "stylesheet")) "")
    (link (@ (type "text/css") (href "css/header.min.css") (rel "stylesheet")) "")
    (link (@ (type "text/css") (href "css/main.min.css") (rel "stylesheet")) "")
    ))

(define %meta-sxml-elements
  '(
    (meta (@ (charset "utf-8")))
    (meta (@ (name "viewport") (content "width=device-width, initial-scale=1, shrink-to-fit=no")))
    (meta (@ (name "keywords") (content "GNU, Emacs, Libre Software, Hurd, Guile, Guix")))
    (meta (@ (name "description")
             (content "GNUcode.me is a website focusing on libre software projects, especially the GNU project.")))
    (link (@ (type "application/atom+xml") (rel "alternate") (title "GNUcode.me -- Feed")
             (href "/feed.xml")))
    (a (@ (rel "me") (href "https://fosstodon.org/@thegnuguy")) "")
    ))

(define %footer-sxml
  '(footer
    (p "© 2020 Joshua Branson.  The text on this site is free culture under the Creative Commons Attribution Share-Alike 4.0 International license.")
    (p "This website is build with Haunt, a static site generator written in Guile Scheme.  Source code is "
       (a (@ (href "https://notabug.org/jbranso/gnucode.me")) "available."))
    (p "The color theme of this website is based off of the famous "
       (a (@ (href "#3f3f3f") (target "_blank")) "zenburn")
       " theme.")))