diff --git a/test/test-web.lisp b/test/test-web.lisp
index 56b234c..9dee315 100644
--- a/test/test-web.lisp
+++ b/test/test-web.lisp
@@ -5,9 +5,11 @@
(:local-nicknames (:config :scopes/config)
(:core :scopes/core)
(:client :scopes/web/client)
+ (:dom :scopes/web/dom)
(:logging :scopes/logging)
(:message :scopes/core/message)
(:server :scopes/web/server)
+ (:util :scopes/util)
(:t :scopes/testing))
(:export #:run)
(:import-from :scopes/testing #:deftest #:== #:has-prefix))
@@ -32,6 +34,13 @@
(core:shutdown)
(t:show-result))))
+(deftest test-dom ()
+ (== (dom:render
+ (dom:link '(:href "https://example.com"
+ :title "Demo" :class '(:demo-link :plain))
+ (dom:text "Link to example.com")))
+ "Link to example.com"))
+
(deftest test-server-config (server)
(== (parse-integer (server:port (core:config server))) 8899))
@@ -42,5 +51,5 @@
(deftest test-message (client)
(let ((msg (message:create '(:test :data :field :info) :data '(:info "test data"))))
- (== (str:trim (client:send-message client msg))
- "
- info
- test data
")))
+ (== (util:flatten-str (client:send-message client msg))
+ "- info
- test data
")))
diff --git a/util.lisp b/util.lisp
index 1962650..3590199 100644
--- a/util.lisp
+++ b/util.lisp
@@ -2,7 +2,7 @@
(defpackage :scopes/util
(:use :common-lisp)
- (:export #:to-keyword #:trunc
+ (:export #:flatten-str #:to-keyword
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
#:relative-path #:runtime-path #:system-path))
@@ -10,11 +10,8 @@
;;;; strings, symbols, keywords, ...
-(defun trunc (s n)
- (let ((s1 (str:substring 0 n s)))
- (if (> (length s) n)
- (str:concat s1 "...")
- s1)))
+(defun flatten-str (s &key (with " "))
+ (str:join with (str:lines s)))
(defun to-keyword (s)
(intern (string-upcase s) :keyword))
diff --git a/web/dom.lisp b/web/dom.lisp
index 2c9e1a1..95a3bec 100644
--- a/web/dom.lisp
+++ b/web/dom.lisp
@@ -3,39 +3,39 @@
(defpackage :scopes/web/dom
(:use :common-lisp)
(:local-nicknames (:alx :alexandria))
- (:export #:render #:dl))
+ (:export #:render #:text
+ #:dl #:link))
(in-package :scopes/web/dom)
;;;; basic / common stuff
-(defvar *output* nil)
+(defvar *output* (make-string-output-stream))
(defmacro render (&body body)
`(let ((*output* (make-string-output-stream)))
,@body
(get-output-stream-string *output*)))
+(defmacro text (s)
+ `(put-string (string ,s)))
+
(defmacro put-string (s)
`(write-string ,s *output*))
(defmacro put-char (c)
`(write-char ,c *output*))
-(defmacro nested (tag attrs &body body)
+(defmacro element (tag attrs &body body)
`(progn
(start ,tag ,attrs)
,@body
(end ,tag t)))
-(defun terminal (tag attrs val)
- (start tag attrs)
- (put-string val)
- (end tag))
-
(defun start (tag &optional attrs)
(put-char #\<)
(put-string tag)
+ ;(put-attrs attrs)
(put-char #\>))
(defun end (tag &optional newline)
@@ -47,15 +47,17 @@
;;;; tag-specific renderers
-(defun dl (plist)
- (nested "dl" nil
+(defun dl (attrs plist)
+ (element "dl" attrs
(loop for (key val . r) on plist by #'cddr do
- (terminal "dt" nil (string-downcase key))
- (dd val))))
+ (element "dt" nil (put-string (string-downcase key)))
+ (dd nil val))))
-(defun dd (v)
+(defun dd (attrs v)
(if (atom v)
(setf v (list v)))
(dolist (el v)
- (terminal "dd" nil (string el))))
+ (element "dd" attrs (text el))))
+(defmacro link (attrs &body body)
+ `(element "a" ,attrs ,@body))
diff --git a/web/response.lisp b/web/response.lisp
index 698879c..1dafdde 100644
--- a/web/response.lisp
+++ b/web/response.lisp
@@ -28,8 +28,7 @@
((ctype :initform "text/html")))
(defmethod render-content ((resp html-response) msg)
- (dom:render (dom:dl (message:data msg))))
- ;(getf (message:data msg) :info))
+ (dom:render (dom:dl nil (message:data msg))))
;;;; common definitions