From d51b377a23914c7033764158079238f9a1de5edf Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Wed, 2 Mar 2011 15:56:35 +0100
Subject: Support context inheritance.

---
 json-template.lisp | 35 ++++++++++++++++++++++++-----------
 1 file changed, 24 insertions(+), 11 deletions(-)

diff --git a/json-template.lisp b/json-template.lisp
index 30b6a94..5b0a9b8 100644
--- a/json-template.lisp
+++ b/json-template.lisp
@@ -129,21 +129,30 @@
 
 (defun expand-template (template context)
   (with-output-to-string (out)
-    (expand-template-to-stream template context out)))
+    (expand-template-to-stream template (list context) out)))
 
 (defun getcontext (context key)
-  (if (string= key "@")
-      context
-      (getf context (intern (string-upcase (string key)) '#:keyword) nil)))
+  (getf context (intern (string-upcase (string key)) '#:keyword) nil))
 
-(defun expand-template-to-stream (template context stream)
+(defun lookup-context (contexts key)
+  (labels ((lookup-in-stack (context-stack)
+               (if (endp context-stack)
+                   nil
+                   (or (getcontext (first context-stack) key)
+                       (lookup-in-stack (rest context-stack))))))
+    (if (string= key "@")
+        (first contexts)
+        (lookup-in-stack contexts))))
+
+
+(defun expand-template-to-stream (template contexts stream)
   (dolist (thing template)
     (ecase (first thing)
       (:text
        (write-string (second thing) stream))
       (:variable
        (destructuring-bind (variable filter) (cdr thing)
-         (let ((value (getcontext context variable)))
+         (let ((value (lookup-context contexts variable)))
            (format stream "~A"
                    (if filter
                        (funcall (cdr (assoc filter *template-filters*))
@@ -151,15 +160,19 @@
                        value)))))
       (:section
        (destructuring-bind (section branch alternative) (cdr thing)
-         (let ((value (getcontext context section)))
+         (let ((value (lookup-context contexts section)))
+           (print "section")
+           (print value)
            (expand-template-to-stream (if value branch alternative)
-                                      value
+                                      (cons value contexts)
                                       stream))))
       (:repeated-section
+       (print "repeat")
        (destructuring-bind (section branch alternative) (cdr thing)
-         (let ((value (getcontext context section)))
+         (let ((value (lookup-context contexts section)))
+           (print value)
            (if value
                (mapc (lambda (ctx)
-                       (expand-template-to-stream branch ctx stream))
+                       (expand-template-to-stream branch (cons ctx contexts) stream))
                      value)
-               (expand-template-to-stream alternative value stream))))))))
+               (expand-template-to-stream alternative contexts stream))))))))
-- 
cgit v1.2.3