Add support to global template variables.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
diff --git a/template.lisp b/template.lisp
index d1ceacd..eb2d9ba 100644
--- a/template.lisp
+++ b/template.lisp
@@ -22,6 +22,7 @@
(:export
#:*template-output*
#:*template-vars-package*
+ #:define-template-var
#:template-let
#:read-template
#:compile-template
@@ -40,6 +41,11 @@
(defun template-var-key (var)
(intern (symbol-name var) *template-vars-package*))
+(defun template-var-p (var)
+ (and (symbolp var)
+ (eq (symbol-package var)
+ (find-package *template-vars-package*))))
+
(defmacro template-let (bindings &body body)
"By default bind to an existing variable."
(let ((bindings (mapcar (lambda (b)
@@ -56,6 +62,9 @@
bindings)
,@body))))
+(defmacro define-template-var (name value &optional doc)
+ `(defvar ,(template-var-key name) ,value ,doc))
+
;; Template reader
(defvar *template-output* *standard-output*)
@@ -136,14 +145,33 @@
(pushnew x vars :test #'eq)))
(nreverse vars)))
+(defun template-printer-code (template)
+ (let ((vars))
+ (labels ((walk (x)
+ (if (consp x)
+ (cons (walk (car x)) (walk (cdr x)))
+ (if (template-var-p x)
+ (let ((g (assoc x vars)))
+ (if g
+ (cdr g)
+ (cdar (push (cons x (gensym (symbol-name x)))
+ vars))))
+ x))))
+ (let ((body (walk template)))
+ `(lambda ()
+ ,@(if vars
+ `((let ,(mapcar (lambda (var)
+ `(,(cdr var) (when (boundp ',(car var))
+ (symbol-value ',(car var)))))
+ vars)
+ ,@body))
+ body))))))
+
+#+nil
+(template-printer-code (read-template-from-string "plop«= $abc »"))
+
(defun compile-template (template)
- (let ((vars (collect-vars template)))
- (compile nil `(lambda ()
- (symbol-macrolet ,(mapcar (lambda (v)
- `(,v (when (boundp ',v)
- (symbol-value ',v))))
- vars)
- ,@template)))))
+ (compile nil (template-printer-code template)))
;; File-level cache