focks
/
lspx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

moved DEFTEMPLATE logging into the macro

This commit is contained in:
a. fox 2024-01-23 21:40:35 -05:00
parent 39d2bc2c3f
commit 0ec453f86b
1 changed files with 15 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
templates.lisp
View File

@ -42,24 +42,25 @@
(defmacro deftemplate (tag lambda-list &body body)
"defines a new template denoted with TAG."
(log:info "defining new template for tag ~A" tag)
(let ((inner (gensym "INNER"))
(arg (gensym "ARG"))
(has-rest (member '&rest lambda-list))
(has-keys (search '(&key) lambda-list)))
`(setf (gethash ,tag *custom-tags*)
(lambda ,(if lambda-list
(if has-rest lambda-list
(if has-keys `(,@(subseq lambda-list 0 has-keys)
&rest ,arg
,@(subseq lambda-list has-keys))
(append lambda-list (list '&rest arg))))
`(,inner &rest ,arg))
,@(typecase (car body)
(string `((declare (ignore ,arg))
(format nil ,(car body) ,inner)))
(list (if has-rest body
(append `((declare (ignore ,arg))) body))))))))
`(progn
(log:info "defining new template for tag ~A" ,tag)
(setf (gethash ,tag *custom-tags*)
(lambda ,(if lambda-list
(if has-rest lambda-list
(if has-keys `(,@(subseq lambda-list 0 has-keys)
&rest ,arg
,@(subseq lambda-list has-keys))
(append lambda-list (list '&rest arg))))
`(,inner &rest ,arg))
,@(typecase (car body)
(string `((declare (ignore ,arg))
(format nil ,(car body) ,inner)))
(list (if has-rest body
(append `((declare (ignore ,arg))) body)))))))))
(defun maybe-render-template (template raw-input &rest data)
"checks for TEMPLATE in *custom-tags*