summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am9
-rw-r--r--README.md6
-rw-r--r--configure.ac4
-rw-r--r--example/haunt.scm11
-rw-r--r--example/posts/baz.skr29
-rw-r--r--haunt/reader/skribe.scm44
-rw-r--r--haunt/skribe.scm82
-rw-r--r--haunt/skribe/utils.scm85
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 \
diff --git a/README.md b/README.md
index a0bd76f..1d856a5 100644
--- a/README.md
+++ b/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)))