gdritter repos van-de-graaf / master
Mostly early scaffolding, no changes to the source code Getty Ritter 4 years ago
13 changed file(s) with 817 addition(s) and 0 deletion(s). Collapse all Expand all
(New empty file)
1 Van de Graaf is a static site generating tool designed for blogs
2 and built on top of [Guile Scheme] and the generic [TeLML] markup
3 language.
4
5 ## How To Use
6
7 A given page needs at least a template, and probably an input.
8 The input is interpreted as [TeLML].
9
10 ## Man
1 #!/bin/sh
2
3 # XXX: TODO
4 exit 0
(New empty file)
(New empty file)
(New empty file)
1 % VAN-DE-GRAAF(1) User Manuals
2
3 # NAME
4
5 van-de-graaf - scheme-based static site generation
6
7 # SYNOPSIS
8
9 van-de-graaf TEMPLATE [-i file] [-o file] [-t telml definitions]
10 [-d DECL]
11
12 # DESCRIPTION
13
14 *van-de-graaf* is a tool based on the GNU Guile implementation of
15 Scheme and the TeX-inspired TeLML markup language.
16
17 # EXAMPLES
18
19 # OPTIONS
20
21 *van-de-graaf* understands the following options:
22
23 -i
24 : Specify an input filename. If this is not specified, or if the
25 argument `-` is given, then it will take the input file on
26 _stdin_.
27
28 -o
29 : Specify an output filename. If this is not specified, or if the
30 argument `-` is given, then the resulting document will appear
31 on _stdout_.
32
33 -t
34 : Specify a file of _telml_ definitions to be used in addition to
35 the default ones. For further detail on _telml_ extension files,
36 see *telml-extensions(7)*
37
38 -d
39 : Specify the definition of a variable in Scheme. This can be used
40 to convey definitions to the script.
41
42 # BUGS
43
44 Lots, probably.
45
46 # RETURN CODES
47
48 *van-de-graaf* exits with a code of 0 on success. If there was an
49 error parsing the template file, it exits with a code of 1. If
50 there was an error parsing the input file, it exits with a code of
51 2. If there was an error with the command-line arguments, it exits
52 with a code of 3.
53
54 # SEE ALSO
55
56 * guile(1)
57 * telml(7)
58 * telml-extensions(7)
59 * sxml(7)
60 * <http://okmij.org/ftp/Scheme/xml.html#SXML-spec>
61 * scss(7)
62
63 # AUTHOR
64
65 Getty Ritter <http://infinitenegativeutility.com>
1 (include "types.scm")
2 (include "telml.scm")
3 (include "libs.scm")
4 (include "templates.scm")
5
6 (use-modules (srfi srfi-1))
7 (use-modules (ice-9 match))
8 (use-modules (ice-9 ftw))
9
10
11
12 ;; Create a folder if it doesn't exist. (There does not
13 ;; appear to be a Guile binding to mkdir -p.)
14 (define (ensure-folder f)
15 (if (not (file-exists? f))
16 (mkdir f)))
17
18 ;; create an output filename from a set of path components,
19 ;; creating the necessary folders if needed, as well.
20 (define (outfile chunks)
21 (define (go rest so-far)
22 (ensure-folder so-far)
23 (match rest
24 (() (++ so-far "/index.html"))
25 ((x . xs) (go xs (++ so-far "/" (as-string x))))))
26 (go chunks "output"))
27
28 ;; create a URL from a set of path components
29 (define (url chunks)
30 (define (go rest so-far)
31 (match rest
32 (() (++ so-far "/"))
33 ((x . xs) (go xs (++ so-far "/" (as-string x))))))
34 (go chunks ""))
35
36 ;; Grab all the posts and their metadata from the posts folder,
37 ;; sorted by creation time. This does unnecessary work right
38 ;; now; parsing all of them just to get the first metadata tag
39 ;; out of them.
40 (define (get-all-posts)
41 (let* ((files (cddr (file-system-tree "posts")))
42 (files-sorted (sort files (lambda (x y)
43 (> (stat:mtime (cadr x))
44 (stat:mtime (cadr y)))))))
45 (map (lambda (file-entry)
46 (let* ((filename (string-append "posts/" (car file-entry)))
47 (telml (translate-file filename))
48 (metadata (telml-meta telml)))
49 (make-post filename
50 (localtime (stat:mtime (cadr file-entry)))
51 (meta-slug metadata)
52 (meta-title metadata)
53 (meta-tags metadata)
54 (telml-content telml))))
55 files-sorted)))
56
57 ;; This should be factored out better, but for now... eh...
58 (define (get-all-feed-posts)
59 (let* ((files (cddr (file-system-tree "posts")))
60 (files-sorted (sort files (lambda (x y)
61 (> (stat:mtime (cadr x))
62 (stat:mtime (cadr y)))))))
63 (map (lambda (file-entry)
64 (let* ((filename (string-append "posts/" (car file-entry)))
65 (telml (translate-feed-file filename))
66 (metadata (telml-meta telml)))
67 (make-post filename
68 (localtime (stat:mtime (cadr file-entry)))
69 (meta-slug metadata)
70 (meta-title metadata)
71 (meta-tags metadata)
72 (telml-content telml))))
73 files-sorted)))
74
75 ;; Turn a post into an <li> element with appropriate
76 ;; link and date.
77 (define (post->list-elem post)
78 (let* ((date (date->string (post-time post)))
79 (href (post-url post))
80 (title (post-title post)))
81 `(li ,(++ date ": ") (a (@ (href ,href)) ,title))))
82
83 ;; Turn a tag into an <li> element with the appropriate link
84 (define (tag->list-elem tag)
85 (let ((url (url (list 'tag tag))))
86 `(li (@ (class tag-entry))
87 (a (@ (href ,url)) ,tag))))
88
89 ;; Generate the archive page
90 (define (archive)
91 (let* ((posts (get-all-posts))
92 (list `(div (@ (class archive-list))
93 (ul
94 ,(map post->list-elem posts)))))
95 (with-output-to-file (outfile '(archive))
96 (lambda ()
97 (display (sxml->html5 (page (url '(archive)) "archive" list)))))))
98
99 ;; Flatten a list
100 (define (concat list)
101 (apply append list))
102
103 ;; Get the list of all tags
104 (define (get-tag-list posts)
105 (let ((c (concat (map post-tags posts))))
106 (delete-duplicates (sort c string<?))))
107
108 ;; Get the list of all posts that are tagged with a given tag
109 (define (get-posts-with-tag tag posts)
110 (filter (lambda (post) (member tag (post-tags post))) posts))
111
112 ;; Generate all tag-related pages
113 (define (tags)
114 (let* ((posts (get-all-posts))
115 (tags (get-tag-list posts))
116 (tag-list `(div (@ (class archive-list))
117 (ul
118 ,(map tag->list-elem tags)))))
119
120 (define (mk-tag-page tag)
121 (let* ((ps (get-posts-with-tag tag posts))
122 (content `(div (@ (class archive-list))
123 "pages tagged "
124 (span (@ (class tag)) ,tag)
125 ":"
126 (ul
127 ,(map post->list-elem ps)))))
128 (with-output-to-file (outfile (list 'tag tag))
129 (lambda ()
130 (display (sxml->html5 (page (url (list 'tag tag))
131 tag
132 content)))))))
133
134 (with-output-to-file (outfile '(tags))
135 (lambda ()
136 (display (sxml->html5 (page (url '(tags))
137 "tags"
138 tag-list)))))
139
140 (map mk-tag-page tags)))
141
142 (define (feed)
143 (let ((posts (get-all-feed-posts)))
144 (with-output-to-file "output/feed.xml"
145 (lambda ()
146 (display (serialize-sxml (atom-feed posts)))))))
147
148 ;; Load a telml page and turn it into an html page
149 (define (main pg file out)
150 (let* ((page-source (translate-file file))
151 (telml (telml-content page-source))
152 (meta (telml-meta page-source))
153 (date (localtime (stat:mtime (stat file))))
154 (ndate (date->string date))
155 (title (if meta (meta-title meta) pg))
156 (target (outfile (if out out
157 (list ndate (meta-slug meta)))))
158 (url (url (if out out
159 (list ndate (meta-slug meta)))))
160 (display (sxml->html5 (page url
161 title
162 (add-tags telml (meta-tags meta))))))
163 (format #t "printing to ~a\n" target)
164 (with-output-to-file target
165 (lambda () (format #t "~a\n" display)))))
166
167 ;; Figure out which page is supposed to be generated
168 (define (dispatch pg files)
169 (match pg
170 ("index" (main "index" (car files) '()))
171 ("post" (map (lambda (f) (main "post" f #f)) files))
172 ("archive" (archive))
173 ("tags" (tags))
174 ("about" (main "about" "pages/about.telml" '(about)))
175 ("feed" (feed))))
176
177 (let ((args (cdr (command-line))))
178 (cond ((= (length args) 0)
179 (format #t "Usage: generate [page] [files]\n"))
180 (else (dispatch (car args) (cdr args)))))
1 ;; some library stuff
2
3 ;; A utility function for string-appending.
4 (define (++ . args) (apply string-append args))
5
6 ;; Speculatively convert a symbol to a string.
7 (define (as-string s)
8 (if (symbol? s) (symbol->string s) s))
9
10 ;; (intercalate x (a b ... c)) produces the list (a x b x ... x c).
11 (define (intercalate x xs)
12 (define (go ls)
13 (cond ((null? ls) '())
14 ((null? (cdr ls)) ls)
15 (else
16 (cons (car ls) (cons x (go (cdr ls)))))))
17 (apply ++ (go xs)))
18
19 ;;
20 (define (scss->css scss)
21 (define (mk-selector selector)
22 (cond ((symbol? selector)
23 (symbol->string selector))
24 ((and (list? selector)
25 (eq? (car selector) '=)
26 (eq? (cadr selector) 'class))
27 (++ "." (symbol->string (caddr selector))))
28 ((and (list? selector)
29 (eq? (car selector) '=)
30 (eq? (cadr selector) 'id))
31 (++ "#" (symbol->string (caddr selector))))
32 ((and (list? selector)
33 (eq? (car selector) '//))
34 (intercalate " " (map mk-selector (cdr selector))))
35 ((and (list? selector)
36 (eq? (car selector) '&&))
37 (intercalate "," (map mk-selector (cdr selector))))
38 (else "...")))
39 (define (mk-line line)
40 (++ " " (as-string (car line)) ": " (as-string (cadr line)) ";\n"))
41 (define (mk-clause clause)
42 (++
43 (mk-selector (car clause))
44 " {\n"
45 (apply ++ (map mk-line (cdr clause)))
46 "}\n"))
47 (apply ++ (map mk-clause scss)))
48
49 (define (cadr? sexp)
50 (if (or (null? sexp)
51 (null? (cdr sexp))
52 (not (list? (cadr sexp))))
53 #f (cadr sexp)))
54
55 (define (serialize-sxml sxml)
56 (define (mk-prop prop)
57 (let ((key (as-string (car prop))) (val (as-string (cadr prop))))
58 (++ " " key "="
59 (if (string? val) (++ "\"" val "\"") (as-string val)))))
60 (cond ((null? sxml) "")
61 ((string? sxml) sxml)
62 ((symbol? sxml) (symbol->string sxml))
63 ((not (symbol? (car sxml)))
64 (apply string-append (map serialize-sxml sxml)))
65 (else
66 (let ((tag (symbol->string (car sxml)))
67 (props (if (and (cadr? sxml) (eq? (caadr sxml) '@))
68 (cdadr sxml) '()))
69 (vals (if (and (cadr? sxml) (eq? (caadr sxml) '@))
70 (cddr sxml) (cdr sxml))))
71 (if (null? vals)
72 (++ "<"
73 tag
74 (apply ++ (map mk-prop props))
75 " />")
76 (++ "<"
77 tag
78 (apply ++ (map mk-prop props))
79 ">"
80 (apply ++ (map serialize-sxml vals))
81 "</"
82 tag
83 ">"))))))
84
85 (define (sxml->html5 sxml)
86 (++ "<!DOCTYPE html>" (serialize-sxml sxml)))
1 (use-modules (ice-9 match))
2 (use-modules (ice-9 rdelim))
3 (use-modules (ice-9 regex))
4 (use-modules (srfi srfi-9))
5
6 (define-record-type <telml-doc>
7 (make-telml-doc meta content)
8 telml-doc?
9 (meta telml-meta)
10 (content telml-content))
11
12 (define-record-type <meta>
13 (make-meta slug title tags)
14 meta?
15 (slug meta-slug)
16 (title meta-title)
17 (tags meta-tags))
18
19 (define (mk-stream s)
20 (let ((lst (string->list s)))
21 (lambda (msg)
22 (cond ((eq? 'next msg)
23 (if (null? lst)
24 #f
25 (let ((x (car lst)))
26 (set! lst (cdr lst))
27 x)))
28 ((eq? 'peek msg)
29 (if (null? lst) #f (car lst)))
30 ((eq? 'peek2 msg)
31 (if (or (null? lst) (null? (cdr lst))) #f
32 (cadr lst)))
33 ((eq? 'done msg) (null? lst))))))
34
35 (define (special-char? c)
36 (or (eq? c #\\)
37 (eq? c #\{)
38 (eq? c #\})
39 (eq? c #\|)
40 (not c)))
41
42 (define (stream->list s)
43 (if (s 'peek) (cons (s 'next) (stream->list s)) '()))
44
45 (define (ident-char? c)
46 (let ((i (char->integer c)))
47 (or (= i 45) (= i 95)
48 (and (>= i 64) (<= i 90))
49 (and (>= i 97) (<= i 122)))))
50
51 (define (whitespace? c)
52 (let ((i (char->integer c)))
53 (or (= i 9) (= i 10) (= i 13) (= i 32))))
54
55 (define (parse str)
56 (let ((s (mk-stream str)))
57
58 (define (match-char c)
59 (if (eq? (s 'next) c) #t (raise c)))
60
61 (define (parse-tag)
62 (let* ((_ (match-char #\\))
63 (name (parse-tag-name))
64 (_ (skip-whitespace))
65 (_ (match-char #\{))
66 (args (parse-args))
67 (_ (match-char #\})))
68 `(,(string->symbol name) ,@args)))
69
70 (define (parse-text)
71 (define (go)
72 (cond ((and (eq? (s 'peek) #\\) (special-char? (s 'peek2)))
73 (begin (s 'next) (cons (s 'next) (go))))
74 ((special-char? (s 'peek)) '())
75 (else
76 (let ((c (s 'next))) (cons c (go))))))
77 (list->string (go)))
78
79 (define (skip-whitespace)
80 (if (whitespace? (s 'peek))
81 (begin (s 'next) (skip-whitespace))))
82
83 (define (parse-tag-name)
84 (define (go)
85 (if (ident-char? (s 'peek))
86 (cons (s 'next) (go))
87 '()))
88 (list->string (go)))
89
90 (define (parse-args)
91 (if (eq? (s 'peek) #\})
92 '()
93 (let ((f (parse-fragment-list)))
94 (cond ((eq? (s 'peek) #\|) (begin (s 'next) (cons f (parse-args))))
95 ((eq? (s 'peek) #\}) (list f))
96 (else (raise 'unreachable))))))
97
98 (define (parse-fragment)
99 (let ((c (s 'peek)))
100 (cond ((not c) '())
101 ((eq? c #\\) (parse-tag))
102 (else (parse-text)))))
103
104 (define (parse-fragment-list)
105 (cond ((or (not (s 'peek))
106 (eq? (s 'peek) #\})
107 (eq? (s 'peek) #\|)) '())
108 (else (let* ((f (parse-fragment))
109 (fs (parse-fragment-list)))
110 (cons f fs)))))
111
112 (parse-fragment-list)))
113
114 (define basic-tag-list
115 (let ((simple-tag (lambda (n) (cons n (lambda (arg) (list n arg)))))
116 (list-tag (lambda (n) (cons n (lambda args (cons n args))))))
117 (list (simple-tag 'em)
118 (simple-tag 'strong)
119 (simple-tag 'li)
120 (simple-tag 'h1)
121 (simple-tag 'h2)
122 (list-tag 'sub)
123 (cons 'p (lambda (n) `(div (@ (class para)) ,@n)))
124 (list-tag 'ul)
125 (list-tag 'ol)
126 (simple-tag 'blockquote)
127 (cons 'ttcom (lambda (n) `(span (@ (class comment)) ,n)))
128 (cons 'ttkw (lambda (n) `(span (@ (class keyword)) ,n)))
129 (cons 'ttcn (lambda (n) `(span (@ (class constr)) ,n)))
130 (cons 'ttstr (lambda (n) `(span (@ (class string)) ,n)))
131 (cons 'tt (lambda (n) (list 'code n)))
132 (cons 'br (lambda _ `(br)))
133 (cons 'code (lambda (n) `(pre (code ,n))))
134 (cons 'comment (lambda _ ""))
135 (cons 'link (lambda (url name)
136 `(a (@ (href ,(apply string-append url))) ,name)))
137 (cons 'img (lambda (src)
138 `(img (@ (src ,(apply string-append src))))))
139 (cons 'center (lambda (arg)
140 `(div (@ (align "center")) ,arg))))))
141
142 (define standard-tag-list
143 (append basic-tag-list
144 (list (cons 'wd (lambda (wd mn)
145 `(span (@ (class "word"))
146 ,wd
147 (span (@ (class "meaning")) ,mn))))
148 (cons 'sidenote (lambda (arg)
149 `(span (@ (class sidenote)) ,arg)))
150 (cons 'ref (lambda (name)
151 `(label (@ (for ,(car name)) (class "sidenote-number")) ""))))))
152
153 (define feed-tag-list
154 (append basic-tag-list
155 (list (cons 'wd (lambda (wd _) wd))
156 (cons 'sidenote (lambda _ ""))
157 (cons 'ref (lambda _ "")))))
158
159 (define (partition doc lst)
160 (cond ((null? doc) (reverse lst))
161 ((not (car doc)) (partition (cdr doc) (cons '() lst)))
162 (else (partition (cdr doc)
163 (cons (append (car lst) (list (car doc)))
164 (cdr lst))))))
165
166 (define (string-take str i)
167 (substring str 0 i))
168
169 (define (string-drop str i)
170 (let ((l (string-length str)))
171 (substring str i l)))
172
173 (define (gather-para document)
174 (define (split-string text)
175 (let ((m (string-match "\n\n" text)))
176 (if (not m) (list text)
177 (let ((i (match:start m)))
178 (cons (string-take text i)
179 (cons #f (split-string (string-drop text (+ i 2)))))))))
180 (define (go doc)
181 (cond ((null? doc) '())
182 ((not (string? (car doc)))
183 (cons (car doc) (go (cdr doc))))
184 (else
185 (append (split-string (car doc)) (go (cdr doc))))))
186 (partition (go document) '(())))
187
188 (define (string->sexp str)
189 (call-with-input-string str read))
190
191 (define (escape-chars str)
192 (define (go c rest)
193 (cond
194 ((eq? c #\<)
195 (cons #\; (cons #\t (cons #\l (cons #\& rest)))))
196 ((eq? c #\>)
197 (cons #\; (cons #\t (cons #\g (cons #\& rest)))))
198 ((eq? c #\&)
199 (cons #\; (cons #\p (cons #\m (cons #\a (cons #\& rest))))))
200 (else (cons c rest))))
201 (reverse-list->string (string-fold go '() str)))
202
203 (define (telml->sxml telml tags)
204 (define (rec arg)
205 (cond ((string? arg) (escape-chars arg))
206 ((symbol? (car arg))
207 (let ((args (map rec (cdr arg)))
208 (func (assoc (car arg) tags)))
209 (if func
210 (apply (cdr func) args)
211 (raise "Unknown tag"))))
212 (else
213 (map rec arg))))
214 (let ((meta (match telml
215 ((('meta (xs)) . _) xs)
216 (_ #f)))
217 (body (match telml
218 ((('meta _) . xs) xs)
219 (xs xs))))
220 (make-telml-doc
221 (if meta (apply make-meta (string->sexp meta)) '())
222 (map (lambda (x)
223 `(div (@ (class para)) ,(rec x)))
224 (gather-para body)))))
225
226 (define (translate-file filename)
227 (let ((body (with-input-from-file filename read-string)))
228 (telml->sxml (parse body) standard-tag-list)))
229
230 (define (translate-feed-file filename)
231 (let ((body (with-input-from-file filename read-string)))
232 (telml->sxml (parse body) feed-tag-list)))
1 ;; template-ey things and style things
2
3 ;; The date format we're using is {year:04}-{month:02}-{day:02}.
4 (define (date->string date)
5 (strftime "%Y-%m-%d" date))
6
7 (define (date->tz date)
8 (strftime "%Y-%m-%dT%TZ" date))
9
10 (define (post-url post)
11 (let ((date (date->string (post-time post)))
12 (slug (post-slug post)))
13 (format #f "/~a/~a/" date slug)))
14
15 (define (atom-element post)
16 (let ((url (++ "http://what.happens.when.computer" (post-url post))))
17 `(entry
18 (title ,(post-title post))
19 (link (@ (href ,url)))
20 (id ,url)
21 (updated ,(date->tz (post-time post)))
22 (author
23 (name "Getty Ritter")
24 (email "gettyritter@gmail.com"))
25 (content
26 (@ (type "xhtml"))
27 (div (@ (xmlns "http://www.w3.org/1999/xhtml"))
28 ,(post-content post))))))
29
30 (define (atom-feed posts)
31 (let ((updated (date->tz (post-time (car posts)))))
32 `(feed (@ (xmlns "http://www.w3.org/2005/Atom"))
33 (title "what happens when computer")
34 (link (@ (href "http://what.happens.when.computer/feed.xml")
35 (rel "self")))
36 (link (@ (href "http://what.happens.when.computer/")))
37 (updated ,updated)
38 (id "http://what.happens.when.computer/")
39 ,(map (lambda (post) (atom-element post)) posts))))
40
41 ;; the scss stylesheet
42 (define stylesheet
43 '((body
44 (font-family "Palatino, \"Palatino Linotype\", \"Palatino LT STD\", \"Book Antiqua\", Georgia, serif")
45 (font-size 15pt)
46 (background-color "#eeeeee")
47 (counter-reset sidenote-counter))
48
49 (a:link
50 (color "#336699"))
51
52 (a:visited
53 (color "#104070"))
54
55 ((= class all)
56 (width 800px)
57 (margin-left auto)
58 (margin-right auto)
59 (text-align center))
60
61 ((= class menu)
62 (color "#0f0f0f"))
63
64 ((= class main)
65 (padding-right 25%)
66 (text-align justify)
67 (line-height 150%))
68
69 ((= class menu-index:before)
70 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
71 (content "\"/ \""))
72 ((= class menu-archive:before)
73 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
74 (content "\"^ \""))
75 ((= class menu-tags:before)
76 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
77 (content "\"# \""))
78 ((= class menu-about:before)
79 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
80 (content "\"@ \""))
81
82 ((// (= class navlist) li)
83 (display inline)
84 (list-style-type none)
85 (padding-left 10px)
86 (padding-right 20px))
87
88 ((// (= class navlist) ul)
89 (padding-left 100px)
90 (padding-right 100px))
91
92 ((// (= class archive-list) ul)
93 (padding-left 100px)
94 (padding-right 100px))
95
96 ((// (= class archive-list) li)
97 (list-style-type none))
98
99 ((= class tag-entry:before)
100 (content "\"#\""))
101
102 ((// (= class tags) ul)
103 (display inline))
104
105 ((= class para)
106 (padding-top 20px))
107
108 ((= class tag:before)
109 (content "\"#\""))
110
111 ((= class tag)
112 (font-style italic))
113
114 ((= class word)
115 (position relative)
116 (padding "2px 4px 2px 4px")
117 (border-radius "5px")
118 (color "#993366"))
119
120 ((// (= class word) span)
121 (display none))
122
123 ((= class word:hover)
124 (background-color "white"))
125
126 ((// (= class word:hover) span)
127 (display block)
128 (background-color "#cccccc")
129 (border-radius "5px")
130 (color "black")
131 (position absolute)
132 (padding "5px")
133 (top "1.3em")
134 (left "0px")
135 (max-width "400px")
136 (white-space "nowrap")
137 (z-index "50"))
138
139 ((= class sidenote)
140 (float right)
141 (clear right)
142 (margin-right -60%)
143 (font-size 12pt)
144 (line-height 130%)
145 (width 50%))
146
147 ((= class sidenote-number)
148 (counter-increment sidenote-counter))
149
150 ((&& (= class sidenote-number:after) (= class sidenote:before))
151 (content "counter(sidenote-counter) \" \"")
152 (position relative)
153 (color "#3366bb"))
154
155 ((= class sidenote-number:after)
156 (content "counter(sidenote-counter) \" \"")
157 (top -0.5rem)
158 (left -0.1rem)
159 (vertical-align super)
160 (font-size 70%)
161 (color "#3366bb")
162 (font-size: 0.9rem))
163
164 ((= class sidenote:before)
165 (content "counter(sidenote-counter) \". \"")
166 (position absolute)
167 (-webkit-transform "translateX(-100%) translateX(-0.25rem)")
168 (-ms-transform "translateX(-100%) translateX(-0.25rem)")
169 (transform "translateX(-100%) translateX(-0.25rem)"))
170
171 ((= class constr) (color "#993366"))
172 ((= class string) (color "#339966"))
173 ((= class comment) (color "#666666"))
174 ((= class keyword) (color "#336699"))))
175
176 ;; the SXML chunk representing the navigation menu
177 (define menu
178 (let ((menu-item
179 (lambda (name url)
180 `(li (@ (class ,(string-append "menu-" name)))
181 (a (@ (href ,url)) ,name)))))
182 `(ul (@ (class navlist))
183 ,(menu-item "index" "/")
184 ,(menu-item "archive" "/archive/")
185 ,(menu-item "tags" "/tags/")
186 ,(menu-item "about" "/about/"))))
187
188 ;; The SXML chunk representing a page on the site
189 (define (page url title content)
190 `(html
191 (head
192 (meta (@ (http-equiv "Content-Type")
193 (content "application/xhtml+xml; charset=utf-8;")))
194 (meta (@ (property "og:title")
195 (content ,(++ "what happens when computer: " title))))
196 (meta (@ (property "og:url")
197 (content ,(++ "http://what.happens.when.computer" url))))
198 (meta (@ (property "og:image")
199 (content "http://what.happens.when.computer/static/when-computer.png")))
200 (meta (@ (property "og:type")
201 (content "website")))
202 (link (@ (href "/feed.xml")
203 (type "application/atom+xml")
204 (rel "alternate")
205 (title "what happens when computer atom feed")))
206 (link (@ (rel "icon")
207 (type "image/png")
208 (href "http://what.happens.when.computer/static/when-computer-icon.png")))
209 (style (@ (type "text/css")) ,(scss->css stylesheet))
210 (script (@ (type "text/javascript")
211 (src "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML")) "")
212 (title ,(string-append "what happens when computer: " title)))
213 (div (@ (class "all"))
214 (div (@ (class "header"))
215 (h1 "what happens when computer"))
216 (div (@ (class "nav")) ,menu)
217 (div (@ (class "main")) ,content)
218 (div (@ (class "footer")) "&copy; 2016 getty ritter"))))
219
220 ;; if a page has tags, add those tags to the end of the page
221 (define (add-tags chunk tags)
222 (define (tag->link tag)
223 `(a (@ (href ,(format #f "/tag/~a/" tag))
224 (class tag)) ,tag))
225 (if (null? tags)
226 chunk
227 (append chunk
228 `((div (@ (class "tags"))
229 (ul ,(map tag->link tags)))))))
1 (use-modules (srfi srfi-9))
2
3 (define-record-type <post>
4 (make-post file time slug title tags content)
5 post?
6 (file post-file)
7 (time post-time)
8 (slug post-slug)
9 (title post-title)
10 (tags post-tags)
11 (content post-content))