Skip to content

Instantly share code, notes, and snippets.

@eli-oat

eli-oat/html.lisp

Forked from markasoftware/html.lisp
Created Jul 26, 2020
Embed
What would you like to do?
html->string (Super simple HTML templating for Lisp)
(defvar *html-void-tags* '(:area :base :br :col :embed :hr :img :input :link
:meta :param :source :track :wbr)
"String designators for self-closing/void tags.
https://html.spec.whatwg.org/multipage/syntax.html#void-elements")
(defvar *html-escapes*
'(#\& "&"
#\< "&lt;"
#\> "&gt;"
#\" "&quot;"))
(defun escape (str)
(declare (string str))
(with-output-to-string (stream)
(loop for ch across str
for escaped = (getf *html-escapes* ch)
do (if escaped
(write-string escaped stream)
(write-char ch stream)))))
(defun html->string (html)
"The argument should be of the form (tag-name (attr-name attr-val) child1
child2 ...). Attributes and children are optional.
(html->string
'(html ()
(head ()
(title () \"My awesome website!\"))
(body ()
\"Hello! I'm Mark.\"
;; No attributes or children:
(br)
(a (href \"https://github.com/markasoftware\") \"My stuff\")
(br)
;; No children:
(img (src \"/cats.jpg\" alt \"My cute cats!\")))))
Since the argument must be quoted, you can use backquote notation to interleave
html and lisp:
`(div ()
\"My name is \"
,*my-name*
\", But you can call me:\"
(br)
(ul ()
,@(mapcar (lambda (name) `(li () ,name)) *my-nicknames*)))
All text and attribute values are escaped properly. You can use keyword symbols
for tag and attribute names if you'd like. There's a hardcoded list of
self-closing tags, such as br and img."
(etypecase html
(null "")
(string (escape html))
(number (write-to-string html))
(cons
;; the &key business forces an odd number of arguments.
(destructuring-bind
(tag &optional ((&rest attrs &key &allow-other-keys)) &rest body)
html
(declare (symbol tag))
;; printf is a child's toy. Honestly, regex might be too!
(format nil "<~A~:{ ~A=\"~A\"~}~:[/>~;>~A</~A>~]"
(string-downcase tag)
(loop for attr-name in attrs by #'cddr
for attr-val in (cdr attrs) by #'cddr
collect
(list (string-downcase attr-name)
(escape (etypecase attr-val
((or string symbol) (string attr-val))
(number (write-to-string attr-val))))))
(not (member tag *html-void-tags* :test #'string=))
(apply #'concatenate 'string (mapcar #'html->string body))
(string-downcase tag))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.