Commit ef3984600db40227bb2bb1d49b0779be1fb6433a - vdg-old

Mostly early scaffolding, no changes to the source code Getty Ritter 8 years ago

13 changed file(s) with 817 addition(s) and 0 deletion(s). Collapse all Expand all

-0

Makefile less more

(New empty file)

+10

-0

README.md less more

	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

-0

configure less more

	1	#!/bin/sh
	2
	3	# XXX: TODO
	4	exit 0

-0

docs/scss.pandoc less more

(New empty file)

-0

docs/sxml.pandoc less more

(New empty file)

-0

docs/telml-extensions.pandoc less more

(New empty file)

-0

docs/telml.pandoc less more

(New empty file)

+65

-0

docs/van-de-graaf.pandoc less more

	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>

+180

-0

src/generate.scm less more

	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)))))

+86

-0

src/libs.scm less more

	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)))

+232

-0

src/telml.scm less more

	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)))

+229

-0

src/templates.scm less more

	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")) "© 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)))))))

+11

-0

src/types.scm less more

	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))