Fix h macro
This commit is contained in:
parent
2b3446dac6
commit
55735c71cc
2 changed files with 16 additions and 15 deletions
|
@ -194,7 +194,7 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
|
|||
|
||||
(defmacro h (&body body)
|
||||
`(progn
|
||||
,@(tree-leaves
|
||||
,@(modify-first-leaves
|
||||
body
|
||||
(html-element-p x)
|
||||
(find-symbol (string-upcase x) :piccolo))))
|
||||
|
|
|
@ -10,22 +10,23 @@
|
|||
(cdr kv)))
|
||||
alist))
|
||||
|
||||
(defstruct !expanded list)
|
||||
|
||||
(defun tree-leaves%% (tree test result)
|
||||
(defun %%modify-first-leaves (tree test result)
|
||||
(if tree
|
||||
(if (listp tree)
|
||||
(let ((car-result (tree-leaves%% (car tree) test result))
|
||||
(cdr-result (tree-leaves%% (cdr tree) test result)))
|
||||
(if (!expanded-p car-result)
|
||||
(append (!expanded-list car-result) cdr-result)
|
||||
(cons car-result cdr-result)))
|
||||
(if (funcall test tree)
|
||||
(funcall result tree)
|
||||
tree))))
|
||||
(cons (let ((first-node (first tree)))
|
||||
(cond
|
||||
((listp first-node)
|
||||
(%%modify-first-leaves first-node test result))
|
||||
((funcall test first-node)
|
||||
(funcall result first-node))
|
||||
(t first-node)))
|
||||
(mapcar (lambda (node)
|
||||
(if (listp node)
|
||||
(%%modify-first-leaves node test result)
|
||||
node))
|
||||
(rest tree)))))
|
||||
|
||||
(defmacro tree-leaves (tree test result)
|
||||
`(tree-leaves%%
|
||||
(defmacro modify-first-leaves (tree test result)
|
||||
`(%%modify-first-leaves
|
||||
,tree
|
||||
(lambda (x)
|
||||
(declare (ignorable x))
|
||||
|
|
Loading…
Reference in a new issue