1; template.ss - Simple template
2;
3;   Copyright (c) 2011  Higepon(Taro Minowa)  <higepon@users.sourceforge.jp>
4;
5;   Redistribution and use in source and binary forms, with or without
6;   modification, are permitted provided that the following conditions
7;   are met:
8;
9;   1. Redistributions of source code must retain the above copyright
10;      notice, this list of conditions and the following disclaimer.
11;
12;   2. Redistributions in binary form must reproduce the above copyright
13;      notice, this list of conditions and the following disclaimer in the
14;      documentation and/or other materials provided with the distribution.
15;
16;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
17;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
18;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
19;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
20;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
22;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
23;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
24;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27;
28 (library (template)
29  (export template-vars template->sexp eval-template eval-template-file ref h template-dir)
30  (import (rnrs)
31          (shorten)
32          (mosh)
33          (mosh file)
34          (srfi :39)
35          (rnrs eval)
36          (rename (mosh cgi) (escape h))
37          (mosh control))
38
39(define template-vars (make-parameter #f))
40(define template-dir (make-parameter #f))
41
42(define-syntax ref
43  (lambda (x)
44    (syntax-case x ()
45      [(_ alist key)
46       #'(assoc-ref alist 'key)])))
47
48(define (eval-template-file file vars . import-spec*)
49  (let1 path (if (template-dir) (string-append (template-dir) "/" file) file)
50    (apply eval-template (file->string path) vars import-spec*)))
51
52(define (eval-template template vars . import-spec*)
53  (parameterize ([template-vars vars])
54    (let1 templ (template->sexp template vars)
55      (if (eof-object? templ)
56          '()
57          (eval templ (apply environment '(rnrs) '(mosh) '(template) '(match) import-spec*))))))
58
59;; http://d.hatena.ne.jp/yuum3/20080203/1202049898
60(define (compile-elem templ port)
61;  (format (current-error-port) "\n\n~s\n\n" templ)
62  (cond [(or (not templ) (string=? templ "")) #t]
63        [((string->regexp "^<%include (((?!%>)(.|\n))*) %>((.|\n)*)" 's) templ) =>
64         (^m
65;          (format (current-error-port) "fild=<~s>" (m 1))
66          (let1 path (if (template-dir) (string-append (template-dir) "/" (m 1)) (m 1))
67            (compile-elem (string-append (file->string path) (if (m 4) (m 4) "")) port)))]
68        ;; comment
69        [((string->regexp "^<%#(((?!%>)(.|\n))*)%>((.|\n)*)" 's) templ) =>
70         (^m
71          (compile-elem (m 4) port))]
72        [((string->regexp "^<%=unsafe(((?!%>)(.|\n))*)%>((.|\n)*)" 's) templ) =>
73         (^m
74          (format port "(display ~a)" (m 1))
75          (compile-elem (m 4) port))]
76        ;; output with escape
77        [((string->regexp "^<%=(((?!%>)(.|\n))*)%>((.|\n)*)" 's) templ) =>
78         (^m
79          (format port "(display (h ~a))" (m 1))
80          (compile-elem (m 4) port))]
81        [((string->regexp "^<%(((?!%>)(.|\n))*)%>((.|\n)*)" 's) templ) =>
82         (^m
83;         (format (current-error-port) "hoge=[~s] [~s]\n" (m 1) (m 4))
84          (format port "~a" (m 1))
85          (compile-elem (m 4) port))]
86        [((string->regexp "^(((?!<%)(.|\n))*)<%((.|\n)*)" 's) templ) =>
87         (^m
88;         (format (current-error-port) "hoge=[~s] [~s]\n" (m 1) (m 4))
89          (format port "(display ~s)" (m 1))
90          (compile-elem (string-append "<%" (if (m 4) (m 4) "")) port))]
91        [else
92         (format port "(display ~s)" templ)]))
93
94(define (template->sexp template variable*)
95  (let-values (([port get-string] (open-string-output-port)))
96    (compile-elem template port)
97    (let1 body (let1 p (open-string-input-port (get-string))
98                 (let loop ([sexp (read p)]
99                            [ret '()])
100                   (if (eof-object? sexp)
101                       (reverse ret)
102                       (loop (read p) (cons sexp ret)))))
103      (if (null? body)
104          #f
105          `(let (,@(map (^v `(,(car v) ,(cdr v))) variable*))
106             ,@body)))))
107)
108
109