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