diff options
Diffstat (limited to 'haunt')
| -rw-r--r-- | haunt/reader/skribe.scm | 44 | ||||
| -rw-r--r-- | haunt/skribe.scm | 82 | ||||
| -rw-r--r-- | haunt/skribe/utils.scm | 85 |
3 files changed, 211 insertions, 0 deletions
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))) |