87 lines
3.4 KiB
Common Lisp
87 lines
3.4 KiB
Common Lisp
;; Copyright (c) 2020 Mark Polyakov
|
|
;; Released under the WTFPL (Do What The Fuck You Want To Public License)
|
|
|
|
;; https://gist.github.com/markasoftware/ab357f1b967b3f656d026e33fec3bc0e
|
|
|
|
(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*
|
|
'())
|
|
|
|
(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.
|
|
|
|
Unescaped HTML can be inserted as a string using (:noescape \"<div>\"), for example. This is the
|
|
only time the second argument may be a string, so :noescape can still be used to designate
|
|
<noescape>."
|
|
(etypecase html
|
|
(null "")
|
|
(string (escape html))
|
|
(number (write-to-string html))
|
|
(cons
|
|
(cond
|
|
;; if html is not a valid html element, assume it's a list of html elements and recurse
|
|
((or (null (car html))
|
|
(not (symbolp (car html))))
|
|
(apply #'concatenate 'string (mapcar #'html->string html)))
|
|
((and (eq :noescape (car html))
|
|
(stringp (cadr html)))
|
|
(cadr html))
|
|
(t (destructuring-bind
|
|
;; the &key business forces an even number of arguments.
|
|
(tag &optional ((&rest attrs &key &allow-other-keys)) &rest body)
|
|
html
|
|
(check-type tag symbol)
|
|
;; 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 attr-val) on 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))))))))
|