paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

stuff...

Browse source
This commit is contained in:
Francis St-Amour 2023-12-21 12:40:05 -05:00
parent 90ebcd6e82
commit a4bf72232f
1 changed files with 27 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
src/flute.lisp
View file

@ -84,9 +84,13 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
(setf (gethash :html *builtin-elements*) t) (setf (gethash :html *builtin-elements*) t)
(defmacro define-builtin-element (element-name) (defmacro define-builtin-element (element-name)
`(defun ,element-name (&rest attrs-and-children) `(progn
(multiple-value-bind (attrs children) (defun ,element-name (&rest attrs-and-children)
(split-attrs-and-children attrs-and-children) (multiple-value-bind (attrs children)
(split-attrs-and-children attrs-and-children)
(make-builtin-element :tag (string-downcase (mkstr ',element-name))
:attrs attrs :children children)))
(defun ,(alexandria:symbolicate element-name '*) (attrs children)
(make-builtin-element :tag (string-downcase (mkstr ',element-name)) (make-builtin-element :tag (string-downcase (mkstr ',element-name))
:attrs attrs :children children)))) :attrs attrs :children children))))
@ -95,6 +99,7 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
,@(mapcan (lambda (e) ,@(mapcan (lambda (e)
(list `(define-builtin-element ,e) (list `(define-builtin-element ,e)
`(setf (gethash (make-keyword ',e) *builtin-elements*) t) `(setf (gethash (make-keyword ',e) *builtin-elements*) t)
`(setf (gethash (make-keyword ,(format nil "~a*" e)) *builtin-elements*) t)
`(export ',e))) `(export ',e)))
element-names))) element-names)))
@ -114,6 +119,16 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
(format stream " ~{~a=~s~^ ~}" (alist-plist* (attrs-alist attrs))) (format stream " ~{~a=~s~^ ~}" (alist-plist* (attrs-alist attrs)))
(format stream ""))) (format stream "")))
(defun self-closing-p (element)
(gethash (if (symbolp element)
element
(intern (string-downcase element) #.*package*))
#.(let ((self-closing-tags (make-hash-table)))
(loop :for tag :in '(area base br col embed hr img input keygen
link meta param source track wbr)
:do (setf (gethash tag self-closing-tags) tag))
self-closing-tags)))
(defmethod print-object ((element element) stream) (defmethod print-object ((element element) stream)
(if (element-children element) (if (element-children element)
(format stream (if (rest (element-children element)) (format stream (if (rest (element-children element))
@ -123,7 +138,12 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
(element-attrs element) (element-attrs element)
(element-children element) (element-children element)
(element-tag element)) (element-tag element))
(format stream "<~a~a>" (element-tag element) (element-attrs element)))) (format stream (if (self-closing-p (element-tag element))
"<~a~a>"
"<~a~a></~a>")
(element-tag element)
(element-attrs element)
(element-tag element))))
(defmethod print-object ((element builtin-element-with-prefix) stream) (defmethod print-object ((element builtin-element-with-prefix) stream)
(format stream "~a~%" (element-prefix element)) (format stream "~a~%" (element-prefix element))
@ -134,14 +154,14 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
(multiple-value-bind (,g!attrs ,g!children) (multiple-value-bind (,g!attrs ,g!children)
(split-attrs-and-children ,g!attrs-and-children) (split-attrs-and-children ,g!attrs-and-children)
(let ((,g!element (let ((,g!element
(make-user-element :tag (string-downcase ',name) :attrs ,g!attrs (make-user-element :tag (string-downcase ',name) :attrs ,g!attrs
:children ,g!children))) :children ,g!children)))
(setf (user-element-expander ,g!element) (setf (user-element-expander ,g!element)
(lambda (tag attrs children) (lambda (tag attrs children)
(declare (ignorable tag attrs children)) (declare (ignorable tag attrs children))
(let ,(mapcar (lambda (arg) (let ,(mapcar (lambda (arg)
(list arg `(attr attrs (make-keyword ',arg)))) (list arg `(attr attrs (make-keyword ',arg))))
args) args)
(progn ,@body)))) (progn ,@body))))
,g!element)))) ,g!element))))