diff --git a/test/test-web.lisp b/test/test-web.lisp index 9dee315..db7fde6 100644 --- a/test/test-web.lisp +++ b/test/test-web.lisp @@ -26,6 +26,7 @@ (core:setup-services) (let ((server (core:find-service :server)) (client (core:find-service :client))) + (test-dom) (test-server-config server) (sleep 0.1) (test-fileserver client) @@ -37,7 +38,7 @@ (deftest test-dom () (== (dom:render (dom:link '(:href "https://example.com" - :title "Demo" :class '(:demo-link :plain)) + :title "Demo" :class (:demo-link :plain)) (dom:text "Link to example.com"))) "Link to example.com")) @@ -52,4 +53,4 @@ (deftest test-message (client) (let ((msg (message:create '(:test :data :field :info) :data '(:info "test data")))) (== (util:flatten-str (client:send-message client msg)) - "
info
test data
"))) + "
info
test data
"))) diff --git a/util.lisp b/util.lisp index 3590199..b356d06 100644 --- a/util.lisp +++ b/util.lisp @@ -2,7 +2,7 @@ (defpackage :scopes/util (:use :common-lisp) - (:export #:flatten-str #:to-keyword + (:export #:flatten-str #:to-keyword #:to-string #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string #:relative-path #:runtime-path #:system-path)) @@ -13,6 +13,11 @@ (defun flatten-str (s &key (with " ")) (str:join with (str:lines s))) +(defun to-string (k) + (if (atom k) + (string-downcase k) + (str:join " " (mapcar #'string-downcase k)))) + (defun to-keyword (s) (intern (string-upcase s) :keyword)) diff --git a/web/dom.lisp b/web/dom.lisp index 95a3bec..20ca5e5 100644 --- a/web/dom.lisp +++ b/web/dom.lisp @@ -2,7 +2,8 @@ (defpackage :scopes/web/dom (:use :common-lisp) - (:local-nicknames (:alx :alexandria)) + (:local-nicknames (:util :scopes/util) + (:alx :alexandria)) (:export #:render #:text #:dl #:link)) @@ -30,20 +31,36 @@ `(progn (start ,tag ,attrs) ,@body - (end ,tag t))) + (end ,tag))) + +(defun put-attrs (plist) + (loop for (key val . r) on plist by #'cddr do + (put-char #\Space) + (when val + (put-string (string-downcase key)) + (when (not (eq val t)) + (put-string "=\"") + (put-string (attr-str key val)) + (put-char #\"))))) + +(defun attr-str (key val) + (case key + ((:id :class) (util:to-string val)) + (t (string val)))) (defun start (tag &optional attrs) (put-char #\<) (put-string tag) - ;(put-attrs attrs) + (put-attrs attrs) (put-char #\>)) -(defun end (tag &optional newline) +(defun end (tag) (put-string ") - (if newline - (put-char #\Newline))) + (put-char #\>)) + +(defun newline () + (put-char #\Newline)) ;;;; tag-specific renderers