1 files changed, 105 insertions, 0 deletions

@@ -0,0 +1,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)))))))