diff options
| -rw-r--r-- | Makefile.am | 9 | ||||
| -rw-r--r-- | README.md | 6 | ||||
| -rw-r--r-- | configure.ac | 4 | ||||
| -rw-r--r-- | example/haunt.scm | 11 | ||||
| -rw-r--r-- | example/posts/baz.skr | 29 | ||||
| -rw-r--r-- | haunt/reader/skribe.scm | 44 | ||||
| -rw-r--r-- | haunt/skribe.scm | 82 | ||||
| -rw-r--r-- | haunt/skribe/utils.scm | 85 |
8 files changed, 264 insertions, 6 deletions
diff --git a/Makefile.am b/Makefile.am index b6094c6..541d17f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -60,6 +60,15 @@ SOURCES = \ haunt/serve/mime-types.scm \ haunt/serve/web-server.scm +if HAVE_GUILE_READER + +SOURCES += \ + haunt/skribe.scm \ + haunt/skribe/utils.scm \ + haunt/reader/skribe.scm + +endif + EXTRA_DIST += \ pre-inst-env.in \ README.md \ @@ -50,7 +50,11 @@ To view your creation, run `haunt serve` and browse to Requirements ------------ -GNU Guile >= 2.0.11 +- GNU Guile >= 2.0.11 + +Optional: + +- guile-reader (for Skribe support) Building from Git ----------------- diff --git a/configure.ac b/configure.ac index 46b186c..c623045 100644 --- a/configure.ac +++ b/configure.ac @@ -12,4 +12,8 @@ AC_CONFIG_FILES([scripts/haunt], [chmod +x scripts/haunt]) GUILE_PROGS([2.0.11]) +dnl Guile-reader is needed for Skribe support +GUILE_MODULE_AVAILABLE([have_guile_reader], [(system reader)]) +AM_CONDITIONAL([HAVE_GUILE_READER], [test "x$have_guile_reader" = "xyes"]) + AC_OUTPUT diff --git a/example/haunt.scm b/example/haunt.scm index b292c9c..4095f87 100644 --- a/example/haunt.scm +++ b/example/haunt.scm @@ -1,16 +1,17 @@ -(use-modules (haunt site) - (haunt reader) - (haunt asset) +(use-modules (haunt asset) (haunt builder blog) (haunt builder atom) - (haunt builder assets)) + (haunt builder assets) + (haunt reader) + (haunt reader skribe) + (haunt site)) (site #:title "Built with Guile" #:domain "example.com" #:default-metadata '((author . "Eva Luator") (email . "eva@example.com")) - #:readers (list sxml-reader html-reader) + #:readers (list skribe-reader sxml-reader html-reader) #:builders (list (blog) (atom-feed) (atom-feeds-by-tag) diff --git a/example/posts/baz.skr b/example/posts/baz.skr new file mode 100644 index 0000000..abfb51a --- /dev/null +++ b/example/posts/baz.skr @@ -0,0 +1,29 @@ +(post + :title "Hello, Skribe!" + :date (make-date* 2015 10 09 23 00) + :tags '("foo" "bar" "baz") + + (h1 [Hello!]) + + (p [This is a Skribe document!]) + + (p [Skribe is a ,(em [really]) cool document authoring format that + provides all the power of Scheme whilst giving the user a + means to write literal text without stuffing it into a string + literal. If this sort of thing suits you, be sure to check out + ,(anchor "Skribilo" "http://www.nongnu.org/skribilo/"), too.]) + + (p [Here's a simple list generated by Scheme code:]) + + (ul (map li '("foo" "bar" "baz"))) + + (p [And here's a code snippet of how I build Haunt using GNU Guix:]) + + (source-code + "guix environment -l package.scm +./configure +make") + + (p [And finally, here's an image:]) + + (image "/images/guile-banner.small.png")) diff --git a/haunt/reader/skribe.scm b/haunt/reader/skribe.scm new file mode 100644 index 0000000..cf88504 --- /dev/null +++ b/haunt/reader/skribe.scm @@ -0,0 +1,44 @@ +;;; Haunt --- Static site generator for GNU Guile +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; This file is part of Haunt. +;;; +;;; Haunt is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Haunt is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Haunt. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Skribe post reader. +;; +;;; Code: + +(define-module (haunt reader skribe) + #:use-module (haunt reader) + #:use-module (haunt skribe) + #:use-module (haunt skribe utils) + #:use-module (haunt utils) + #:export (make-skribe-reader + skribe-reader)) + +(define* (make-skribe-reader #:key (modules '((haunt skribe utils)))) + "Return a new Skribe post reader that imports MODULES by default +before reading a document." + (make-reader (make-file-extension-matcher "skr") + (lambda (file) + (let ((file (absolute-file-name file))) + (save-module-excursion + (lambda () + (set-current-module (make-user-module modules)) + (load file %skribe-reader))))))) + +(define skribe-reader (make-skribe-reader)) diff --git a/haunt/skribe.scm b/haunt/skribe.scm new file mode 100644 index 0000000..7ce5457 --- /dev/null +++ b/haunt/skribe.scm @@ -0,0 +1,82 @@ +;;; Haunt --- Static site generator for GNU Guile +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; This file is part of Haunt. +;;; +;;; Haunt is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Haunt is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Haunt. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Skribe reader. +;; +;;; Code: + +(define-module (haunt skribe) + #:use-module ((system reader) #:renamer (symbol-prefix-proc 'r:)) + #:export (%skribe-reader)) + +;; Taken from Skribilo +(define (make-colon-free-token-reader tr) + ;; Stolen from `guile-reader' 0.3. + "If token reader @var{tr} handles the @code{:} (colon) character, remove it +from its specification and return the new token reader." + (let* ((spec (r:token-reader-specification tr)) + (proc (r:token-reader-procedure tr))) + (r:make-token-reader (filter (lambda (chr) + (not (char=? chr #\:))) + spec) + proc))) + +(define &sharp-reader + ;; The reader for what comes after a `#' character. + (let* ((dsssl-keyword-reader ;; keywords à la `#!key' + (r:make-token-reader #\! + (r:token-reader-procedure + (r:standard-token-reader 'keyword))))) + (r:make-reader (cons dsssl-keyword-reader + (map r:standard-token-reader + '(character srfi-4 vector + number+radix boolean + srfi30-block-comment + srfi62-sexp-comment))) + #f ;; use default fault handler + 'reader/record-positions))) + +(define (make-skribe-reader) + (let ((colon-keywords ;; keywords à la `:key' fashion + (r:make-token-reader #\: + (r:token-reader-procedure + (r:standard-token-reader 'keyword)))) + (symbol-misc-chars-tr + ;; Make sure `:' is handled only by the keyword token reader. + (make-colon-free-token-reader + (r:standard-token-reader 'r6rs-symbol-misc-chars)))) + + ;; Note: we use the `r6rs-symbol-*' and `r6rs-number' token readers since + ;; they consider square brackets as delimiters. + (r:make-reader (cons* (r:make-token-reader #\# &sharp-reader) + colon-keywords + symbol-misc-chars-tr + (map r:standard-token-reader + `(whitespace + sexp string r6rs-number + r6rs-symbol-lower-case + r6rs-symbol-upper-case + quote-quasiquote-unquote + semicolon-comment + skribe-exp))) + #f ;; use the default fault handler + 'reader/record-positions))) + +(define %skribe-reader (make-skribe-reader)) diff --git a/haunt/skribe/utils.scm b/haunt/skribe/utils.scm new file mode 100644 index 0000000..edd9977 --- /dev/null +++ b/haunt/skribe/utils.scm @@ -0,0 +1,85 @@ +;;; Haunt --- Static site generator for GNU Guile +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; This file is part of Haunt. +;;; +;;; Haunt is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Haunt is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Haunt. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Skribe helper procedures. +;; +;;; Code: + +(define-module (haunt skribe utils) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) + #:export (post + + p blockquote em + h1 h2 h3 h4 + code pre strong + ul li dl dt dd + anchor + image + source-code + + make-date*)) + +(define (post . metadata+sxml) + "Create a new Skribe post by parsing out the metadata and SXML +contents from METADATA+SXML." + (let loop ((stuff metadata+sxml) + (metadata '())) + (match stuff + (() (values metadata '())) + (((and (? keyword?) (= keyword->symbol key)) value . rest) + (loop rest (alist-cons key value metadata))) + (_ (values metadata stuff))))) + +;; Basic SXML constructors. +(define-syntax-rule (define-simple-sxml-constructors tag ...) + (begin + (define (tag . contents) + `(tag ,@contents)) ...)) + +(define-simple-sxml-constructors + p blockquote + em strong + code samp pre kbd var + cite dfn abbr + h1 h2 h3 h4 + ul ol li dl dt dd) + +(define (anchor text uri) + "Return an anchor SXML node that contains TEXT and points to to URI." + `(a (@ (href ,uri)) ,text)) + +(define* (image uri #:key (alt-text "")) + "Return an image SXML node that points to a URI for an image. +Optionally, the ALT-TEXT keyword argument may be a string that +contains a description of the image." + `(img (@ (src ,uri) (alt ,alt-text)))) + +(define (source-code . code) + "Return an SXML node that wraps CODE in a 'pre' and 'code' tag to +create a code block." + `(pre (code ,code))) + +(define* (make-date* year month day #:optional (hour 0) (minute 0)) + "Create a SRFI-19 date for the given YEAR, MONTH, DAY, HOUR (24-hour +format), and MINUTE." + (let ((tzoffset (tm:gmtoff (localtime (time-second (current-time)))))) + (make-date 0 0 minute hour day month year tzoffset))) |