diff --git a/scopes-web.asd b/scopes-web.asd index 7164826..e8e78ab 100644 --- a/scopes-web.asd +++ b/scopes-web.asd @@ -6,7 +6,7 @@ :version "0.0.1" :homepage "https://www.cyberconcepts.org" :description "Web client and server functionality." - :depends-on (:cl-cookie :clack :dexador :flexi-streams + :depends-on (:cl-cookie :cl-html-parse :clack :dexador :flexi-streams :lack :lack-component :lack-app-file :quri :scopes-core) :components ((:file "frontend/cs-hx" :depends-on ("web/dom" "web/response")) diff --git a/test/test-web.lisp b/test/test-web.lisp index 9cd2c9c..3e75f8c 100644 --- a/test/test-web.lisp +++ b/test/test-web.lisp @@ -29,6 +29,7 @@ (core:setup-services) (let ((server (core:find-service :server)) (client (core:find-service :client))) + (test-dom-parse) (test-dom) (test-jwt) (test-server-config server) @@ -39,6 +40,18 @@ (core:shutdown) (t:show-result)))) +;;;; the tests + +(deftest test-dom-parse () + (let (inp parsed rendered) + (setf inp "Link") + (setf parsed '(((:a :href "https://example.com") "Link"))) + (== (dom:parse inp) parsed) + ;(setf wanted (dom:a '(:href "https://example.com") "Link")) + (== (dom:render (dom:from-list parsed)) inp) + ) + ) + (deftest test-dom () (== (dom:render (dom:a '(:href "https://example.com" diff --git a/web/dom.lisp b/web/dom.lisp index 794a3ac..b579494 100644 --- a/web/dom.lisp +++ b/web/dom.lisp @@ -3,14 +3,17 @@ (defpackage :scopes/web/dom (:use :common-lisp) (:local-nicknames (:util :scopes/util) + (:hp :html-parse) (:alx :alexandria)) (:export #:xml-element #:elem #:element #:void-element #:render #:dlist #:a #:dd #:div #:dl #:dt #:label - #:br #:input)) + #:br #:input + #:parse #:from-list)) (in-package :scopes/web/dom) +(defvar *this* *package*) ;;;; basic definitions @@ -142,3 +145,22 @@ (defun newline () (put-char #\Newline)) +;;;; create elements from list of symbols + +(defun from-list (lst) + (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) + (hp:parse-html html))