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

Add defhsx macro

Browse source
This commit is contained in:
paku 2024-05-27 11:10:11 +09:00
parent 9d0a425b49
commit a85fc32384
2 changed files with 40 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
src/hsx.lisp
View file

@ -5,27 +5,26 @@
#:make-keyword) #:make-keyword)
(:import-from #:hsx/element (:import-from #:hsx/element
#:create-element) #:create-element)
(:export #:defcomp (:export #:defhsx
#:defcomp
#:hsx)) #:hsx))
(in-package #:hsx/hsx) (in-package #:hsx/hsx)
;;;; hsx definitions ;;;; hsx definitions
(defparameter *builtin-elements* (make-hash-table)) (defmacro defhsx (name element-type)
(defmacro define-builtin-element (name)
`(defmacro ,name (&body body) `(defmacro ,name (&body body)
(multiple-value-bind (props children) (multiple-value-bind (props children)
(parse-body body) (parse-body body)
`(create-element ,',(string-downcase name) `(create-element ,',element-type (list ,@props) ,@children))))
(list ,@props)
,@children)))) (defparameter *builtin-elements* (make-hash-table))
(defmacro define-and-export-builtin-elements (&body names) (defmacro define-and-export-builtin-elements (&body names)
`(progn `(progn
,@(mapcan (lambda (name) ,@(mapcan (lambda (name)
(list `(define-builtin-element ,name) (list `(defhsx ,name ,(string-downcase name))
`(setf (gethash (make-keyword ',name) *builtin-elements*) t) `(setf (gethash (make-keyword ',name) *builtin-elements*) t)
`(export ',name))) `(export ',name)))
names))) names)))
@ -51,12 +50,7 @@
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)
(defun ,%name ,props (defun ,%name ,props
,@body) ,@body)
(defmacro ,name (&body body) (defhsx ,name (fdefinition ',%name)))))
(multiple-value-bind (props children)
(parse-body body)
`(create-element #',',%name
(list ,@props)
,@children))))))
(defun parse-body (body) (defun parse-body (body)
(if (keywordp (first body)) (if (keywordp (first body))

37
tests/hsx.lisp
View file

@ -8,6 +8,7 @@
(def-suite hsx-test) (def-suite hsx-test)
(in-suite hsx-test) (in-suite hsx-test)
(test empty-hsx (test empty-hsx
(is (equal (macroexpand-1 (is (equal (macroexpand-1
'(div)) '(div))
@ -44,16 +45,42 @@
"child1" "child1"
"child2")))) "child2"))))
(defcomp comp (&key prop1 prop2 children) (defhsx custom "custom")
(declare (ignore prop1 prop2 children)))
(test component-hsx (test hsx-for-custom-tag-element
(is (equal (macroexpand-1 (is (equal (macroexpand-1
'(comp :prop1 "value1" :prop2 "value2" '(custom :prop1 "value1" :prop2 "value2"
"child1" "child1"
"child2")) "child2"))
'(create-element '(create-element
#'%comp "custom"
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2"))))
(defun %comp1 (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children)))
(defhsx comp1 #'%comp1)
(defcomp comp2 (&key prop1 prop2 children)
(declare (ignore prop1 prop2 children)))
(test hsx-for-component-element
(is (equal (macroexpand-1
'(comp1 :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
#'%comp1
(list :prop1 "value1" :prop2 "value2")
"child1"
"child2")))
(is (equal (macroexpand-1
'(comp2 :prop1 "value1" :prop2 "value2"
"child1"
"child2"))
'(create-element
(fdefinition '%comp2)
(list :prop1 "value1" :prop2 "value2") (list :prop1 "value1" :prop2 "value2")
"child1" "child1"
"child2")))) "child2"))))