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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
;;; Wikme --- build a static wiki from a folder full of markdown
;; -*- geiser-scheme-implementation: chicken -*-
;; Copyright (C) C. Duckworth <acdw@acdw.net> under the GPL-MD license.
;; See COPYING for details.
;; Written with help from (and thanks to!) S. Dunlap
(import
(chicken irregex) ; Regex engine
(chicken file posix) ; File access
(chicken port) ; Input/Output ports
(chicken process) ; Processes and pipes
(ersatz) ; Jinja-compatible templating
(filepath) ; File paths
(lowdown) ; Markdown parser
(srfi-19) ; Time library
(srfi-19-io) ; Time input/output
(srfi-152) ; String library
(utf8)) ; UTF8 support
;;; Strings
(define (string-capitalize str)
"Capitalize the first word in STR, and ensure the rest of it is lowercase."
;; Stolen and adapted from MIT/GNU Scheme
(let* ((end (string-length str))
(str* (make-string end)))
(do ((i 0 (+ i 1)))
((= i end))
(string-set! str* i ((if (= i 0) char-upcase char-downcase)
(string-ref str i))))
str*))
(define (slugify str)
"Convert STR to a 'slug', that is, another string suitable for linking.
This function will return the input string, in sentence case, and with all
punctuation and spaces converted to a hypen."
(string-capitalize
(string-trim-both (irregex-replace/all '(+ (~ alnum)) str "-")
(lambda (c)
(char=? c #\-)))))
(define (unslugify slug)
"Convert a SLUG back into a normal string as best as possible.
Because information is lost in slugification, it's impossible to be sure that
the result of this procedure is totally accurate. That is, slugification is not
round-trippable."
(irregex-replace/all '("-") slug " "))
;;; Pages
(define-record-type <page>
(make-page title content source last-edited)
page?
(title page-title page-title-set!)
(content page-content page-content-set!)
(source page-source page-source-set!)
(last-edited page-last-edited page-last-edited-set!))
(define (read-page file)
"Read a <page> record from FILE."
(let* ((src (with-input-from-file file read-string))
(sxml (call-with-input-string src markdown->sxml)))
(title (or (extract-title sxml)
(unslugify (filepath:take-base-name file)))))
(make-page title
sxml
src
(get-last-mtime file)))
(define (get-last-mtime file)
"Figure out FILE's mtime.
First, try running a git log command. If that doesn't work, use the file
system."
(seconds->time
(or (string->number
(string-trim-both
(with-input-from-pipe
(string-append "git -C " _ "log -1 --format=%ct --date=unix " file)
read-string)))
(file-modification-time file))))
;;; Templates
(define (render-template template page
#!key
(last-updated-format "~4")
(escape-html #f)
)
"Render PAGE using TEMPLATE.
TEMPLATE is a jinja2-compatible template file and PAGE is a <page> record type.
TEMPLATE will be passed the following variables:
- title: the page title
- body: the page body as HTML, escaped depending on ESCAPE-HTML (default #f).
- last_updated: the time the page was updated in LAST-UPDATED-FORMAT
(default ISO-8601 year-month-day-hour-minute-second-timezone)"
(from-file template
#:env (template-std-env #:autoescape escape-html)
#:models `((title . ,(Tstr (page-title page)))
(body . ,(Tstr (page-content page)))
(last_updated . ,(Tstr (format-date #f last-updated-format
(page-last-edited page)))))))
|
