#| Copyright (C) 2008 David Owen This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program 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 Lesser Public License for more details. You should have received a copy of the GNU Lesser Public License along with this program. If not, see . |# (defpackage #:dso-simple-template-templ (:use #:cl) (:import-from #:dso-parse #:defgrammar) (:export #:template #:read-template-from-string #:read-template #:load-template)) (in-package #:dso-simple-template-templ) (defun flatten-chars (tree) (flet ((f (tree) (destructuring-bind (x) tree (aref x 0)))) (coerce (mapcar #'f tree) 'string))) (defun flatten-expression-chars (tree) (flet ((f (tree) (destructuring-bind (x) tree (aref x 0)))) (destructuring-bind (x) tree (coerce (mapcar #'f x) 'string)))) (defgrammar () (expression-start #\{) (expression-finish #\}) (escaped-expression-start ({} 2 2 expression-start) :filter (lambda (x) '("{")) :cclass t) #|(escaped-expression-finish ({} 2 2 expression-finish) :filter (lambda (x) '("}")) :cclass t)|# (newline #\Newline :filter (lambda (x) '(" ")) :cclass t) (expression-char (/ #|escaped-expression-finish|# ((! expression-finish) (^ "."))) :cclass t) (expression ((= expression-start) (+ expression-char) (= expression-finish)) :filter flatten-expression-chars) (body-char (/ escaped-expression-start ((! expression-start) (^ ".")) newline) :cclass t) (body-text (+ body-char) :filter flatten-chars) (simple-template (+ (/ body-text expression)))) (defclass template () ((parts :type list :initarg :parts :reader parts))) (defun read-template-from-string (s) (multiple-value-bind (ok tail tree) (simple-template s) (unless (and ok (string= tail "")) (error "Can't parse the template.")) (make-instance 'template :parts (cdr tree)))) (defun gulp-stream (stream) (let ((s-out (make-string-output-stream)) (buffer (make-sequence 'string 4096))) (do ((n #1=(read-sequence buffer stream) #1#)) ((= n 0)) (write-sequence buffer s-out :end n)) (get-output-stream-string s-out))) (defun read-template (stream) (read-template-from-string (gulp-stream stream))) (defun load-template (filename) (with-open-file (stream filename) (read-template stream)))