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 "")
(put-string tag)
- (put-char #\>)
- (if newline
- (put-char #\Newline)))
+ (put-char #\>))
+
+(defun newline ()
+ (put-char #\Newline))
;;;; tag-specific renderers