1 files changed, 0 insertions, 290 deletions
diff --git a/wikme-impl.scm b/wikme-impl.scm
deleted file mode 100644
index 2097af7..0000000
--- a/wikme-impl.scm
+++ /dev/null

@@ -1,290 +0,0 @@
-;;; Wikme --- convert a directory of markdown files into a static wiki
-(import (chicken file)
-        (chicken file posix)
-        (chicken format)
-        (chicken io)
-        (chicken irregex)
-        (chicken pathname)
-        (chicken port)
-        (chicken process)
-        (chicken process-context)
-        (chicken string)
-        (chicken time posix)
-        (cmark)
-        (regex)                         ; XXX: deprecated upstream
-        (srfi-13))
-;;; Records
-(define-record-type <wiki>
-  ;;; A wiki is a collection of pages and assorted metadata.
-  (make-wiki base-url                   ; base URL for links
-             origin-dir                 ; origin directory
-             destination-dir            ; destination directory
-             pages                      ; list of <page>s
-             defaults                   ; alist of default properties for pages
-             )
-  wiki?
-  (base-url wiki-base-url (setter wiki-base-url))
-  (origin-dir wiki-origin-dir (setter wiki-origin-dir))
-  (destination-dir wiki-destination-dir (setter wiki-destination-dir))
-  (pages wiki-pages (setter wiki-pages))
-  (defaults wiki-defaults (setter wiki-defaults)))
-(define (wiki-default-ref wiki key)
-  (alist-ref key (wiki-defaults wiki)))
-(define (wiki-default-set! wiki key value)
-  (set! (wiki-defaults wiki) (cons (cons key value)
-                                   (wiki-defaults wiki))))
-(define-record-type <page>
-  ;;; A wiki page is a mapping between source and body content, and between the
-  ;;; page's origin and its destination files, wrapped together with some
-  ;;; metadata.
-  (make-page source                     ; source markup
-             body                       ; rendered page body
-             origin                     ; source filename (relative to wiki)
-             destination                ; destination file (relative to wiki)
-             template                   ; this page's template
-             source-transformers        ; list of source transformer functions
-             path-transformers          ; list of path transformers
-             wiki                       ; the <wiki> this page is a part of
-             meta                       ; alist of metadata tags
-             )
-  page?
-  (source page-source (setter page-source))
-  (body page-body (setter page-body))
-  (origin page-origin (setter page-origin))
-  (destination page-destination (setter page-destination))
-  (template page-template (setter page-template))
-  (source-transformers page-source-transformers (setter page-source-transformers))
-  (path-transformers page-path-transformers (setter page-path-transformers))
-  (wiki page-wiki (setter page-wiki))
-  (meta page-meta (setter page-meta)))
-(define (page-meta-ref page key)
-  ;;; Get metadata KEY from PAGE.
-  (alist-ref key (page-meta page)))
-(define (page-meta-set! page key value)
-  ;;; Set KEY in PAGE's metadata to VALUE.
-  (set! (page-meta page) (cons (cons key value)
-                               (page-meta page))))
-;;; Transformers
-(define (transform page input transformers)
-  (let loop ((ts transformers)
-             (it input))
-    (if (null? ts)
-        it
-        (loop (cdr ts)
-              ;; This is ugly but I need it for some things (namely, `indexify').
-              ;; Transformers can add an #!optional _ parameter to ignore it.
-              ((car ts) it page)))))
-(define (transform-source! page)
-  ;;; Transform PAGE's source to html.
-  ;; Passes page-source through each of page-transformers in order and sets
-  ;; page-body to the result.
-  (set! (page-body page)
-    (transform page (page-source page) (page-source-transformers page))))
-(define (transform-path! page)
-  ;;; Transform PAGE's path from input directory to output directory.
-  ;; This will take the page-origin  and transform it using
-  ;; page-path-transformers.  It will then set page-destination to the result.
-  (set! (page-destination page)
-    (transform page (page-origin page) (page-path-transformers page))))
-;; Cmark wrapper
-(define (page-cmark->html input #!optional page)
-  (cmark->html input (page-meta-ref page 'safe)))
-;;; Templates
-(define (render-template template env)
-  ;;; Render TEMPLATE using ENV.
-  ;; TEMPLATE is a string with {{placeholders}}; ENV is an alist of key-value
-  ;; pairs to insert into the TEMPLATE's placeholders.
-  ;; XXX: Depends on the deprecated library (regex) which is just glue around
-  ;; irregex (apparently).
-  (string-substitute* template (env->replacements env)))
-(define (env->replacements env)
-  ;;; Convert an ENV alist of the form `((X . Y) ...) to '(("{{X}}" . "Y") ...).
-  ;; X's are template variables and Y's are the values of those variables.  In
-  ;; the template, both "{{X}}" and "{{ X }}" will be replaced.
-  ;; If Y is a thunk, call it.
-  (let loop ((env env)
-             (res '()))
-    (if (null? env)
-        res
-        (let* ((this (car env))
-               (rest (cdr env))
-               (key (->string (car this)))
-               (val (if (procedure? (cdr this))
-                        ((cdr this))
-                        (->string (cdr this)))))
-          (loop (cdr env)
-                (append (list (cons (sprintf "{{~a}}" key) val)
-                              (cons (sprintf "{{ ~a }}" key) val))
-                        res))))))
-(define (render page)
-  (render-template (page-template page)
-                   (append `((source . ,(page-source page))
-                             (body . ,(page-body page))
-                             (origin . ,(page-origin page))
-                             (destination . ,(page-destination page)))
-                           (page-meta page))))
-;;; Links
-(define wiki-link-sre
-  ;;; An SRE for [[wiki-style links|with optional titles]].
-  '(: "[["
-      (submatch-named pname (+ (~ "|")))
-      (? (submatch "|" (submatch-named ptitle (*? nonl))))
-      "]]"))
-(define (wikify-links text #!optional page)
-  ;;; Convert [[Wiki-style links]] to <a> tags in TEXT.
-  ;; The base url of PAGE's wiki is prepended to the generated links.
-  (irregex-replace/all wiki-link-sre
-                       text
-                       (lambda (m)
-                         (let* ((pname (irregex-match-substring m 'pname))
-                                (ptitle (or (irregex-match-substring m 'ptitle)
-                                            pname)))
-                           (sprintf "<a href=\"~a\">~a</a>"
-                                    (linkify pname
-                                             (if page
-                                                 (wiki-base-url
-                                                  (page-wiki page))
-                                                 ""))
-                                    ptitle)))))
-(define (linkify pagename base-url)
-  ;;; Turn a page name into a link suitable for an <a> tag.
-  (make-pathname (list base-url (slugify pagename))
-                 "index"
-                 "html"))
-(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 (string-capitalize str)
-  ;;; Capitalize the first word in STR, and ensure the rest of it is lowercase.
-  ;; Returns the new string.
-  (let loop ((cs (string->list str))
-             (it #f))
-    (if (null? cs)
-        (reverse-list->string it)
-        (loop (cdr cs)
-              (if it
-                  (cons (char-downcase (car cs)) it)
-                  (list (char-upcase (car cs))))))))
-(define (unslugify str)
-  ;;; 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 "-" str " "))
-(define (path-relativize path dir)
-  ;;; Return PATH relative to DIR.
-  ;; Currently, this doesn't do anything special if PATH begins with / or ~ ...
-  ;; it probably should.
-  (let ((path (normalize-pathname path))
-        (dir (normalize-pathname dir)))
-    (make-pathname
-     dir
-     (string-trim (string-drop path (string-prefix-length path dir))
-                  (lambda (c) (char=? c #\/))))))
-;;; Build a page
-(define (file->page file wiki
-                    #!key
-                    (source
-                     (with-input-from-file file read-string))
-                    (template
-                     (wiki-default-ref wiki 'template))
-                    (source-transformers
-                     (wiki-default-ref wiki 'source-transformers))
-                    (path-transformers
-                     (wiki-default-ref wiki 'path-transformers)))
-  (let ((page (make-page source
-                         #f
-                         (path-relativize file (wiki-origin-dir wiki))
-                         #f
-                         (with-input-from-file template read-string)
-                         source-transformers
-                         path-transformers
-                         wiki
-                         '())))
-    (transform-source! page)
-    (page-meta-set! page 'title (guess-title page))
-    (page-meta-set! page 'last-updated (guess-last-updated page))
-    (transform-path! page)
-    (set! (wiki-pages wiki) (cons page (wiki-pages wiki)))
-    page))
-(define (guess-title page)
-  ;;; Guess the title from PAGE.
-  ;; If the first line is a Markdown H1 ("# ..."), use that as the title.
-  ;; Otherwise, unslugify the basename of the PAGE file to use as the title.
-  (let* ((str (page-body page))
-         (m (irregex-match '(: "#" (* whitespace) ($ (* nonl)) (* any))
-                           str)))
-    (if (irregex-match-data? m)
-        (irregex-match-substring m 1)
-        (unslugify (basename (page-origin page))))))
-(define (basename file)
-  (receive (_ base _) (decompose-pathname file)
-    base))
-(define (indexify _origin page)
-  ;;; Transform a PAGE's filename from a markdown source to an html destination.
-  (make-pathname (slugify (page-meta-ref page 'title))
-                 "index"
-                 "html"))
-(define (guess-last-updated page)
-  ;;; Guess when PAGE was last edited.
-  ;; Tries to use git, but falls back to mtime.
-  (let ((f (path-relativize (page-origin page)
-                            (wiki-origin-dir (page-wiki page)))))
-    (time->string
-     (seconds->local-time
-      (or #;
-       (string->number
-       (string-trim-both
-       (with-input-from-pipe
-       (sprintf "git log -1 --format=%ct --date=unix -C ~s ~s"
-       (wiki-origin-dir (page-wiki page))
-       f)
-       read-string)))
-       (file-modification-time f))))))
-(define (page->file page)
-  ;;; Write PAGE to its destination file.
-  (let ((dest (make-pathname (wiki-destination-dir (page-wiki page))
-                             (page-destination page))))
-    (receive (dir _ _) (decompose-pathname dest)
-      (create-directory dir 'parents))
-    (with-output-to-file dest
-      (lambda ()
-        (write-string (render page))))))

diff --git a/wikme-impl.scm b/wikme-impl.scm deleted file mode 100644 index 2097af7..0000000 --- a/wikme-impl.scm +++ /dev/null
@@ -1,290 +0,0 @@
1	;;; Wikme --- convert a directory of markdown files into a static wiki
2
3	(import (chicken file)
4	(chicken file posix)
5	(chicken format)
6	(chicken io)
7	(chicken irregex)
8	(chicken pathname)
9	(chicken port)
10	(chicken process)
11	(chicken process-context)
12	(chicken string)
13	(chicken time posix)
14	(cmark)
15	(regex) ; XXX: deprecated upstream
16	(srfi-13))
17
18	;;; Records
19
20	(define-record-type <wiki>
21	;;; A wiki is a collection of pages and assorted metadata.
22	(make-wiki base-url ; base URL for links
23	origin-dir ; origin directory
24	destination-dir ; destination directory
25	pages ; list of <page>s
26	defaults ; alist of default properties for pages
27	)
28	wiki?
29	(base-url wiki-base-url (setter wiki-base-url))
30	(origin-dir wiki-origin-dir (setter wiki-origin-dir))
31	(destination-dir wiki-destination-dir (setter wiki-destination-dir))
32	(pages wiki-pages (setter wiki-pages))
33	(defaults wiki-defaults (setter wiki-defaults)))
34
35	(define (wiki-default-ref wiki key)
36	(alist-ref key (wiki-defaults wiki)))
37
38	(define (wiki-default-set! wiki key value)
39	(set! (wiki-defaults wiki) (cons (cons key value)
40	(wiki-defaults wiki))))
41
42	(define-record-type <page>
43	;;; A wiki page is a mapping between source and body content, and between the
44	;;; page's origin and its destination files, wrapped together with some
45	;;; metadata.
46	(make-page source ; source markup
47	body ; rendered page body
48	origin ; source filename (relative to wiki)
49	destination ; destination file (relative to wiki)
50	template ; this page's template
51	source-transformers ; list of source transformer functions
52	path-transformers ; list of path transformers
53	wiki ; the <wiki> this page is a part of
54	meta ; alist of metadata tags
55	)
56	page?
57	(source page-source (setter page-source))
58	(body page-body (setter page-body))
59	(origin page-origin (setter page-origin))
60	(destination page-destination (setter page-destination))
61	(template page-template (setter page-template))
62	(source-transformers page-source-transformers (setter page-source-transformers))
63	(path-transformers page-path-transformers (setter page-path-transformers))
64	(wiki page-wiki (setter page-wiki))
65	(meta page-meta (setter page-meta)))
66
67	(define (page-meta-ref page key)
68	;;; Get metadata KEY from PAGE.
69	(alist-ref key (page-meta page)))
70
71	(define (page-meta-set! page key value)
72	;;; Set KEY in PAGE's metadata to VALUE.
73	(set! (page-meta page) (cons (cons key value)
74	(page-meta page))))
75
76	;;; Transformers
77
78	(define (transform page input transformers)
79	(let loop ((ts transformers)
80	(it input))
81	(if (null? ts)
82	it
83	(loop (cdr ts)
84	;; This is ugly but I need it for some things (namely, `indexify').
85	;; Transformers can add an #!optional _ parameter to ignore it.
86	((car ts) it page)))))
87
88	(define (transform-source! page)
89	;;; Transform PAGE's source to html.
90	;; Passes page-source through each of page-transformers in order and sets
91	;; page-body to the result.
92	(set! (page-body page)
93	(transform page (page-source page) (page-source-transformers page))))
94
95	(define (transform-path! page)
96	;;; Transform PAGE's path from input directory to output directory.
97	;; This will take the page-origin and transform it using
98	;; page-path-transformers. It will then set page-destination to the result.
99	(set! (page-destination page)
100	(transform page (page-origin page) (page-path-transformers page))))
101
102	;; Cmark wrapper
103	(define (page-cmark->html input #!optional page)
104	(cmark->html input (page-meta-ref page 'safe)))
105
106	;;; Templates
107
108	(define (render-template template env)
109	;;; Render TEMPLATE using ENV.
110	;; TEMPLATE is a string with {{placeholders}}; ENV is an alist of key-value
111	;; pairs to insert into the TEMPLATE's placeholders.
112	;; XXX: Depends on the deprecated library (regex) which is just glue around
113	;; irregex (apparently).
114	(string-substitute* template (env->replacements env)))
115
116	(define (env->replacements env)
117	;;; Convert an ENV alist of the form `((X . Y) ...) to '(("{{X}}" . "Y") ...).
118	;; X's are template variables and Y's are the values of those variables. In
119	;; the template, both "{{X}}" and "{{ X }}" will be replaced.
120	;; If Y is a thunk, call it.
121	(let loop ((env env)
122	(res '()))
123	(if (null? env)
124	res
125	(let* ((this (car env))
126	(rest (cdr env))
127	(key (->string (car this)))
128	(val (if (procedure? (cdr this))
129	((cdr this))
130	(->string (cdr this)))))
131	(loop (cdr env)
132	(append (list (cons (sprintf "{{~a}}" key) val)
133	(cons (sprintf "{{ ~a }}" key) val))
134	res))))))
135
136	(define (render page)
137	(render-template (page-template page)
138	(append `((source . ,(page-source page))
139	(body . ,(page-body page))
140	(origin . ,(page-origin page))
141	(destination . ,(page-destination page)))
142	(page-meta page))))
143
144	;;; Links
145
146	(define wiki-link-sre
147	;;; An SRE for [[wiki-style links\|with optional titles]].
148	'(: "[["
149	(submatch-named pname (+ (~ "\|")))
150	(? (submatch "\|" (submatch-named ptitle (*? nonl))))
151	"]]"))
152
153	(define (wikify-links text #!optional page)
154	;;; Convert [[Wiki-style links]] to <a> tags in TEXT.
155	;; The base url of PAGE's wiki is prepended to the generated links.
156	(irregex-replace/all wiki-link-sre
157	text
158	(lambda (m)
159	(let* ((pname (irregex-match-substring m 'pname))
160	(ptitle (or (irregex-match-substring m 'ptitle)
161	pname)))
162	(sprintf "<a href=\"~a\">~a</a>"
163	(linkify pname
164	(if page
165	(wiki-base-url
166	(page-wiki page))
167	""))
168	ptitle)))))
169
170	(define (linkify pagename base-url)
171	;;; Turn a page name into a link suitable for an <a> tag.
172	(make-pathname (list base-url (slugify pagename))
173	"index"
174	"html"))
175
176	(define (slugify str)
177	;;; Convert STR to a 'slug', that is, another string suitable for linking.
178	;; This function will return the input string, in sentence case, and with all
179	;; punctuation and spaces converted to a hypen.
180	(string-capitalize
181	(string-trim-both (irregex-replace/all '(+ (~ alnum)) str "-")
182	(lambda (c)
183	(char=? c #\-)))))
184
185	(define (string-capitalize str)
186	;;; Capitalize the first word in STR, and ensure the rest of it is lowercase.
187	;; Returns the new string.
188	(let loop ((cs (string->list str))
189	(it #f))
190	(if (null? cs)
191	(reverse-list->string it)
192	(loop (cdr cs)
193	(if it
194	(cons (char-downcase (car cs)) it)
195	(list (char-upcase (car cs))))))))
196
197	(define (unslugify str)
198	;;; Convert a SLUG back into a normal string as best as possible.
199	;; Because information is lost in slugification, it's impossible to be sure
200	;; that the result of this procedure is totally accurate. That is,
201	;; slugification is not round-trippable.
202	(irregex-replace/all "-" str " "))
203
204	(define (path-relativize path dir)
205	;;; Return PATH relative to DIR.
206	;; Currently, this doesn't do anything special if PATH begins with / or ~ ...
207	;; it probably should.
208	(let ((path (normalize-pathname path))
209	(dir (normalize-pathname dir)))
210	(make-pathname
211	dir
212	(string-trim (string-drop path (string-prefix-length path dir))
213	(lambda (c) (char=? c #\/))))))
214
215	;;; Build a page
216
217	(define (file->page file wiki
218	#!key
219	(source
220	(with-input-from-file file read-string))
221	(template
222	(wiki-default-ref wiki 'template))
223	(source-transformers
224	(wiki-default-ref wiki 'source-transformers))
225	(path-transformers
226	(wiki-default-ref wiki 'path-transformers)))
227	(let ((page (make-page source
228	#f
229	(path-relativize file (wiki-origin-dir wiki))
230	#f
231	(with-input-from-file template read-string)
232	source-transformers
233	path-transformers
234	wiki
235	'())))
236	(transform-source! page)
237	(page-meta-set! page 'title (guess-title page))
238	(page-meta-set! page 'last-updated (guess-last-updated page))
239	(transform-path! page)
240	(set! (wiki-pages wiki) (cons page (wiki-pages wiki)))
241	page))
242
243	(define (guess-title page)
244	;;; Guess the title from PAGE.
245	;; If the first line is a Markdown H1 ("# ..."), use that as the title.
246	;; Otherwise, unslugify the basename of the PAGE file to use as the title.
247	(let* ((str (page-body page))
248	(m (irregex-match '(: "#" (* whitespace) ($ (* nonl)) (* any))
249	str)))
250	(if (irregex-match-data? m)
251	(irregex-match-substring m 1)
252	(unslugify (basename (page-origin page))))))
253
254	(define (basename file)
255	(receive (_ base _) (decompose-pathname file)
256	base))
257
258	(define (indexify _origin page)
259	;;; Transform a PAGE's filename from a markdown source to an html destination.
260	(make-pathname (slugify (page-meta-ref page 'title))
261	"index"
262	"html"))
263
264	(define (guess-last-updated page)
265	;;; Guess when PAGE was last edited.
266	;; Tries to use git, but falls back to mtime.
267	(let ((f (path-relativize (page-origin page)
268	(wiki-origin-dir (page-wiki page)))))
269	(time->string
270	(seconds->local-time
271	(or #;
272	(string->number
273	(string-trim-both
274	(with-input-from-pipe
275	(sprintf "git log -1 --format=%ct --date=unix -C ~s ~s"
276	(wiki-origin-dir (page-wiki page))
277	f)
278	read-string)))
279	(file-modification-time f))))))
280
281	(define (page->file page)
282	;;; Write PAGE to its destination file.
283	(let ((dest (make-pathname (wiki-destination-dir (page-wiki page))
284	(page-destination page))))
285	(receive (dir _ _) (decompose-pathname dest)
286	(create-directory dir 'parents))
287	(with-output-to-file dest
288	(lambda ()
289	(write-string (render page))))))
290