From d309f7d3d1336d6167fec9f16bf8599e691559d7 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Wed, 2 Mar 2011 18:45:42 +0100 Subject: =?UTF-8?q?Support=20compound=20substitutions=20(i.e.=20forms=20li?= =?UTF-8?q?ke=20=E2=80=9Ca.b.c=E2=80=9D).?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- json-template.lisp | 33 ++++++++++++++++++++++++--------- 1 file changed, 24 insertions(+), 9 deletions(-) diff --git a/json-template.lisp b/json-template.lisp index 4ea4b9a..2acc811 100644 --- a/json-template.lisp +++ b/json-template.lisp @@ -131,18 +131,33 @@ (with-output-to-string (out) (expand-template-to-stream template (list context) out))) -(defun getcontext (context key) - (getf context (intern (string-upcase (string key)) '#:keyword) nil)) +(defun getcontext (context key &aux (result context)) + (dolist (key-component key result) + (setq result + (getf result + key-component + nil)))) + +(defun listify-key (key &optional (start 0)) + (let ((dot (position #\. key :start start))) + (if dot + (cons (intern (string-upcase (subseq key start dot)) + '#:keyword) + (listify-key key (1+ dot))) + (list (intern (string-upcase (subseq key start)) + '#:keyword))))) (defun lookup-context (contexts key) + (when (string= key "@") + (return-from lookup-context (first contexts))) + (unless (listp key) + (setq key (listify-key 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)))) + (if (endp context-stack) + nil + (or (getcontext (first context-stack) key) + (lookup-in-stack (rest context-stack)))))) + (lookup-in-stack contexts))) (defun expand-template-to-stream (template contexts stream) -- cgit v1.2.3