updated deftemplate to look and feel more like defun

This commit is contained in:
a. fox 2024-01-23 21:10:46 -05:00
parent 683e385bc7
commit 221bcaba68
2 changed files with 21 additions and 17 deletions

View File

@ -84,11 +84,10 @@ Templates are also capable of being passed parameters thru HTML tag attributes.
an example of what I'm referring to:
```common-lisp
(deftemplate "MyTag"
#'(lambda (inner &key parm1 parm2)
(if parm1
(format nil "<div>~A</div>" inner)
(format nil "<strong>parm2: ~A</strong>~%~A" parm2 inner))))
(deftemplate "MyTag" (inner &key parm1 parm2)
(if parm1
(format nil "<div>~A</div>" inner)
(format nil "<strong>parm2: ~A</strong>~%~A" parm2 inner)))
```
```html

View File

@ -40,18 +40,22 @@
"</body>")
"</html>")))
(defun deftemplate (tag format)
"defines a new template denoted with TAG.
FORMAT is either a format-compatible string or a function that accepts one parameter (the inner-html)
if additional configuration is desired, html attributes of the form attr=\"value\" are converted into :ATTR \"value\" and applied to the function at render time"
(defmacro deftemplate (tag lambda-list &body body)
"defines a new template denoted with TAG."
(log:info "defining new template for tag ~A" tag)
(setf (gethash tag *custom-tags*)
(typecase format
(string (lambda (in &rest _)
(declare (ignore _))
(format nil format in)))
(compiled-function format))))
(let ((inner (gensym "INNER"))
(arg (gensym "ARG"))
(has-rest (member '&rest lambda-list)))
`(setf (gethash ,tag *custom-tags*)
(lambda ,(if lambda-list
(if has-rest lambda-list
(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*
@ -73,5 +77,6 @@ if TEMPLATE does not specify a custom tag we just apply format to RAW-INPUT with
(apply (gethash template *custom-tags*)
`(,(apply #'format `(nil ,cleaned ,@data))
,@(when attributes
(parse-attributes (str:trim attributes))))))
(parse-attributes (str:trim attributes)))
:allow-other-keys t)))
(apply #'format `(nil ,raw-input ,@data))))