dom:from-list (after HTML parsing): improvements

This commit is contained in:
Helmut Merz 2025-03-23 16:31:42 +01:00
parent 104fceba8b
commit e507bf0c1f
2 changed files with 23 additions and 21 deletions

View file

@ -43,14 +43,13 @@
;;;; the tests ;;;; the tests
(deftest test-dom-parse () (deftest test-dom-parse ()
(let (inp parsed rendered) (let (inp parsed)
(setf inp "<a href=\"https://example.com\">Link</a>") (setf inp "<a href=\"https://example.com\">Link</a>")
(setf parsed '(((:a :href "https://example.com") "Link"))) (setf parsed (dom:parse inp))
(== (dom:parse inp) parsed) (== parsed '(((:a :href "https://example.com") "Link")))
;(setf wanted (dom:a '(:href "https://example.com") "Link")) ;(== (dom:from-list parsed) ((dom:a '(:href "https://example.com") "Link")))
(== (dom:render (dom:from-list parsed)) inp) (== (dom:render (dom:from-list parsed)) inp)
) ))
)
(deftest test-dom () (deftest test-dom ()
(== (dom:render (== (dom:render

View file

@ -145,22 +145,25 @@
(defun newline () (defun newline ()
(put-char #\Newline)) (put-char #\Newline))
;;;; create elements from list of symbols ;;;; conversions (for testing or manipulation of HTML using dom)
(defun from-list (lst) (defun to-list (&rest elems))
(mapcar #'(lambda (part)
(etypecase part
(string part)
(symbol (funcall (find-symbol (string part) *this*)))
(list
(etypecase (car part)
(symbol (apply (find-symbol (string (car part)) *this*)
nil (from-list (cdr part))))
(list (apply (find-symbol (string (caar part)) *this*)
(cdar part) (from-list (cdr part))))
)))) lst))
;;;; parsing (for testing or manipulation of HTML using dom)
(defun parse (html) (defun parse (html)
(hp:parse-html html)) (hp:parse-html html))
(defun from-list (lst)
"Create elements from a list of symbols as produced by parse-html."
(mapcar #'from-list-part lst))
(defun from-list-part (part)
(flet ((sym (k) (find-symbol (string k) *this*)))
(etypecase part
(string part)
(symbol (funcall (sym part)))
(list
(let ((tag (car part)) attr)
(when (consp tag)
(setf attr (cdr tag) tag (car tag)))
(apply (sym tag) attr (from-list (cdr part))))))))