theme.scm 2.14 KB
Newer Older
Philip Kaludercic's avatar
Philip Kaludercic committed
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
(add-to-load-path "..")
(define-module (local theme)
  #:use-module (ice-9 format)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (haunt builder blog)
  #:use-module (haunt post)
  #:use-module (haunt site)
  #:use-module (local common)
  #:export (local-site-theme))

(define (intersperse lst x)
  (append (apply append (map (lambda (item) (list item x))
							 (drop-right lst 1)))
		  (last-pair lst)))

(intersperse '(1 2 3 4 5 6) -1)

(define* (make-post-generator #:key site prefix)
  (lambda (post)
	`(article
	  ,(post-sxml post)
	  (nav (time ,(date->string (post-date post)
								"Beigetragen am ~d ~h. ~Y"))
		   (span "Tags: "
				 ,(intersperse
				   (map (lambda (tag)
						  (link tag (format #f "/feeds/tags/~a.xml" tag)))
						(or (post-ref post 'tags) '()))
				   ", "))
		   ,@(if (and site prefix)
				 `(" "
				   ,(link "Permalink"
						  (format #f "/~a/~a.html"
								  prefix (site-post-slug site post))))
				 '(""))))))

(define local-site-theme
  (theme
   #:name "local"
   #:layout
   (lambda (site title body)
     `((doctype "html")
       (head
        (meta (@ (charset "utf-8")))
		(meta (@ (name "referrer") (content "none")))
		(meta (@ (name "viewport") (content "width=device-width")))
        (title ,title)
		(link (@ (rel "stylesheet") (href "/static/style.css"))))
       (body
		(header
		 (nav ,@(list (link '(code "#faui2k17") "/") 
					  (link "IRC" "/irc.html")
					  (link "WhatsApp" "/whatsapp.html")
					  (link "Beitragen" "/meta.html")
					  (link "Atom Feed" "/feed.xml"))))
        ,body)))
   #:post-template (make-post-generator)
   #:collection-template
   (lambda (site title posts prefix number last?)
	 (list
      (map (make-post-generator #:site site
								#:prefix prefix)
           posts)
	  `(footer
		,(let ((prev (link "←" (format #f "/page-~d.html" (1- number))))
			   (next (link "→" (format #f "/page-~d.html" (1+ number))))
			   (name (format #f "Page ~d" number)))
		   (cond ((and last? (= number 1))
				  (list name))
				 (last?
				  (list prev " " name))
				 ((= number 1)
				  (list name " " prev))
				 (else
				  (list prev " " name " " next)))))))))